"Fossies" - the Fresh Open Source Software Archive

Member "absence-v2.1/cgi-bin/AbsenceDB.pm.dna" (10 Dec 2013, 71949 Bytes) of package /linux/www/web-absence-2.1.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 #----------------------------------------------------------------------
    2 # AbsenceDB - interface to database
    3 # $Id: AbsenceDB.pm 91 2009-07-14 15:58:06Z urban $
    4 #----------------------------------------------------------------------
    5 
    6 # $Rev: 91 $:  Revision of last commit
    7 # $Author: urban $:  Author of last commit
    8 # $Date: 2009-07-14 17:58:06 +0200 (Tue, 14 Jul 2009) $:  Date of last commit
    9 
   10 package AbsenceDB;
   11 
   12 use FileHandle;
   13 use Carp;
   14 use Digest::MD5 qw(md5_base64);
   15 
   16 use AbsenceConfig;
   17 use AbsenceDate;
   18 use AbsenceLog;
   19 use DBI;
   20 use CGI::Session;
   21 use IPC::Open3;
   22 
   23 #----------------------------------------------------------------------
   24 # initialization
   25 #----------------------------------------------------------------------
   26 
   27 my $DB_NAME			= AbsenceConfig::fetch('database_name');
   28 my $DB_PORT			= AbsenceConfig::fetch('database_port');
   29 my $DB_HOST			= AbsenceConfig::fetch('database_host');
   30 my $DB_USER			= AbsenceConfig::fetch('database_user');
   31 my $DB_PASS			= AbsenceConfig::fetch('database_pass');
   32 
   33 my $DEBUG			= 1;
   34 my $VERBOSE			= 1;
   35 my %META;	# container for PostgreSQL metadata about tables/fields
   36 
   37 #----------------------------------------------------------------------
   38 # connect to db first thing
   39 #----------------------------------------------------------------------
   40 $DEBUG && abslog("init: connect to DB");
   41 
   42 my $DBH = DBI->connect("dbi:Pg:dbname=$DB_NAME;host=$DB_HOST",
   43 	$DB_USER, $DB_PASS, {AutoCommit => 1, RaiseError => 1});
   44 
   45 defined($DBH) || die "cannot connect to DB";
   46 
   47 my @SESSION_PARAMS	= (
   48 	'driver:PostgreSQL',
   49 	undef,
   50 	{
   51 		Handle		=> $DBH,
   52 		ColumnType	=> 'binary',
   53 	}
   54 );
   55 
   56 END {
   57 	#defined($DBH) && $DBH->disconnect;
   58 }
   59 
   60 #-----------------------------------------
   61 # $FULL_SLOTS is defined here *and* in
   62 # AbsenceImage.pm :(
   63 #-----------------------------------------
   64 my $FULL_SLOTS		= 4;
   65 
   66 my $MODTIME_FILE	= AbsenceConfig::fetch('modtime_db_file');
   67 my $OAP				= AbsenceConfig::fetch('objects_are_people');
   68 my $AUTH			= AbsenceConfig::fetch('authentication');
   69 my $CRED_SRC		= AbsenceConfig::fetch('credential_src');
   70 my $PW_HASH_FORMAT	= AbsenceConfig::fetch('pw_hash_format');
   71 my $SESSION_TIMEOUT	= AbsenceConfig::fetch('session_timeout');
   72 my $MULTI_RES		= AbsenceConfig::fetch('multi_res');
   73 my $MAX_MULTI		= AbsenceConfig::fetch('max_multi');
   74 
   75 
   76 my $VERSION			= '1.5';
   77 
   78 #----------------------------------------------------------------------
   79 # methods
   80 #----------------------------------------------------------------------
   81 
   82 #----------------------------------------------------------------
   83 # getPeople()
   84 #
   85 # returns an array of person_ids sorted by name
   86 # if group_id is zero, returns all people. Otherwise, returns
   87 # people in group_id
   88 #----------------------------------------------------------------
   89 
   90 sub getPeople
   91 {
   92 	my $group_id = shift;
   93 
   94 	my @out;
   95 	my $sql;
   96 
   97 	if ($group_id == 0) {
   98 		$sql = qq{
   99 			SELECT id
  100 			FROM v_object
  101 			ORDER BY LOWER(name);
  102 		};
  103 		return dbSelectColumn($sql, 'id');
  104 	}
  105 
  106 	if (!groupExists(id => $group_id)) {
  107 		die "getPeople: gid [$group_id] does not exist";
  108 	}
  109 
  110 	$sql = qq{
  111 		SELECT o.id
  112 		FROM
  113 			v_object AS o,
  114 			v_group AS g,
  115 			c_group_object AS go
  116 		WHERE
  117 			g.id = ? AND
  118 			go.group_id = g.id AND
  119 			go.object_id = o.id
  120 		ORDER BY
  121 			LOWER(o.name);
  122 	};
  123 	return dbSelectColumn($sql, 'id', $group_id);
  124 }
  125 
  126 sub groupExists
  127 {
  128 	my ($field, $val) = @_;
  129 
  130 	my $sql = qq{SELECT id FROM v_group WHERE $field = ?;};
  131 
  132 	my $rv = $DBH->do($sql, undef, $val);
  133 	($rv eq '0E0') && return 0;
  134 	return 1;
  135 }
  136 
  137 sub reservationExists
  138 {
  139 	my $id = shift;
  140 
  141 	my $sql = qq{SELECT id FROM v_reservation WHERE id = ?;};
  142 
  143 	my $rv = $DBH->do($sql, undef, $id);
  144 	($rv eq '0E0') && return 0;
  145 	return 1;
  146 }
  147 
  148 sub objectExists
  149 {
  150 	my ($field, $val) = @_;
  151 
  152 	my $sql = qq{SELECT id FROM v_object WHERE $field = ?;};
  153 
  154 	my $rv = $DBH->do($sql, undef, $val);
  155 	($rv eq '0E0') && return 0;
  156 	return 1;
  157 }
  158 
  159 sub userExists
  160 {
  161 	my ($field, $val) = @_;
  162 
  163 	my $sql = qq{SELECT id FROM v_user WHERE $field = ?;};
  164 
  165 	my $rv = $DBH->do($sql, undef, $val);
  166 	($rv eq '0E0') && return 0;
  167 	return 1;
  168 }
  169 
  170 sub inListN
  171 {
  172 	my ($thing, $lref) = @_;
  173 
  174 	foreach my $elem (@{$lref}) {
  175 		($elem == $thing) && return 1;
  176 	}
  177 
  178 	return 0;
  179 }
  180 
  181 sub getPerson
  182 {
  183 	my ($pid, $field) = @_;
  184 
  185 	if (!objectExists(id => $pid)) {
  186 		#print "no person with ID=[$pid]\n";
  187 		return undef;
  188 	}
  189 	
  190 	my $sql;
  191 
  192 	if ($field) {
  193 		$sql = qq{SELECT $field FROM v_object WHERE id = ?;};
  194 
  195 		my $ref = dbSelect($sql, $pid);
  196 		return defined($ref) ? $ref->{$field} : undef;
  197 	}
  198 
  199 	$sql = qq{SELECT * FROM v_object WHERE id = ?;};
  200 
  201 	return dbSelect($sql, $pid);
  202 }
  203 
  204 sub getUserForOid
  205 {
  206 	my $oid = shift;
  207 
  208 	my $sql = qq{
  209 		SELECT *
  210 		FROM v_user
  211 		WHERE object_id = ?;
  212 	};
  213 
  214 	return dbSelect($sql, $oid);
  215 }
  216 
  217 sub getOidForUid
  218 {
  219 	my $user_id = shift;
  220 
  221 	my $sql = qq{
  222 		SELECT	object_id
  223 		FROM	v_user
  224 		WHERE	id = ?;
  225 	};
  226 
  227 	my $res = dbSelect($sql, $user_id);
  228 
  229 	return defined($res) ? $res->{object_id} : undef;
  230 }
  231 
  232 sub getPidForUser
  233 {
  234 	my $user = shift;
  235 
  236 	userExists(username => $user) || confess "user [$user] unknown";
  237 
  238 	my $sql = qq{
  239 		SELECT	object_id
  240 		FROM	v_user
  241 		WHERE	username = ?;
  242 	};
  243 
  244 	my $res = dbSelect($sql, $user);
  245 
  246 	return defined($res) ? $res->{object_id} : undef;
  247 }
  248 
  249 #-------------------------------------------------------------
  250 # getReservations()
  251 #
  252 # apparently only called from resConflict, probably don't need anymore
  253 # also, inefficient, as it queries all reservations, without regard
  254 # for date
  255 #-------------------------------------------------------------
  256 sub getReservations
  257 {
  258 	my $person_id = shift;
  259 
  260 	my @out;
  261 
  262 	$DEBUG && abslog("getReservations for id=[$person_id]");
  263 
  264 	my $sql = qq{
  265 		SELECT *
  266 		FROM v_reservation
  267 		WHERE object_id = ?;
  268 	};
  269 
  270 	return dbSelect($sql, $person_id);
  271 }
  272 
  273 sub getMonthReservations
  274 {
  275 	my ($person_id, $month, $year) = @_;
  276 
  277 	my $dim = AbsenceDate::daysInMonth($month, $year);
  278 	my $month_begin = "$year-$month-1";
  279 	my $month_end = "$year-$month-$dim";
  280 
  281 	#$DEBUG && abslog("getMonthReservations: p_id = $person_id, m=$month, y=$year");
  282 
  283 	my $sql = qq{
  284 		SELECT *
  285 		FROM v_reservation
  286 		WHERE
  287 			object_id = ? AND (
  288 				(
  289 					( start BETWEEN ? AND ? ) OR
  290 					( finish BETWEEN ? AND ? )
  291 				)
  292 				OR
  293 				(
  294 					( start < ? ) AND ( finish > ? )
  295 				)
  296 			);
  297 	};
  298 
  299 	my @bind_params = (
  300 		$person_id,
  301 		$month_begin, $month_end, $month_begin, $month_end,
  302 		$month_begin, $month_end);
  303 
  304 	my @out;
  305 	foreach my $ref (dbSelect($sql, @bind_params)) {
  306 		my ($sd, $ed) = getMonthBounds($ref->{start}, $ref->{finish}, $month, $year);
  307 		push(@out, {
  308 			res		=> $ref,
  309 			bounds	=> {
  310 				start	=> $sd,
  311 				end		=> $ed,
  312 			 },
  313 		});
  314 	}
  315 
  316 	@out;
  317 }
  318 
  319 sub getMonthBounds
  320 {
  321 	my ($start, $end, $month, $year) = @_;
  322 
  323 	my ($sd, $sm, $sy, $ed, $em, $ey);
  324 
  325 	if (ref($start)) {
  326 		($sy, $sm, $sd) = ($start->{year}, $start->{month}, $start->{day});
  327 		($ey, $em, $ed) = ($end->{year}, $end->{month}, $end->{day});
  328 	} else {
  329 		($sy, $sm, $sd) = ($start =~ /^(\d{4})-(\d{2})-(\d{2})$/);
  330 		($ey, $em, $ed) = ($end =~ /^(\d{4})-(\d{2})-(\d{2})$/);
  331 	}
  332 
  333 	my $dim = AbsenceDate::daysInMonth($month, $year);
  334 
  335 	my $s = (($sm == $month) && ($sy == $year)) ? $sd : 1;
  336 	my $e = (($em == $month) && ($ey == $year)) ? $ed : $dim;
  337 
  338 	return ($s, $e);
  339 }
  340 
  341 sub getReservation
  342 {
  343 	my $rid = shift;
  344 
  345 	my $sql = qq{
  346 		SELECT *
  347 		FROM v_reservation
  348 		WHERE id = ?;
  349 	};
  350 
  351 	return dbSelect($sql, $rid);
  352 }
  353 
  354 #--------------------------------------------------------------------
  355 # group stuff
  356 #--------------------------------------------------------------------
  357 
  358 sub addGroup
  359 {
  360 	# ROBBO: modify callers to pass desc too
  361 	my ($gid, $name, $pass, $desc) = @_;
  362 
  363 	$DEBUG && abslog("addGroup: start: name=[$name], pass=[$pass]");
  364 
  365 	## check lengths
  366 	#my $ret = checkLengths('c_group', {
  367 	#	name		=> $name,
  368 	#	password	=> $pass,
  369 	#	description	=> $desc,
  370 	#};
  371 	#$ret && return "baddata: $ret";
  372 
  373 	my $verb;
  374 
  375 	my $sql;
  376 
  377 	if ($gid eq 'new') {
  378 		if (groupExists(name => $name)) {
  379 			abslog("addGroup: dup, bailing.");
  380 			return 'duplicate';
  381 		}
  382 		$sql = qq{
  383 			INSERT INTO c_group
  384 				(name, password, description)
  385 			VALUES (?,?,?);
  386 		};
  387 		$verb = 'insert';
  388 		$gid = insertRowRetrieveSequence('c_group', $sql, $name, $pass, $desc);
  389 
  390 	} else {
  391 		if (!groupExists(id => $gid)) {
  392 			abslog("error: attempt to modify non-existent group [$gid]");
  393 			return undef;
  394 		}
  395 		$sql = qq{
  396 			UPDATE c_group
  397 			SET name = ?, password = ?, description = ?
  398 			WHERE id = ?;
  399 		};
  400 		$verb = 'update';
  401 		my $rv = $DBH->do($sql, undef, $name, $pass, $desc, $gid);
  402 		defined($rv) || die "update group [$name]. error=".$DBH->errstr();
  403 	}
  404 
  405 	$DEBUG && abslog("addGroup: group-id = [$gid].");
  406 	abslog("addGroup: $verb: name=[$name], gid=[$gid]");
  407 
  408 	return wantarray ? ('ok', $gid) : 'ok';
  409 }
  410 
  411 sub deleteGroup
  412 {
  413 	my $gid = shift;
  414 
  415 	$DEBUG && abslog("deleteGroup: start: gid=[$gid]");
  416 
  417 	my $sql = qq{SELECT * FROM v_group WHERE id = $gid;};
  418 	my $gref = dbSelect($sql);
  419 
  420 	if (!defined($gref)) {
  421 		abslog("error: attempt to delete non-existent group [$gid]");
  422 		return undef;
  423 	}
  424 
  425 	#---------------------------------------------------
  426 	# first, check if members need to be deleted or modified
  427 	#---------------------------------------------------
  428 	$sql = qq{
  429 		SELECT DISTINCT v_object.id
  430 		FROM v_group,v_object,c_group_object
  431 		WHERE c_group_object.group_id = ?
  432 		AND c_group_object.object_id = v_object.id;
  433 	};
  434 
  435 	my $aref = $DBH->selectcol_arrayref($sql, undef, $gid);
  436 	if (defined($aref)) {
  437 		#---------------------------------------------------
  438 		# people are still members of $gid
  439 		# for each member, check if member of other groups
  440 		# if yes, delete membership, if no, delete object
  441 		#---------------------------------------------------
  442 		foreach my $pid (@{$aref}) {
  443 			# get IDs of object/group mapping for $pid
  444 			removeObjectFromGroup(
  445 				-pid	=> $pid,
  446 				-gid	=> $gid,
  447 				#'-delete_groupless_objects',
  448 			);
  449 		}
  450 	}
  451 
  452 	#---------------------------------------------------
  453 	# remove any referring rows in d_group_mod_time
  454 	#---------------------------------------------------
  455 	$sql = qq{ DELETE FROM d_group_mod_time WHERE group_id = ?; };
  456 	$DBH->do($sql, undef, $gid);
  457 
  458 	#-----------------------------------------------------------------
  459 	# now get rid of the group
  460 	# it might be interesting some time to implement invalidation.
  461 	# for now, I just delete the row entirely.
  462 	#-----------------------------------------------------------------
  463 	#my $now = time();
  464 	#$sql = qq{UPDATE c_group SET invalidated = int2tsz($now) WHERE id = $gid;};
  465 	#-----------------------------------------------------------------
  466 
  467 	$sql = qq{DELETE FROM c_group WHERE id = ?;};
  468 	$DBH->do($sql, undef, $gid);
  469 	
  470 	$AUTH && deleteGidInAcls($gid);
  471 
  472 	abslog("deleteGroup: name=[$gref->{name}], gid=[$gid]");
  473 
  474 	return 'ok';
  475 }
  476 
  477 sub addGroupMappings
  478 {
  479 	my ($object_id, @gids) = @_;
  480 
  481 	my $sql = qq{
  482 		INSERT INTO c_group_object
  483 			(group_id,object_id)
  484 		VALUES (?,?);
  485 	};
  486 	my $sth = $DBH->prepare($sql);
  487 	defined($sth) || die "prepare failed on sql [$sql]";
  488 
  489 	#	VALUES ($gid,$object_id);
  490 	foreach my $gid (@gids) {
  491 		$sth->execute($gid, $object_id)
  492 			|| die "sql failed: [$sql] with params gid=[$gid], object_id=[$object_id]";
  493 	}
  494 }
  495 
  496 sub deleteGroupMappings
  497 {
  498 	my ($object_id, @group_ids) = @_;
  499 
  500 	my $sql;
  501 	my @bind_params;
  502 
  503 	if (!@group_ids) {
  504 		$sql = qq{
  505 			DELETE FROM c_group_object
  506 			WHERE object_id = ?;
  507 		};
  508 		@bind_params = ($object_id);
  509 	} else {
  510 		my @questions = map '?', @group_ids;
  511 		my $q = join(',', @questions);
  512 		$sql = qq{
  513 			DELETE FROM c_group_object
  514 			WHERE object_id = ?
  515 			AND group_id in ($q);
  516 		};
  517 		@bind_params = ($object_id, @group_ids);
  518 	}
  519 	$DBH->do($sql, undef, @bind_params);
  520 }
  521 
  522 #--------------------------------------------------------------------
  523 # removeObjectFromGroup()
  524 #
  525 # remove an object from a group by deleting the object-group mapping.
  526 # parameters:
  527 # -gid => $gid
  528 # -pid => $pid
  529 # -delete_groupless_objects
  530 #
  531 # $gid and $pid are mandatory
  532 #
  533 # returns: nothing
  534 #--------------------------------------------------------------------
  535 sub removeObjectFromGroup
  536 {
  537 	my $delete_groupless_objects = 0;
  538 	my ($pid, $gid);
  539 
  540 	while(my $arg = shift) {
  541 		if ($arg =~ /delete_groupless_objects/) {
  542 			$delete_groupless_objects = 1
  543 		} elsif ($arg eq '-pid') {
  544 			$pid = shift;
  545 		} elsif ($arg eq '-gid') {
  546 			$gid = shift;
  547 		}
  548 	}
  549 	defined($pid) && defined($gid) || die "removeObjectFromGroup: pid/gid not defined";
  550 
  551 	my $sql = qq{
  552 		SELECT *
  553 		FROM c_group_object
  554 		WHERE c_group_object.object_id = ?;
  555 	};
  556 	my @list = dbSelect($sql, $pid);
  557 
  558 	my $mapping_to_delete;
  559 	my @others;
  560 	foreach my $mapping (@list) {
  561 		if ($mapping->{group_id} == $gid) {
  562 			$mapping_to_delete = $mapping;
  563 		} else {
  564 			push(@others, $mapping);
  565 		}
  566 	}
  567 
  568 	# $mapping_to_delete now contains id of the mapping which
  569 	# associates object $pid with group $gid.
  570 	# @others possibly contains mappings for $pid to other groups
  571 
  572 	#--------------------------------------------------------
  573 	# delete mapping
  574 	#--------------------------------------------------------
  575 	if (defined($mapping_to_delete)) {
  576 		$sql = qq[
  577 			DELETE FROM c_group_object
  578 			WHERE id = ?;
  579 		];
  580 		$DBH->do($sql, undef, $mapping_to_delete->{id});
  581 	}
  582 
  583 	#--------------------------------------------------------
  584 	# invalidate object, if desired, and if object is not member
  585 	# of other groups
  586 	#--------------------------------------------------------
  587 	if ($delete_groupless_objects && !@others) {
  588 		#invalidateObject($pid);
  589 		_deleteObject($pid);
  590 	}
  591 }
  592 
  593 sub bad_deleteObject
  594 {
  595 	my $oid = shift;
  596 	
  597 	deleteReservations(object_id => $oid);
  598 
  599 	my $sql = qq{ DELETE FROM c_object WHERE id = ?; };
  600 	$DBH->do($sql, undef, $oid);
  601 }
  602 
  603 sub invalidateObject
  604 {
  605 	my $oid = shift;
  606 	
  607 	invalidateReservations(object_id => $oid);
  608 
  609 	my $now = time();
  610 
  611 	my $sql = qq{
  612 		UPDATE c_object SET invalidated = int2tsz($now) WHERE id = ?;
  613 	};
  614 	$DBH->do($sql, undef, $oid);
  615 }
  616 
  617 sub _deleteReservation
  618 {
  619 	my $res_id = shift;
  620 
  621 	my $sql = qq{
  622 		DELETE FROM d_reservation WHERE id = ?;
  623 	};
  624 	$DBH->do($sql, undef, $res_id);
  625 }
  626 
  627 sub invalidateReservation
  628 {
  629 	my $res_id = shift;
  630 
  631 	my $now = time();
  632 
  633 	my $sql = qq{
  634 		UPDATE d_reservation SET invalidated = int2tsz($now) WHERE id = ?;
  635 	};
  636 	$DBH->do($sql, undef, $res_id);
  637 }
  638 
  639 sub deleteReservations
  640 {
  641 	my ($field, $val) = @_;
  642 
  643 	my $sql = qq{
  644 		DELETE FROM d_reservation WHERE $field = ?;
  645 	};
  646 	$DEBUG && abslog("deleteReservations: sql=[$sql]");
  647 
  648 	$DBH->do($sql, undef, $val);
  649 }
  650 
  651 sub invalidateReservations
  652 {
  653 	my ($field, $val) = @_;
  654 
  655 	my $now = time();
  656 
  657 	my $sql;
  658 
  659 	$sql = qq{
  660 		UPDATE d_reservation SET invalidated = int2tsz($now) WHERE $field = ?;
  661 	};
  662 
  663 	$DBH->do($sql, undef, $val);
  664 }
  665 
  666 #--------------------------------------------------------------------
  667 # ACL stuff
  668 #--------------------------------------------------------------------
  669 
  670 sub convertAclToInternal
  671 {
  672 	my @out;
  673 	foreach (@_) {
  674 		push(@out, {
  675 			level	=> $_->{level},
  676 			target	=> defined($_->{magic}) ? $_->{magic} : $_->{ref_id},
  677 		});
  678 	}
  679 	return wantarray ? (@out) : $out[0];
  680 }
  681 
  682 sub getUserAcls
  683 {
  684 	my $user_id = shift;
  685 
  686 	my $sql = qq{
  687 		SELECT *
  688 		FROM c_access
  689 		WHERE user_id = ?;
  690 	};
  691 
  692 	my @acls = dbSelect($sql, $user_id);
  693 	@acls || return undef;
  694 
  695 	# separate ACLs into group/object
  696 
  697 	my (@group, @object);
  698 
  699 	foreach my $acl (@acls) {
  700 		if ($acl->{type} eq 'object') {
  701 			push(@object, convertAclToInternal($acl));
  702 		} else {
  703 			push(@group, convertAclToInternal($acl));
  704 		}
  705 	}
  706 
  707 	return { object => \@object, group => \@group };
  708 }
  709 
  710 #------------------------------------------------------
  711 # authorizeAccessToObject()
  712 #
  713 # determines whether a user, ($user_id) may write an object ($oid),
  714 # that is, create, modify, and delete reservations.  a user
  715 # may gain write privileges in one of four:
  716 # (in all access entries level must be >= 2 and user_id must equal $user_id)
  717 # 1. there is an object access entry with magic=self and pointing to
  718 #    the oid associated with the user_id
  719 # 2. there is an object access entry pointing to the oid
  720 # 3. there is a group access entry pointing to a group to which
  721 #    oid belongs
  722 # 4. there is a group access entry with magic == 'all'
  723 # 5. there is a group access entry with magic == self, and the
  724 #    object associated with $user_id belongs to a group to which
  725 #    the object $oid also belongs
  726 #------------------------------------------------------
  727 sub authorizeAccessToObject
  728 {
  729 	my ($user_id, $oid, $access) = @_;
  730 
  731 	my %access_map = (
  732 		read	=> 1,
  733 		write	=> 2,
  734 		admin	=> 4,
  735 	);
  736 
  737 	exists($access_map{$access}) || die "access-type [$access] uknown";
  738 
  739 	my $sql = qq{
  740 		SELECT *
  741 		FROM
  742 			c_access		AS a,
  743 			c_group_object	AS map_u,
  744 			c_group_object	AS map_o,
  745 			v_user			AS u
  746 		WHERE
  747 			(a.user_id = ? AND a.level >= $access_map{$access}) AND
  748 			(
  749 					(a.type				= 'object'			AND
  750 					 a.magic			= 'self'			AND
  751 					 u.id				= ?					AND
  752 					 u.object_id		= ?) 
  753 				OR
  754 					(a.type				= 'object'			AND
  755 					 a.ref_id			= ?)
  756 				OR
  757 					(a.type				= 'group'			AND 
  758 					 a.ref_id			= map_o.group_id	AND
  759 					 map_o.object_id	= ?)
  760 				OR
  761 					(a.type				= 'group'			AND 
  762 					 a.magic			= 'all')
  763 				OR
  764 					(a.type				= 'group'			AND
  765 					 a.magic			= 'self'			AND
  766 					 map_u.object_id	= u.object_id		AND
  767 					 map_o.object_id	= ?					AND
  768 					 map_o.group_id		= map_u.group_id	AND
  769 					 u.id				= ?)
  770 			)
  771 		LIMIT 1;
  772 	};
  773 	my @bind_params = ($user_id, $user_id, $oid, $oid, $oid, $oid, $user_id);
  774 	defined(dbSelect($sql, @bind_params)) && return 1;
  775 	
  776 	return 0;
  777 }
  778 
  779 sub authorizeAccessToGroup
  780 {
  781 	my ($user_id, $gid, $access) = @_;
  782 
  783 	my %access_map = (
  784 		read	=> 1,
  785 		write	=> 2,
  786 		admin	=> 4,
  787 	);
  788 
  789 	#--------------------------------------------------------------------
  790 	# the magical value 'self' is not allowed for administration of
  791 	# groups.  Shut it off by looking for something impossible.
  792 	#--------------------------------------------------------------------
  793 	my $self = ($access eq 'admin') ? 'junk' : 'self';
  794 
  795 	exists($access_map{$access}) || die "access-type [$access] uknown";
  796 
  797 	my $implicit_read;
  798 	if ($access eq 'read') {
  799 		$implicit_read = qq{
  800 			OR
  801 				(u.id			= ?			 AND
  802 				 map.object_id	= u.object_id)
  803 		};
  804 	}
  805 
  806 	my $sql = qq{
  807 		SELECT a.id AS id
  808 		FROM
  809 			c_access		AS a,
  810 			c_group_object	AS map,
  811 			v_user			AS u
  812 		WHERE
  813 			(a.user_id = ? AND a.level >= $access_map{$access}) AND
  814 			(
  815 					(a.type			= 'group'		AND
  816 					 a.ref_id		= ?)
  817 				OR
  818 					(a.type			= 'group'		AND
  819 					 a.magic		= 'self'		AND
  820 					 map.group_id	= ?				AND
  821 					 map.object_id	= u.object_id	AND
  822 					 u.id			= ?)
  823 				OR
  824 					(a.type			= 'group'		AND 
  825 					 a.magic		= 'all')
  826 				$implicit_read
  827 			);
  828 	};
  829 
  830 	my @bind_params = ($user_id, $gid, $gid, $user_id);
  831 	$implicit_read && push(@bind_params, $user_id);
  832 
  833 	defined(dbSelect($sql, @bind_params)) && return 1;
  834 	
  835 	return 0;
  836 }
  837 
  838 sub findReadableGroups
  839 {
  840 	my $user_id = shift;
  841 
  842 	#---------------------------------------------------------------
  843 	# three things need to be checked:
  844 	# 1. find all groups to which the object associated with
  845 	#    $user_id belongs (if any)
  846 	# 2. find access records that refer directly to a particular group
  847 	# 3. check if the user has an access record with type=group, and
  848 	#    magic=all, if so, return *all* groups
  849 	#---------------------------------------------------------------
  850 
  851 	my $sql = qq{
  852 		SELECT map.group_id
  853 		FROM
  854 			c_group_object	AS map,
  855 			v_user			AS u
  856 		WHERE
  857 			(u.id			= ? AND
  858 			 map.object_id	= u.object_id)
  859 
  860 		UNION
  861 
  862 		SELECT ref_id AS group_id
  863 		FROM c_access
  864 		WHERE
  865 			(user_id		= ?) AND
  866 			(type			= 'group') AND 
  867 			(ref_id			IS NOT NULL)
  868 
  869 		UNION
  870 
  871 		SELECT g.id AS group_id
  872 		FROM
  873 			v_group g,
  874 			c_access a
  875 		WHERE
  876 		 a.user_id = ? AND a.type = 'group' AND a.magic = 'all';
  877 	};
  878 	my @bind_params = ($user_id, $user_id, $user_id);
  879 
  880 	my $sth = $DBH->prepare($sql);
  881 	$sth->execute(@bind_params) || confess "statement [$sql] failed";
  882 	my $tbl_ary_ref = $sth->fetchall_arrayref([0]);
  883 
  884 	my @result;
  885 	foreach my $row (@{$tbl_ary_ref}) {
  886 		push(@result, $row->[0]);
  887 	}
  888 
  889 	@result;
  890 }
  891 
  892 sub findAdministratableUsers
  893 {
  894 	my ($user_id, $op) = @_;
  895 
  896 	my @all_users = getUsers();
  897 
  898 	($AUTH || isSuperuser($user_id)) && return @all_users;
  899 
  900 	my @admin_groups = findAdminGroups($user_id);
  901 
  902 	my @administratable_users;
  903 	foreach my $uid (@all_users) {
  904 		my @readable = findReadableGroups($uid);
  905 		if (superset(\@admin_groups, \@readable)) {
  906 			push(@administratable_users, $uid);
  907 		}
  908 	}
  909 
  910 	return @administratable_users;
  911 }
  912 
  913 sub findAdminGroups
  914 {
  915 	my $user_id = shift;
  916 
  917 	my $sql = qq{
  918 		SELECT ref_id AS group_id
  919 		FROM c_access AS a
  920 		WHERE
  921 			a.user_id	= ?			AND
  922 			a.level		= 4			AND
  923 			a.type		= 'group'	AND
  924 			a.ref_id	IS NOT NULL
  925 
  926 		UNION
  927 
  928 		SELECT g.id AS group_id
  929 		FROM
  930 			v_group g,
  931 			c_access a
  932 		WHERE
  933 			a.user_id	= ?			AND
  934 			a.level		= 4			AND
  935 			a.type		= 'group'	AND
  936 			a.magic	= 'all';
  937 	};
  938 	my @bind_params = ($user_id, $user_id);
  939 
  940 	#$DEBUG && abslog("findAdminGroups: sql:\n\t".join("\n\t", split(/\n/,$sql)));
  941 	return dbSelectColumn($sql, 'group_id', @bind_params);
  942 }
  943 
  944 sub findAdministratableObjects
  945 {
  946 	my ($user_id, $op) = @_;
  947 
  948 	my $su = isSuperuser($user_id);
  949 
  950 	$su && return getPeople(0);
  951 
  952 	# get a list of all objects in all groups administratable by $user_id
  953 	my $sql = qq{
  954 		SELECT DISTINCT go.object_id
  955 		FROM
  956 			c_access		AS a,
  957 			v_object		AS o,
  958 			v_group			AS g,
  959 			c_group_object	AS go
  960 		WHERE
  961 			a.level			= 4				AND
  962 			a.user_id		= ?				AND
  963 			a.type			= 'group'		AND
  964 			a.ref_id		= go.group_id;
  965 	};
  966 	my @objects = dbSelectColumn($sql, 'object_id', $user_id);
  967 
  968 	my @new;
  969 
  970 	#--------------------------------------------------------
  971 	# to be allowed to delete an object, a group-admin must
  972 	# have admin privs for all groups to which the object belongs
  973 	#--------------------------------------------------------
  974 	if ($op eq 'delete') {
  975 		foreach my $object_id (@objects) {
  976 			if (adminForAllGroups($user_id, $object_id)) {
  977 				push(@new, $object_id);
  978 			}
  979 		}
  980 		@objects = @new;
  981 	}
  982 	
  983 	@new = ();
  984 	#--------------------------------------------------------
  985 	my @super_users = getSuperusers();
  986 	foreach my $oid (@objects) {
  987 		my $o_uid = findUidForObject($oid);
  988 		if (defined($o_uid) && inListN($o_uid, \@super_users)) { next; }
  989 		push(@new, $oid);
  990 	}
  991 
  992 	return @new;
  993 }
  994 
  995 sub adminForAllGroups
  996 {
  997 	my ($user_id, $object_id) = @_;
  998 
  999 	# get groups for $user_id
 1000 	my $sql = qq{
 1001 		SELECT ref_id
 1002 		FROM c_access AS a
 1003 		WHERE
 1004 			a.user_id	= ?			AND
 1005 			a.level		= 4			AND
 1006 			a.type		= 'group'	AND
 1007 			a.ref_id	IS NOT NULL;
 1008 	};
 1009 	my @u_groups = dbSelectColumn($sql, 'ref_id', $user_id);
 1010 
 1011 	my @o_groups = getObjectGroups($object_id);
 1012 
 1013 	# is $user_id admin for all groups in which $object_id is member?
 1014 	foreach my $o_gid (@o_groups) {
 1015 		inListN($o_gid, \@u_groups) || return 0;
 1016 	}
 1017 	return 1;
 1018 }
 1019 
 1020 sub getSuperusers
 1021 {
 1022 	my $sql = qq{
 1023 		SELECT a.user_id
 1024 		FROM
 1025 			c_access AS a
 1026 		WHERE
 1027 			a.type	= 'group'	AND
 1028 			a.magic	= 'all';
 1029 	};
 1030 	return dbSelectColumn($sql, 'user_id');
 1031 }
 1032 
 1033 sub isSuperuser
 1034 {
 1035 	my $user_id = shift;
 1036 
 1037 	my $sql = qq{
 1038 		SELECT id
 1039 		FROM c_access AS a
 1040 		WHERE
 1041 			a.user_id	= ?			AND
 1042 			a.level		= 4			AND
 1043 			a.type		= 'group'	AND
 1044 			a.magic		= 'all';
 1045 	};
 1046 	defined(dbSelect($sql, $user_id)) && return 1;
 1047 	return 0;
 1048 }
 1049 
 1050 sub userHasMagicAccess
 1051 {
 1052 	my ($uid, $type, $value) = @_;
 1053 
 1054 	my $sql = qq{
 1055 		SELECT level
 1056 		FROM c_access
 1057 		WHERE
 1058 			user_id	= ?			AND
 1059 			type	= ?			AND
 1060 			magic	= ?;
 1061 	};
 1062 
 1063 	my $ref = dbSelect($sql, $uid, $type, $value);
 1064 	return defined($ref) ? $ref->{level} : undef;
 1065 }
 1066 
 1067 sub deleteGidInAcls
 1068 {
 1069 	my $gid = shift;
 1070 
 1071 	my $sql = qq{
 1072 		DELETE FROM c_access
 1073 		WHERE ref_id = ?
 1074 		AND type = 'group';
 1075 	};
 1076 	$DBH->do($sql, undef, $gid);
 1077 }
 1078 
 1079 sub deletePidInAcls
 1080 {
 1081 	my $pid = shift;
 1082 
 1083 	my $sql = qq{
 1084 		DELETE FROM c_access
 1085 		WHERE ref_id = ?
 1086 		AND type = 'object';
 1087 	};
 1088 	$DBH->do($sql, undef, $pid);
 1089 }
 1090 
 1091 sub deleteUserIdInAcls
 1092 {
 1093 	my $uid = shift;
 1094 
 1095 	my $sql = qq{
 1096 		DELETE FROM c_access
 1097 		WHERE user_id = ?;
 1098 	};
 1099 	$DBH->do($sql, undef, $uid);
 1100 }
 1101 
 1102 sub setAcls
 1103 {
 1104 	my ($uid, $pacl_ref, $gacl_ref) = @_;
 1105 
 1106 	# get rid of old ACLs
 1107 	deleteUserIdInAcls($uid);
 1108 
 1109 	my $sql = qq{
 1110 		INSERT INTO c_access
 1111 			(user_id, ref_id, type, magic, level)
 1112 		VALUES
 1113 			($uid, ?, ?, ?, ?);
 1114 	};
 1115 	my $sth = $DBH->prepare($sql);
 1116 	defined($sth) || die "prepare failed on sql [$sql]";
 1117 
 1118 	my @params;
 1119 	if (defined($pacl_ref)) {
 1120 		foreach my $acl (@{ $pacl_ref }) {
 1121 			if ($acl->{target} eq 'self') {
 1122 				@params = (undef, 'object', 'self', $acl->{level});
 1123 			} elsif ($acl->{target} =~ /^\d+$/) {
 1124 				@params = ($acl->{target}, 'object', undef, $acl->{level});
 1125 			} else {
 1126 				die "target [$acl->{target}] cannot be";
 1127 			}
 1128 			$sth->execute(@params);
 1129 		}
 1130 	}
 1131 
 1132 	if (defined($gacl_ref)) {
 1133 		foreach my $acl (@{ $gacl_ref }) {
 1134 			if ($acl->{target} =~ /^(self|all)$/) {
 1135 				@params = (undef, 'group', $acl->{target}, $acl->{level});
 1136 			} elsif ($acl->{target} =~ /^\d+$/) {
 1137 				@params = ($acl->{target}, 'group', undef, $acl->{level});
 1138 			} else {
 1139 				die "target [$acl->{target}] cannot be";
 1140 			}
 1141 			$sth->execute(@params);
 1142 		}
 1143 	}
 1144 
 1145 	$sth->finish;
 1146 }
 1147 
 1148 sub deleteElementN
 1149 {
 1150 	my($elem, $lref) = @_;
 1151 
 1152 	my $count = 0;
 1153 	my $match = 0;
 1154 	foreach my $tmp (@{$lref}) {
 1155 		if ($tmp == $elem) {
 1156 			$match = 1;
 1157 			last;
 1158 		}
 1159 		$count++;
 1160 	}
 1161 
 1162 	if ($match) {
 1163 		splice(@{$lref}, $count, 1);
 1164 	}
 1165 }
 1166 
 1167 #--------------------------------------------------------------------
 1168 # Group stuff
 1169 #--------------------------------------------------------------------
 1170 
 1171 sub getGroups
 1172 {
 1173 	my $sql = qq{
 1174 		SELECT id FROM v_group;
 1175 	};
 1176 	my $aref = $DBH->selectcol_arrayref($sql);
 1177 	return @{$aref};
 1178 }
 1179 
 1180 #-------------------------------------------------------------
 1181 # getObjectGroups() get all groups to which an object belongs
 1182 #-------------------------------------------------------------
 1183 sub getObjectGroups
 1184 {
 1185 	my $oid = shift;
 1186 
 1187 	my $sql = qq{
 1188 		SELECT group_id
 1189 		FROM c_group_object
 1190 		WHERE object_id = ?;
 1191 	};
 1192 
 1193 	return dbSelectColumn($sql, 'group_id', $oid);
 1194 }
 1195 
 1196 sub getGroup
 1197 {
 1198 	my ($gid, $field) = @_;
 1199 	
 1200 	if (!groupExists(id => $gid)) {
 1201 		#print "no group with ID=[$gid]\n";
 1202 		return undef;
 1203 	}
 1204 	
 1205 	my $sql = qq{
 1206 		SELECT *
 1207 		FROM v_group
 1208 		WHERE id = ?;
 1209 	};
 1210 	my $ref = dbSelect($sql, $gid);
 1211 
 1212 	if ($field) {
 1213 		exists($ref->{$field}) || die "field [$field] unknown in group";
 1214 		return $ref->{$field};
 1215 	}
 1216 
 1217 	return $ref;
 1218 }
 1219 
 1220 sub groupCount
 1221 {
 1222 	my $sql = qq{SELECT id FROM v_group;};
 1223 	my @list = dbSelect($sql);
 1224 	return scalar(@list);
 1225 }
 1226 
 1227 #--------------------------------------------------------------------
 1228 # user stuff
 1229 #--------------------------------------------------------------------
 1230 
 1231 sub getUser
 1232 {
 1233 	my ($thing, $val, $field) = @_;
 1234 
 1235 	my $sql = qq{
 1236 		SELECT *
 1237 		FROM v_user
 1238 		WHERE $thing = ?;
 1239 	};
 1240 	my $ref = dbSelect($sql, $val);
 1241 	defined($ref) || return undef;
 1242 
 1243 	if ($field) {
 1244 		exists($ref->{$field}) || die "field [$field] unknown in c_user";
 1245 		return $ref->{$field};
 1246 	}
 1247 
 1248 	return $ref;
 1249 }
 1250 
 1251 #--------------------------------------------------------------------
 1252 # getUsers()
 1253 # 
 1254 # if first param is 'all', then returns a list of all user IDs known
 1255 # with no params, returns a list of user IDs for users not associated
 1256 # with objects
 1257 #--------------------------------------------------------------------
 1258 sub getUsers
 1259 {
 1260 	my $all = shift;
 1261 
 1262 	my $sql;
 1263 	if ($all eq 'all') {
 1264 		$sql = qq{ SELECT id FROM v_user; };
 1265 	} else {
 1266 		$sql = qq{
 1267 			SELECT v_user.id
 1268 			FROM v_user
 1269 			WHERE v_user.object_id IS NULL;
 1270 		};
 1271 	}
 1272 	my $aref = $DBH->selectcol_arrayref($sql);
 1273 	defined($aref) && return (@{$aref});
 1274 	return ();
 1275 }
 1276 
 1277 #-------------------------------------------------------------
 1278 # getUserGroups() get all groups to which a user's object belongs
 1279 #-------------------------------------------------------------
 1280 sub getUserGroups
 1281 {
 1282 	my $uid = shift;
 1283 
 1284 	my $sql = qq{
 1285 		SELECT go.group_id
 1286 		FROM
 1287 			c_group_object	AS go,
 1288 			v_user			AS u
 1289 		WHERE
 1290 			u.id			= ?	AND
 1291 			go.object_id	= u.object_id;
 1292 	};
 1293 
 1294 	return dbSelectColumn($sql, 'group_id', $uid);
 1295 }
 1296 
 1297 # ROBBO: check what callers of setPassword expect to pass as uid...
 1298 sub setPassword
 1299 {
 1300 	my ($uid, $password) = @_;
 1301 
 1302 	$DEBUG && abslog(["changePassword: start: user_id=[$uid]",
 1303 		"password=[$password]"]);
 1304 
 1305 	#my $ret = checkLengths('c_user', {
 1306 	#	password	=> $password,
 1307 	#};
 1308 	#$ret && return "baddata: $ret";
 1309 
 1310 	if (!userExists(id => $uid)) {
 1311 		return 'disappeared';
 1312 	}
 1313 
 1314 	my $new_pw = ($PW_HASH_FORMAT eq 'md5')
 1315 		? md5_base64($password)
 1316 		: $password;
 1317 
 1318 	if ($CRED_SRC eq 'absence') {
 1319 		my $sql = qq{
 1320 			UPDATE c_user SET password = ? WHERE id = ?;
 1321 		};
 1322 		$DBH->do($sql, undef, $new_pw, $uid);
 1323 	} elsif ($CRED_SRC eq 'htaccess') {
 1324 		# TODO
 1325 		my $ret = setHtaccessPassword($uid, $password);
 1326 		if ($ret) { return 'error'; }
 1327 	} else {
 1328 		die "unimplemented method [$CRED_SRC]";
 1329 	}
 1330 
 1331 	return 'ok';
 1332 }
 1333 
 1334 #--------------------------------------------------------------------
 1335 # setHtaccessPassword() is an EXAMPLE of how you could
 1336 # implement password management for HTTP authentication.
 1337 # Unless you're using SSL, using this method means you
 1338 # will be sending cleartext passwords over the network.
 1339 # If you do not want to use absence to manage your passwords
 1340 # (for example if you are using HTTP Digest authentication
 1341 # in order to avoid sending cleartext passwords over the
 1342 # network) then you should set "manage_password" in the
 1343 # configuration to "no".  You will need to come up with
 1344 # your own method of managing passwords.
 1345 #--------------------------------------------------------------------
 1346 sub setHtaccessPassword
 1347 {
 1348 	my ($uid, $password) = @_;
 1349 
 1350 	my $username = getUser(id => $uid, 'username');
 1351 
 1352 	my $htaccess = AbsenceConfig::fetch('htaccess_path');
 1353 	my @cmd = ('htpasswd', '-b', $htaccess, $username, $password);
 1354 
 1355 	#dbg("running cmd: ".join(' ', @cmd);
 1356 
 1357 	my ($wfh, $rfh);
 1358 	my $pid = open3($wfh, $rfh, undef, @cmd);
 1359 	close($wfh);
 1360 	my $out;
 1361 	while(<$rfh>) {
 1362 		$out .= $_;
 1363 	}
 1364 	close($rfh);
 1365 
 1366 	waitpid($pid, 0);
 1367 	my $status = $? >> 8;
 1368 	chomp($out);
 1369 
 1370 	#dbg("output: [$out]");
 1371 
 1372 	if ($status) {
 1373 		abslog("setHtaccessPassword: external command failed. rc=$status, output:\n$out");
 1374 	}
 1375 	return $status;
 1376 }
 1377 
 1378 # ROBBO: modify callers of modifyUser() to pass uid and not username
 1379 sub modifyUser
 1380 {
 1381 	my ($uid, $password, $pacl, $gacl) = @_;
 1382 
 1383 	$DEBUG && abslog(["modifyUser: start: user_id=[$uid]",
 1384 		"password=[$password]",
 1385 		"pacl=[$pacl]", "gacl=[$gacl]"]);
 1386 
 1387 	#my $ret = checkLengths('c_user', {
 1388 	#	password	=> $password,
 1389 	#};
 1390 	$ret && return "baddata: $ret";
 1391 
 1392 	if (!userExists(id => $uid)) {
 1393 		return 'disappeared';
 1394 	}
 1395 	my $u_ref = getUser('id' => $uid);
 1396 
 1397 	my $new_pw = (($u_ref->{password} ne $password) && ($PW_HASH_FORMAT eq 'md5'))
 1398 		? md5_base64($password)
 1399 		: $password;
 1400 
 1401 	my $sql;
 1402 	if ($CRED_SRC eq 'absence') {
 1403 		$sql = qq{
 1404 			UPDATE c_user
 1405 			SET password = ?
 1406 			WHERE id = ?;
 1407 		};
 1408 	} elsif ($CRED_SRC ne 'htaccess') {
 1409 		die "unimplemented method [$CRED_SRC]";
 1410 	}
 1411 
 1412 	if ($CRED_SRC eq 'htaccess') {
 1413 		# modify user in some ".htpasswd" file
 1414 		my $out = setHtaccessPassword($uid, $password);
 1415 	}
 1416 
 1417 	setAcls($uid, $pacl, $gacl);
 1418 
 1419 	$DBH->do($sql, undef, $new_pw, $uid);
 1420 
 1421 	abslog([
 1422 		"modify-user: username=[$u_ref->{username}]",
 1423 		'pacl='.join(',', map { "$_->{level}:$_->{target}" } @{$pacl}),
 1424 		'gacl='.join(',', map { "$_->{level}:$_->{target}" } @{$gacl}),
 1425 	]);
 1426 
 1427 	return 'ok';
 1428 }
 1429 
 1430 #--------------------------------------------------------------------
 1431 # addUser()
 1432 # 
 1433 # add a 'user' entity to the DB, possibly also adding pacl/gacl records
 1434 # input:
 1435 # $pacl
 1436 # 	a reference to an array of hashes of the form:
 1437 # 	[
 1438 # 		{ level => <level>, oid => <oid> },
 1439 # 		{ level => <level>, oid => <oid> },
 1440 # 	...
 1441 # 	]
 1442 # 	where <oid> is an object-ID (integer), or the string 'self',
 1443 # 	and <level> is 1, 2, or 4 for read, write, and admin, respectively
 1444 # $gacl
 1445 # 	a reference to an array of scalars of the form:
 1446 # 	[
 1447 # 		{ level => <level>, gid => <oid> },
 1448 # 		{ level => <level>, gid => <oid> },
 1449 # 	...
 1450 # 	]
 1451 # 	where <gid> is a group-ID, 'self', or 'all' and <level> is
 1452 # 	1, 2, or 4, as above
 1453 #--------------------------------------------------------------------
 1454 sub addUser
 1455 {
 1456 	my ($username, $password, $pacl, $gacl) = @_;
 1457 
 1458 	$DEBUG && abslog(["addUser: start: user_id=[$username]",
 1459 		"password=[$password]",
 1460 		'pacl=['.acl2string($pacl).']', 'gacl=['.acl2string($gacl).']']);
 1461 
 1462 	#my $ret = checkLengths('c_user', {
 1463 	#	username	=> $username,
 1464 	#	password	=> $password,
 1465 	#};
 1466 	#$ret && return "baddata: $ret";
 1467 
 1468 	if (userExists(username => $username)) {
 1469 		return 'duplicate';
 1470 	}
 1471 
 1472 	my $uid = _addUser($username, $password, $pacl, $gacl);
 1473 
 1474 	abslog([
 1475 		"add-user: username=[$username]",
 1476 		#"password=[$password]",
 1477 		'pacl='.join(',', map { "$_->{level}:$_->{target}" } @{$pacl}),
 1478 		'gacl='.join(',', map { "$_->{level}:$_->{target}" } @{$gacl}),
 1479 	]);
 1480 
 1481 	return wantarray ? ('ok', $uid) : 'ok';
 1482 }
 1483 
 1484 sub acl2string
 1485 {
 1486 	my $acl_list = shift;
 1487 
 1488 	return join(',', map { "$_->{level}:$_->{target}" } @{$acl});
 1489 }
 1490 
 1491 # ROBBO: check why I used _adduser() inside of adduser()
 1492 # answer: because I need it for addPerson too...
 1493 sub _addUser
 1494 {
 1495 	my ($username, $password, $pacl_ref, $gacl_ref, $oid) = @_;
 1496 
 1497 	my @fields = qw(username);
 1498 	my @values = ($username);
 1499 
 1500 	if (defined($oid)) {
 1501 		push(@fields, 'object_id');
 1502 		push(@values, $oid);
 1503 	}
 1504 
 1505 	if ($CRED_SRC eq 'absence') {
 1506 		my $pw = ($PW_HASH_FORMAT eq 'md5')
 1507 			? md5_base64($password)
 1508 			: $password;
 1509 		push(@fields, 'password');
 1510 		push(@values, $pw);
 1511 	} elsif ($CRED_SRC ne 'htaccess') {
 1512 		die "unimplemented method [$CRED_SRC]";
 1513 	}
 1514 
 1515 	my $fields = join(',', @fields);
 1516 	my $binds = join(',', map '?', @values);
 1517 
 1518 	my $sql = qq{
 1519 		INSERT INTO c_user
 1520 		($fields)
 1521 		VALUES ($binds);
 1522 	};
 1523 
 1524 	my $uid = insertRowRetrieveSequence('c_user', $sql, @values);
 1525 
 1526 	# now handle pacl/gacl
 1527 	setAcls($uid, $pacl_ref, $gacl_ref);
 1528 
 1529 	if ($CRED_SRC eq 'htaccess') {
 1530 		my $ret = setHtaccessPassword($uid, $password);
 1531 		$ret && die "error while setting htaccess pw: $ret";
 1532 	}
 1533 
 1534 	return $uid;
 1535 }
 1536 
 1537 sub deleteAccessControlForUser
 1538 {
 1539 	my $user_id = shift;
 1540 
 1541 	my $sql = qq{
 1542 		DELETE FROM c_access
 1543 		WHERE user_id = ?;
 1544 	};
 1545 	$DBH->do($sql, undef, $user_id);
 1546 }
 1547 
 1548 sub deleteUser
 1549 {
 1550 	my $uid = shift;
 1551 
 1552 	$DEBUG && abslog("delete-user: user_id=[$uid]");
 1553 
 1554 	_deleteUser($uid);
 1555 
 1556 	return 'ok';
 1557 }
 1558 
 1559 sub _deleteUser
 1560 {
 1561 	my $uid = shift;
 1562 
 1563 	#my $now = time();
 1564 
 1565 	# this must happen first!
 1566 	deleteUserIdInAcls($uid);
 1567 
 1568 	my $sql = qq{
 1569 		DELETE FROM c_user WHERE id = ?;
 1570 	};
 1571 	$DBH->do($sql, undef, $uid);
 1572 }
 1573 
 1574 #--------------------------------------------------------------------
 1575 # person stuff
 1576 #--------------------------------------------------------------------
 1577 sub addPerson
 1578 {
 1579 	my ($pid, $name, $username, $email, $gref, $pw, $pacl, $gacl) = @_;
 1580 
 1581 	$DEBUG && abslog(["addPerson: start: pid=[$pid], name=[$name]",
 1582 		"username=[$username]",
 1583 		"email=[$email]", "groups=[@{$gref}]"]);
 1584 
 1585 	my $verb;
 1586 	my $old_pw;
 1587 	my $sql;
 1588 	my $uid;
 1589 
 1590 	if ($pid eq 'new') {
 1591 		#-------------------------------------------------
 1592 		# CREATE
 1593 		#-------------------------------------------------
 1594 		if (objectExists(name => $name)) {
 1595 			return 'duplicate-name';
 1596 		} elsif ($AUTH && $OAP && userExists(username => $username)) {
 1597 			return 'duplicate-uid';
 1598 		}
 1599 		$verb = 'add-person';
 1600 
 1601 		$sql = qq{
 1602 			INSERT INTO c_object
 1603 				(name,email)
 1604 			VALUES (?,?);
 1605 		};
 1606 
 1607 		$DBH->begin_work;
 1608 		$pid = insertRowRetrieveSequence('c_object', $sql, $name, $email);
 1609 		#$DBH->do($sql, undef, $name, $email);
 1610 
 1611 		my $xact_ok = 1;
 1612 		if ($OAP && $AUTH) {
 1613 			# RaiseError is set, so if _addUser fails, script
 1614 			# will terminate, and trasaction will not be completed
 1615 			$uid = _addUser($username, $pw, $pacl, $gacl, $pid);
 1616 		}
 1617 		addGroupMappings($pid, @{$gref});
 1618 		$DBH->commit;
 1619 	} else {
 1620 		#-------------------------------------------------
 1621 		# UPDATE
 1622 		#-------------------------------------------------
 1623 		if (!objectExists(id => $pid)) {
 1624 			die "error: attempt to modify a non-existent person [$pid]";
 1625 		}
 1626 		$verb = 'modify-person';
 1627 
 1628 		$sql = qq{
 1629 			UPDATE c_object
 1630 				SET name = '$name', email = '$email'
 1631 				WHERE id = ?;
 1632 		};
 1633 
 1634 		$DBH->begin_work;
 1635 		$DBH->do($sql, undef, $pid);
 1636 		if ($OAP && $AUTH) {
 1637 			$uid = findUidForObject($pid);
 1638 			if (defined($uid)) {
 1639 				my $rv = modifyUser($uid, $pw, $pacl, $gacl);
 1640 				if ($rv ne 'ok') {
 1641 					$DBH->rollback;
 1642 					return 'error';
 1643 				}
 1644 			} else {
 1645 				if (userExists(username => $username)) {
 1646 					$DBH->rollback;
 1647 					return 'duplicate-username';
 1648 				}
 1649 				$uid = _addUser($username, $pw, $pacl, $gacl, $pid);
 1650 			}
 1651 		}
 1652 		deleteGroupMappings($pid);
 1653 		addGroupMappings($pid, @{$gref});
 1654 		$DBH->commit;
 1655 	}
 1656 
 1657 	abslog(["$verb: pid=[$pid]", "name=[$name]", "username=[$username]",
 1658 		"email=[$email]", "groups = [@{$gref}]"]);
 1659 
 1660 	return wantarray ? ('ok', $pid, $uid) : 'ok';
 1661 }
 1662 
 1663 sub findUidForObject
 1664 {
 1665 	my $oid = shift;
 1666 
 1667 	my $sql = qq{
 1668 		SELECT id
 1669 		FROM v_user
 1670 		WHERE object_id = ?;
 1671 	};
 1672 	my $ref = dbSelect($sql, $oid);
 1673 	return defined($ref) ? $ref->{id} : undef;
 1674 }
 1675 
 1676 sub deletePerson
 1677 {
 1678 	my $pid = shift;
 1679 
 1680 	#abslog("deletePerson: deleting id=[$pid]");
 1681 
 1682 	if (!objectExists(id => $pid)) {
 1683 		abslog("deletePerson: id=[$pid] not found");
 1684 		return 'bad-id';
 1685 	}
 1686 
 1687 	_deleteObject($pid);
 1688 
 1689 	$AUTH && deletePidInAcls($pid);
 1690 
 1691 	return 'ok';
 1692 }
 1693 
 1694 #----------------------------------------------------------------------
 1695 # this is the internal version.
 1696 #----------------------------------------------------------------------
 1697 sub _deleteObject
 1698 {
 1699 	my $oid = shift;
 1700 
 1701 	#----------------------------------------------------------
 1702 	# delete all mappings for object
 1703 	#----------------------------------------------------------
 1704 	my $sql = qq{
 1705 		DELETE FROM c_group_object
 1706 		WHERE object_id = $oid;
 1707 	};
 1708 	$DBH->do($sql);
 1709 
 1710 	#----------------------------------------------------------
 1711 	# invalidate all reservations of this object
 1712 	# well, actually, just delete the row.  someday I may use
 1713 	# invalidation
 1714 	#----------------------------------------------------------
 1715 	#my $now = time();
 1716 	#$sql = qq{
 1717 	#	UPDATE d_reservation
 1718 	#	SET invalidated = int2tsz($now)
 1719 	#	WHERE object_id = $oid;
 1720 	#};
 1721 	$sql = qq{
 1722 		DELETE FROM d_reservation
 1723 		WHERE object_id = ?;
 1724 	};
 1725 	$DBH->do($sql, undef, $oid);
 1726 
 1727 	#----------------------------------------------------------
 1728 	# remember user-id for later
 1729 	#----------------------------------------------------------
 1730 	my $user_id = findUidForObject($oid);
 1731 
 1732 	#----------------------------------------------------------
 1733 	# remember name for logging
 1734 	#----------------------------------------------------------
 1735 	my $name = getPerson($oid, 'name');
 1736 	abslog("deleting object: oid=[$oid], name=[$name]");
 1737 
 1738 	#----------------------------------------------------------
 1739 	# delete associated user, if necessary
 1740 	# must be done *before* object is deleted
 1741 	#----------------------------------------------------------
 1742 	if ($OAP && $AUTH) {
 1743 		if (!defined($user_id)) {
 1744 			abslog("_deleteObject, deleted object [$oid], auth enabled, but no user_id found for that object");
 1745 		}
 1746 		_deleteUser($user_id);
 1747 	}
 1748 
 1749 	#----------------------------------------------------------
 1750 	# delete row.  someday I may invalidate...
 1751 	# 
 1752 	#----------------------------------------------------------
 1753 	#$sql = qq{
 1754 	#	UPDATE c_object
 1755 	#	SET invalidated = int2tsz($now)
 1756 	#	WHERE id = $oid;
 1757 	#};
 1758 	#----------------------------------------------------------
 1759 
 1760 	$sql = qq{
 1761 		DELETE FROM c_object
 1762 		WHERE id = ?;
 1763 	};
 1764 	$DBH->do($sql, undef, $oid);
 1765 }
 1766 
 1767 #----------------------------------------------------------------------
 1768 # addReservation()
 1769 #
 1770 # adds or modifies a reservation for a person.
 1771 # $start and $end are dates in the form
 1772 #	{ day => $day, month => $month, year => $year }
 1773 #
 1774 #----------------------------------------------------------------------
 1775 
 1776 
 1777 sub addReservation
 1778 {
 1779 	my ($res_id, $person_id, $start, $end, $type_id, $desc) = @_;
 1780 
 1781 	my $s = "$start->{year}-$start->{month}-$start->{day}";
 1782 	my $e = "$end->{year}-$end->{month}-$end->{day}";
 1783 
 1784 	if ($DEBUG) {
 1785 		abslog("addReservation: rid=$res_id, pid=$person_id, start=$s, end=$e, type_id=$type_id, desc=[$desc]");
 1786 	}
 1787 
 1788 	my $new = 0;
 1789 	my $verb;
 1790 	my $sql;
 1791 	my ($old_s, $old_e);
 1792 
 1793 	if ($res_id eq 'new') {
 1794 		$new = 1;
 1795 		$verb = 'add-reservation';
 1796 	} else {
 1797 		my $ref = getReservation($res_id);
 1798 		if (!defined($ref)) {
 1799 			abslog("error: attempt to modify non-existent reservation [$res_id]");
 1800 			return ('disappeared');
 1801 		}
 1802 		# a reservation is being modified, I need the old start/end dates
 1803 		$old_s = $ref->{start};
 1804 		$old_e = $ref->{finish};
 1805 		$verb = 'modify-reservation';
 1806 		$DEBUG && abslog("old: start=$ref->{start}, finish=$ref->{finish}");
 1807 	}
 1808 
 1809 	#----------------------------------------------------------
 1810 	# check if either starting or ending day is past end of
 1811 	# corresponding month...
 1812 	#----------------------------------------------------------
 1813 	if (($start->{day} > AbsenceDate::daysInMonth($start->{month})) ||
 1814 		($end->{day} > AbsenceDate::daysInMonth($end->{month})))
 1815 	{
 1816 		return ('badday');
 1817 	}
 1818 
 1819 	my $sjd = AbsenceDate::julianDay($start);
 1820 	my $ejd = AbsenceDate::julianDay($end);
 1821 	($sjd > $ejd) && return ('impossible');
 1822 
 1823 	#my ($ret, $id) = resConflict($res_id, $person_id, $start, $end, $type_id);
 1824 	my $ret = resConflict($res_id, $person_id, $start, $end, $type_id);
 1825 
 1826 	#($ret eq 'bad') && return ('conflict', $id);
 1827 
 1828 	if (defined($ret)) {
 1829 		abslog("resConflict found conflict");
 1830 		return ('conflict', $ret);
 1831 	}
 1832 
 1833 	abslog(
 1834 		[
 1835 			"$verb: res=[$res_id]",
 1836 			"person-id = [$person_id]",
 1837 			"start = [$s]",
 1838 			"end = [$e]",
 1839 			"type = [$type_id]",
 1840 			"desc = [$desc]",
 1841 		]
 1842 	);
 1843 
 1844 	_addReservation($res_id, $person_id, $start, $end, $type_id, $desc);
 1845 
 1846 	my @o_groups = getObjectGroups($person_id);
 1847 
 1848 	if (!$new) {
 1849 		my $s = convToAbsenceDate($old_s);
 1850 		my $e = convToAbsenceDate($old_e);
 1851 		updateModificationTimes(\@o_groups, $s, $e);
 1852 	}
 1853 	updateModificationTimes(\@o_groups, $start, $end);
 1854 
 1855 	$DEBUG && abslog("addReservation: success");
 1856 
 1857 	return ('ok');
 1858 }
 1859 
 1860 #----------------------------------------------------------------------
 1861 # updateModificationTimes()
 1862 #
 1863 # parameters:
 1864 #	$s, $e references to dates in the form:
 1865 #		[<day>, <month>, <year>]
 1866 #----------------------------------------------------------------------
 1867 
 1868 sub updateModificationTimes
 1869 {
 1870 	# ROBBO TODO: check format of $s and $e
 1871 
 1872 	my ($gref, $s, $e) = @_;
 1873 
 1874 	if ($DEBUG) {
 1875 		my $tmp = join(',', @{$gref});
 1876 		my $start = "$s->{month}/$s->{year}";
 1877 		my $end = "$e->{month}/$s->{year}";
 1878 		abslog("updateModificationTimes: grps: [$tmp], s: [$start], e: [$end]");
 1879 	}
 1880 
 1881 	# modify in-memory hash
 1882 	my $month = $s->{month};
 1883 	my $year = $s->{year};
 1884 
 1885 	my $end = $e->{year} * 12 + $e->{month};
 1886 
 1887 	my $now = time();
 1888 
 1889 	while(($year*12+$month) <= $end) {
 1890 		$DEBUG && abslog("updModTime: updating y=$year, m=$month");
 1891 		foreach my $gid (@{$gref}) {
 1892 			updateMonthModTime($gid, $month, $year);
 1893 		}
 1894 		if ($month == 12) {
 1895 			$year++;
 1896 			$month = 1;
 1897 		} else {
 1898 			$month++;
 1899 		}
 1900 	}
 1901 }
 1902 
 1903 sub updateMonthModTime
 1904 {
 1905 	my ($gid, $month, $year) = @_;
 1906 
 1907 	my $now = time();
 1908 
 1909 	my $update_sql = qq{
 1910 		UPDATE d_group_mod_time
 1911 		SET mod_time = $now
 1912 		WHERE group_id = ?
 1913 		AND month = ?
 1914 		AND year = ?;
 1915 	};
 1916 	my $rv = $DBH->do($update_sql, undef, $gid, $month, $year);
 1917 	defined($rv) || die "update mmt, rv=undef, sql=[$update_sql]";
 1918 	if ($rv == 0) {
 1919 		my $insert_sql = qq{
 1920 			INSERT INTO d_group_mod_time
 1921 			(group_id,month,year,mod_time)
 1922 			VALUES (?,?,?,$now);
 1923 		};
 1924 		$rv = $DBH->do($insert_sql, undef, $gid, $month, $year);
 1925 		defined($rv) || die "insert mmt, rv=undef, sql=[$insert_sql]";
 1926 	}
 1927 }
 1928 
 1929 sub updateImageDimensions
 1930 {
 1931 	my ($gid, $month, $year, $width, $height) = @_;
 1932 
 1933 	my $update_sql = qq{
 1934 		UPDATE d_group_mod_time
 1935 		SET image_width = $width, image_height = $height
 1936 		WHERE group_id = ?
 1937 		AND month = ?
 1938 		AND year = ?;
 1939 	};
 1940 	my $rv = $DBH->do($update_sql, undef, $gid, $month, $year);
 1941 	defined($rv) || die "update mmt, rv=undef, sql=[$update_sql]";
 1942 	if ($rv == 0) {
 1943 		my $insert_sql = qq{
 1944 			INSERT INTO d_group_mod_time
 1945 			(group_id,month,year,image_width,image_height)
 1946 			VALUES (?,?,?,$width,$height);
 1947 		};
 1948 		$rv = $DBH->do($insert_sql, undef, $gid, $month, $year);
 1949 		defined($rv) || die "insert mmt, rv=undef, sql=[$insert_sql]";
 1950 	}
 1951 }
 1952 
 1953 #------------------------------------------------------------------
 1954 # updateMonthModTimes()
 1955 #
 1956 # is passed the group-id and a structure of the form:
 1957 #	$ref = {
 1958 #		<year1> = {
 1959 #			<month1> = <time>,
 1960 #			<month2> = <time>,
 1961 #		},
 1962 #		<year2> = {
 1963 #			<month1> = <time>,
 1964 #			<month2> = <time>,
 1965 #		},
 1966 #	}
 1967 #------------------------------------------------------------------
 1968 sub updateMonthModTimes
 1969 {
 1970 	my ($gid, $mref) = @_;
 1971 
 1972 	foreach my $year (keys(%{$mref})) {
 1973 		foreach my $month (keys(%{$mref->{$year}})) {
 1974 			updateMonthModTime($gid, $month, $year);
 1975 			$DEBUG && abslog("updating mmt for [gid=$gid,$month/$year]");
 1976 		}
 1977 	}
 1978 }
 1979 
 1980 sub getModificationTime
 1981 {
 1982 	my ($gid, $month, $year) = @_;
 1983 
 1984 	#$DEBUG && abslog("getModificationTime: lookup: gid=$gid, m=$month, y=$year");
 1985 
 1986 	my $sql = qq{
 1987 		SELECT mod_time
 1988 		FROM d_group_mod_time
 1989 		WHERE group_id = ?
 1990 		AND month = ?
 1991 		AND year = ?;
 1992 	};
 1993 	my $ref = dbSelect($sql, $gid, $month, $year);
 1994 
 1995 	if (defined($ref)) {
 1996 		return $ref->{mod_time};
 1997 	} else {
 1998 		$DEBUG && abslog("getModificationTime: returning [undef]");
 1999 		return undef;
 2000 	}
 2001 }
 2002 
 2003 sub getImageDimensions
 2004 {
 2005 	my ($gid, $month, $year) = @_;
 2006 
 2007 	#$DEBUG && abslog("getImageDimensions: lookup: gid=$gid, m=$month, y=$year");
 2008 
 2009 	my $sql = qq{
 2010 		SELECT image_width, image_height
 2011 		FROM d_group_mod_time
 2012 		WHERE group_id = ?
 2013 		AND month = ?
 2014 		AND year = ?;
 2015 	};
 2016 	my $ref = dbSelect($sql, $gid, $month, $year);
 2017 
 2018 	if (defined($ref)) {
 2019 		return ($ref->{image_width}, $ref->{image_height});
 2020 	} else {
 2021 		$DEBUG && abslog("getImageDimensions: returning [undef]");
 2022 		return undef;
 2023 	}
 2024 }
 2025 
 2026 sub deleteReservation
 2027 {
 2028 	my $res_id = shift;
 2029 
 2030 	my $res = getReservation($res_id);
 2031 
 2032 	if (!defined($res)) {
 2033 		# someone else got there first
 2034 		abslog("deleteReservation: ID [$res_id] disappeared (overlapping ops)");
 2035 		return 'conflict';
 2036 	}
 2037 
 2038 	my ($start, $end) = ($res->{start}, $res->{finish});
 2039 
 2040 	my $pid = $res->{object_id};
 2041 	#invalidateReservations(object_id => $res_id);
 2042 	deleteReservations(id => $res_id);
 2043 
 2044 	# piggy-back onto DB-lock
 2045 	my @o_groups = AbsenceDB::getObjectGroups($pid);
 2046 	my $s = convToAbsenceDate($res->{start});
 2047 	my $e = convToAbsenceDate($res->{finish});
 2048 	updateModificationTimes(\@o_groups, $s, $e);
 2049 
 2050 	abslog("deleteReservation: res-id=[$res_id]");
 2051 
 2052 	return 'ok';
 2053 }
 2054 
 2055 #----------------------------------------------------------------
 2056 # convToDbDate()
 2057 #
 2058 # input:
 2059 # 	a reference to an array with form [ $day, $month, $year ]
 2060 #
 2061 # returns:
 2062 # 	a string of form "YYYY-MM-DD"
 2063 #----------------------------------------------------------------
 2064 sub convToDbDate($)
 2065 {
 2066 	#return join('-', reverse(@{ $_[0] }));
 2067 	my $r = shift;
 2068 	return join('-', $r->{year}, $r->{month}, $r->{day});
 2069 }
 2070 
 2071 #----------------------------------------------------------------
 2072 # convToAbsenceDate()
 2073 #
 2074 # does reverse of convToDbDate()
 2075 #----------------------------------------------------------------
 2076 sub convToAbsenceDate($)
 2077 {
 2078 	my ($year, $mon, $day) = split('-', $_[0]);
 2079 	#return ( $day, $mon, $year );
 2080 	return { day => int($day), month => int($mon), year => $year };
 2081 }
 2082 
 2083 sub resConflict
 2084 {
 2085 	my ($res_id, $pid, $start, $end, $type_id) = @_;
 2086 
 2087 	#abslog("resConflict: res-id=[$res_id]");
 2088 
 2089 	if (!$MULTI_RES) {
 2090 		my $db_start = convToDbDate($start);
 2091 		my $db_finish = convToDbDate($end);
 2092 
 2093 		my @bind_params = ($pid);
 2094 		my $avoid_existing_res;
 2095 		if ($res_id =~ /^\d+$/) {
 2096 			$avoid_existing_res = qq{(id != ?) AND};
 2097 			push(@bind_params, $res_id);
 2098 		}
 2099 		my $sql = qq{
 2100 			SELECT id
 2101 				FROM v_reservation
 2102 			WHERE
 2103 				(object_id = ?) AND $avoid_existing_res (
 2104 					(start  >= ? AND start <= ?) OR
 2105 					(finish >= ? AND start <= ?) OR
 2106 					(start  <  ? AND finish > ?)
 2107 			);
 2108 		};
 2109 		my @tmp = ($db_start, $db_finish);
 2110 		push(@bind_params, @tmp, @tmp, @tmp);
 2111 
 2112 		my $ref = dbSelect($sql, @bind_params);
 2113 		#$DEBUG && abslog("SQL: $sql");
 2114 
 2115 		return defined($ref) ? { type => 'simple', res => $ref } : undef;
 2116 	}
 2117 
 2118 	#------------------------------------------------------------
 2119 	# multiple reservations are enabled
 2120 	#------------------------------------------------------------
 2121 
 2122 	my ($month, $year) = ($start->{month}, $start->{year});
 2123 	my $jm_end = $end->{year} * 12 + $end->{month};
 2124 	my $jm;
 2125 	my $conflict;
 2126 	do {
 2127 		my ($sd, $ed)
 2128 			= getMonthBounds($start, $end, $month, $year);
 2129 		my $myres = {
 2130 			res		=> { id => $res_id, type_id => $type_id },
 2131 			bounds	=> { start => $sd, end => $ed },
 2132 		};
 2133 		$jm = $year * 12 + $month;
 2134 		my @mres_list = getMonthReservations($pid, $month, $year);
 2135 		my @orig_list = @mres_list;
 2136 
 2137 		#----------------------------------------------------------
 2138 		# if I am modifying a reservation, I need to remove the old
 2139 		# reservation from the list to check
 2140 		#----------------------------------------------------------
 2141 		if ($res_id ne 'new') {
 2142 			my @tmp;
 2143 			foreach my $mres (@mres_list) {
 2144 				if ($mres->{res}->{id} != $res_id) {
 2145 					push(@tmp, $mres);
 2146 					#abslog("  adding id=[$mres->{res}->{id}] to list to check");
 2147 				}
 2148 			}
 2149 			@mres_list = @tmp;
 2150 		}
 2151 
 2152 		push(@mres_list, $myres);
 2153 		my $layout = AbsenceImage::layoutObjectRow(\@mres_list, $month, $year);
 2154 		#---------------------------------------------------------
 2155 		# check if row would grow beyond allowed boundary
 2156 		#---------------------------------------------------------
 2157 		my $max_slot = $MAX_MULTI * $FULL_SLOTS - 1;
 2158 		if ($layout->{last_slot} > $max_slot) {
 2159 			# must check if result would be same without new res
 2160 			my $lo2 = AbsenceImage::layoutObjectRow(\@orig_list, $month, $year);
 2161 			if ($lo2->{last_slot} != $layout->{last_slot}) {
 2162 				#$conflict = { type => 'height' };
 2163 				#last;
 2164 				return {
 2165 					type	=> 'no_space',
 2166 					month	=> $month,
 2167 					year	=> $year,
 2168 				};
 2169 			}
 2170 		}
 2171 
 2172 		#---------------------------------------------------------
 2173 		# check if there is any illegal coincidence
 2174 		#---------------------------------------------------------
 2175 		my $type_class = getTypeClass($type_id);
 2176 
 2177 		if (defined($layout->{error})) {
 2178 			foreach my $err (@{ $layout->{error} }) {
 2179 				if ($type_class eq 'block') {
 2180 					if ($err->{type} eq 'b_coincidence' &&
 2181 						($err->{ids}->[0] eq $res_id ||
 2182 						$err->{ids}->[1] eq $res_id))
 2183 					{
 2184 						return $err;
 2185 					}
 2186 				} else {
 2187 					if ($err->{type} eq 'nb_coincidence' &&
 2188 						($err->{ids}->[0] eq $res_id ||
 2189 						$err->{ids}->[1] eq $res_id))
 2190 					{
 2191 						return $err;
 2192 					}
 2193 				}
 2194 			}
 2195 		}
 2196 
 2197 		#{
 2198 		#	$conflict = 1;
 2199 		#	$jm = $jm_end;
 2200 		#}
 2201 
 2202 		if ($month == 12) {
 2203 			$month = 1; $year++;
 2204 		} else {
 2205 			$month++;
 2206 		}
 2207 	} while ($jm < $jm_end);
 2208 
 2209 	return undef;
 2210 }
 2211 
 2212 sub _addReservation
 2213 {
 2214 	my ($res_id, $person_id, $start, $end, $type_id, $desc) = @_;
 2215 
 2216 	$DEBUG && abslog("_addReservation: res_id = [$res_id].");
 2217 
 2218 	my $s = convToDbDate($start);
 2219 	my $e = convToDbDate($end);
 2220 
 2221 	my $sql;
 2222 	my @bind_params;
 2223 	if ($res_id eq 'new') {
 2224 		$sql = qq{
 2225 			INSERT INTO d_reservation
 2226 			(object_id,type_id,start,finish,description)
 2227 			VALUES (?,?,?,?,?);
 2228 		};
 2229 		@bind_params = ($person_id,$type_id,$s,$e,$desc);
 2230 	} else {
 2231 		$sql = qq{
 2232 			UPDATE d_reservation
 2233 			SET
 2234 				start		= ?,
 2235 				finish		= ?,
 2236 				type_id		= ?,
 2237 				description	= ?
 2238 			WHERE id = ?;
 2239 		};
 2240 		@bind_params = ($s, $e, $type_id, $desc, $res_id);
 2241 	}
 2242 
 2243 	return $DBH->do($sql, undef, @bind_params);
 2244 }
 2245 
 2246 sub timestamp
 2247 {
 2248 	my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 2249 	my ($sec,$min,$hour,$mday,$mon,$year,@junk) = localtime(time);
 2250 
 2251 	return sprintf("%d-%s-%d %02d:%02d",
 2252 		$mday, $months[$mon], $year+1900, $hour, $min);
 2253 }
 2254 
 2255 sub dbg
 2256 {
 2257 	my $msg = shift;
 2258 
 2259 	$DEBUG && abslog("DEBUG: $msg");
 2260 }
 2261 
 2262 #===========================================================================
 2263 #-------------------------------------------------------------------
 2264 # dbSelect()
 2265 #
 2266 # performs a generic query using fetchrow_hashref and returns:
 2267 #
 2268 #       (array context) references to the row-hashes
 2269 #       (scalar context) reference to first row
 2270 #
 2271 #-------------------------------------------------------------------
 2272 sub dbSelectColumn
 2273 {
 2274 	my ($sql, $col, @bind_params) = @_;
 2275 
 2276 	my $sth;
 2277 	eval {
 2278 		$sth = $DBH->prepare($sql);
 2279 	};
 2280 	if ($@) {
 2281 		confess $@;
 2282 	}
 2283 	defined($sth) || die "prepare failed on sql [$sql]";
 2284 
 2285 	$sth->execute(@bind_params) || confess "statement [$sql] failed";
 2286 
 2287 	my @result;
 2288 	while(defined($ref = $sth->fetchrow_hashref)) {
 2289 		exists($ref->{$col}) || die "column [$col] unknown in sql [$sql]";
 2290 		push(@result, $ref->{$col});
 2291 	}
 2292 
 2293 	@result;
 2294 }
 2295 
 2296 sub dbSelect
 2297 {
 2298 	my ($sql, @bind_params) = @_;
 2299 
 2300 	my $sth;
 2301 	eval {
 2302 		$sth = $DBH->prepare($sql);
 2303 	};
 2304 	if ($@) {
 2305 		confess $@;
 2306 	}
 2307 	defined($sth) || die "prepare failed on sql [$sql]";
 2308 
 2309 	$sth->execute(@bind_params) || confess "statement [$sql] failed";
 2310 
 2311 	my @result;
 2312 	my $ref;
 2313 	while(defined($ref = $sth->fetchrow_hashref)) {
 2314 		push(@result, $ref);
 2315 	}
 2316 
 2317 	if (wantarray) {
 2318 		return @result;
 2319 	} else {
 2320 		@result || return undef;
 2321 		return $result[0];
 2322 	}
 2323 }
 2324 
 2325 sub executeStatement
 2326 {
 2327 	my ($sql, @bind_params) = shift;
 2328 
 2329 	$DEBUG && abslog("   execing statement: $sql");
 2330 	$FAKE && return 1;
 2331 
 2332 	my $rv;
 2333 	eval {
 2334 		$rv = $DBH->do($sql, undef, @bind_params);
 2335 	};
 2336 	if ($@) {
 2337 		confess "SQL statement failed: [$sql]";
 2338 	}
 2339 
 2340 	#if (!$rv) {
 2341 	#	confess "statement [$sql] failed";
 2342 	#}
 2343 
 2344 	defined($rv) || return undef;
 2345 	($rv eq '0E0') && return 0;
 2346 	return $rv;
 2347 }
 2348 
 2349 sub insertRowRetrieveSequence
 2350 {
 2351 	my ($table, $sql, @bind_params) = @_;
 2352 
 2353 	$DEBUG && abslog("   insertRowRetrieveSequence: $sql");
 2354 	$FAKE && return 1;
 2355 
 2356 	my ($rv, $sth);
 2357 
 2358 	eval {
 2359 		$sth = $DBH->prepare($sql);
 2360 	};
 2361 	if ($@) {
 2362 		confess "SQL prepare failed: [$sql]";
 2363 	}
 2364 	defined($sth) || die "prepare failed on sql [$sql]";
 2365 
 2366 	$sth->execute(@bind_params) || confess "statement [$sql] failed";
 2367 
 2368 	$sth->finish;
 2369 
 2370 	#----------------------------------------------------------
 2371 	# get sequence number
 2372 	#----------------------------------------------------------
 2373 	my $sequence = "${table}_id_seq";
 2374 	$sth = $DBH->prepare("SELECT currval('$sequence');");
 2375 	$sth->execute || confess "statement [SELECT currval('$sequence');] failed";
 2376 
 2377 	my $id = ($sth->fetchrow_array)[0];
 2378 	defined($id) || confess "no ID returned.";
 2379 	return $id;
 2380 }
 2381 
 2382 #=======================================================================
 2383 # Absence-Type stuff
 2384 #=======================================================================
 2385 # ROBBO
 2386 sub getTypes
 2387 {
 2388 	my $arg = shift;
 2389 
 2390 	my $sql;
 2391 	if ($arg eq 'invalid') {
 2392 		$sql = qq{
 2393 			SELECT * FROM c_reservation_type WHERE invalidated IS NOT NULL;
 2394 		};
 2395 	} elsif ($arg eq 'all') {
 2396 		$sql = qq{
 2397 			SELECT * FROM c_reservation_type;
 2398 		};
 2399 	} else {
 2400 		$sql = qq{
 2401 			SELECT * FROM v_reservation_type;
 2402 		};
 2403 	}
 2404 
 2405 	my @list = dbSelect($sql);
 2406 }
 2407 
 2408 sub getType
 2409 {
 2410 	my $type_id = shift;
 2411 
 2412 	my $sql = qq{ SELECT * FROM c_reservation_type WHERE id = ?; };
 2413 	return dbSelect($sql, $type_id);
 2414 }
 2415 
 2416 sub getTypeClass
 2417 {
 2418 	my $type_id = shift;
 2419 
 2420 	my $ref = getType($type_id);
 2421 	return ($ref->{height} eq 'block') ? 'block' : 'non_block';
 2422 }
 2423 
 2424 
 2425 sub queryTypeName
 2426 {
 2427 	my ($name, $arg, $ignore) = @_;
 2428 
 2429 	my $table = ($arg eq 'invalid')
 2430 		? 'c_reservation_type'
 2431 		: 'v_reservation_type';
 2432 
 2433 	my $sql;
 2434 	my @bind_params;
 2435 	if (defined($ignore)) {
 2436 		$sql = qq{ SELECT id FROM $table WHERE name = ? AND id != ?; };
 2437 		@bind_params = ($name, $ignore);
 2438 	} else {
 2439 		$sql = qq{ SELECT id FROM $table WHERE name = ?; };
 2440 		@bind_params = ($name);
 2441 	}
 2442 
 2443 	return dbSelect($sql, @bind_params);
 2444 }
 2445 
 2446 sub modifyType
 2447 {
 2448 	my $ref = shift;
 2449 
 2450 	my $sql;
 2451 
 2452 	$DBH->begin_work;
 2453 	if ($ref->{default_type}) {
 2454 		# first 
 2455 		$sql = qq{
 2456 			UPDATE c_reservation_type
 2457 			SET default_type = FALSE
 2458 			WHERE default_type = TRUE;
 2459 		};
 2460 		if (!defined($DBH->do($sql))) {
 2461 			die "modifyType (remove default) failed";
 2462 		}
 2463 	}
 2464 
 2465 	my @pairs;
 2466 	my @bind_params;
 2467 	foreach my $key (keys(%{ $ref })) {
 2468 		next if ($key eq 'id');
 2469 		push(@pairs, "$key = ?");
 2470 		push(@bind_params, $ref->{$key});
 2471 	}
 2472 	my $pairs = join(',', @pairs);
 2473 	$sql = qq{
 2474 		UPDATE c_reservation_type
 2475 		SET $pairs
 2476 		WHERE id = $ref->{id};
 2477 	};
 2478 	if (!defined($DBH->do($sql, undef, @bind_params))) {
 2479 		$DBH->rollback;
 2480 		die "modifyType (modify) failed";
 2481 	}
 2482 	setTypeModTime();
 2483 	$DBH->commit;
 2484 }
 2485 
 2486 sub addType
 2487 {
 2488 	my $ref = shift;
 2489 
 2490 	my (@fields, @values);
 2491 
 2492 	foreach my $key (keys(%{ $ref })) {
 2493 		push(@fields, $key);
 2494 		push(@values, $ref->{$key});
 2495 	}
 2496 	my $fields = join(',', @fields);
 2497 	my $binds = join(',', map '?', @values);
 2498 
 2499 	my $sql = qq{
 2500 		INSERT INTO c_reservation_type
 2501 		($fields)
 2502 		VALUES ($binds);
 2503 	};
 2504 	my $tid = insertRowRetrieveSequence('c_reservation_type', $sql, @values);
 2505 
 2506 	return $tid;
 2507 }
 2508 
 2509 sub deactivateType
 2510 {
 2511 	my $type_id = shift;
 2512 
 2513 	my $now = time();
 2514 	my $sql = qq{
 2515 		UPDATE c_reservation_type
 2516 		SET invalidated = int2tsz($now)
 2517 		WHERE id = ?;
 2518 	};
 2519 	$DBH->do($sql, undef, $type_id);
 2520 }
 2521 
 2522 sub reactivateType
 2523 {
 2524 	my $type_id = shift;
 2525 
 2526 	my $sql = qq{
 2527 		UPDATE c_reservation_type
 2528 		SET invalidated = NULL
 2529 		WHERE id = ?;
 2530 	};
 2531 	$DBH->do($sql, undef, $type_id);
 2532 }
 2533 
 2534 
 2535 sub getTypeColor
 2536 {
 2537 	my $type_id = shift;
 2538 
 2539 	my $sql = qq{ SELECT * FROM v_reservation_type WHERE id = ?; };
 2540 	my $type_ref = dbSelect($sql, $type_id);
 2541 	defined($type_ref) || die "no type found with id=[$type_id]";
 2542 
 2543 	return [
 2544 		$type_ref->{color_red},
 2545 		$type_ref->{color_green},
 2546 		$type_ref->{color_blue},
 2547 	];
 2548 }
 2549 
 2550 sub getDefaultType
 2551 {
 2552 	my $sql = qq{ SELECT * FROM v_reservation_type WHERE default_type = TRUE; };
 2553 	my $type_ref = dbSelect($sql);
 2554 	defined($type_ref) || return undef;
 2555 
 2556 	return $type_ref;
 2557 }
 2558 
 2559 sub getTypeModTime
 2560 {
 2561 	my $config_name = 'type-modification-time';
 2562 
 2563 	return getConfigItem($config_name);
 2564 }
 2565 
 2566 sub setTypeModTime
 2567 {
 2568 	my $config_name = 'type-modification-time';
 2569 
 2570 	setConfigItem($config_name, time());
 2571 }
 2572 
 2573 sub resTypeCoincidenceAllowed
 2574 {
 2575 	my ($type1, $type2) = @_;
 2576 
 2577 	my @ids = ($type1 > $type2) ? ($type2, $type1) : ($type1, $type2);
 2578 
 2579 	my $sql = qq{
 2580 		SELECT id
 2581 		FROM c_no_coincidence
 2582 		WHERE type_id1 = ? AND type_id2 = ?;
 2583 	};
 2584 
 2585 	defined(dbSelect($sql, @ids)) && return 0;
 2586 
 2587 	return 1;
 2588 }
 2589 
 2590 sub checkVorbidTypeCoincidence
 2591 {
 2592 	my ($type1, $type2) = @_;
 2593 
 2594 	my @ids = ($type1 > $type2) ? ($type2, $type1) : ($type1, $type2);
 2595 
 2596 	my $sql = qq{
 2597 		SELECT id
 2598 		FROM c_no_coincidence
 2599 		WHERE type_id1 = ? AND type_id2 = ?;
 2600 	};
 2601 
 2602 	return defined(dbSelect($sql, @ids)) ? 1 : 0;
 2603 }
 2604 
 2605 sub vorbidTypeCoincidence
 2606 {
 2607 	my ($type1, $type2) = @_;
 2608 
 2609 	my @ids = ($type1 > $type2) ? ($type2, $type1) : ($type1, $type2);
 2610 
 2611 	my $sql = qq{
 2612 		INSERT INTO c_no_coincidence
 2613 		(type_id1, type_id2) VALUES (?,?);
 2614 	};
 2615 
 2616 	$DBH->do($sql, undef, @ids);
 2617 }
 2618 
 2619 sub purgeTypeCoincidenceEntries
 2620 {
 2621 	my $type_id = shift;
 2622 
 2623 	my $sql = qq{
 2624 		DELETE FROM c_no_coincidence
 2625 		WHERE type_id1 = ?
 2626 		OR type_id2 = ?;
 2627 	};
 2628 
 2629 	$DBH->do($sql, undef, $type_id, $type_id);
 2630 }
 2631 
 2632 sub getTypeCoincidence
 2633 {
 2634 	my $type_id = shift;
 2635 
 2636 	my $sql = qq{
 2637 		SELECT *
 2638 		FROM c_no_coincidence
 2639 		WHERE type_id1 = ?
 2640 		OR type_id2 = ?;
 2641 	};
 2642 
 2643 	my @list = dbSelect($sql, $type_id, $type_id);
 2644 	@list || return ();
 2645 
 2646 	my @out;
 2647 	foreach my $row (@list) {
 2648 		push(@out, ($row->{type_id1} == $type_id)
 2649 			? $row->{type_id2}
 2650 			: $row->{type_id1});
 2651 	}
 2652 
 2653 	return @out;
 2654 }
 2655 
 2656 
 2657 #=======================================================================
 2658 # Absence-Holiday stuff
 2659 #=======================================================================
 2660 
 2661 sub getHolidayList
 2662 {
 2663 	my ($month, $year, %args) = @_;
 2664 
 2665 	my $dim = AbsenceDate::daysInMonth($month, $year);
 2666 	my $month_begin = "$year-$month-1";
 2667 	my $month_end = "$year-$month-$dim";
 2668 
 2669 	my $addit = '';
 2670 	my @addit;
 2671 	my @addit_binds;
 2672 	
 2673 	if (exists($args{region})) {
 2674 		push(@addit, "region_id = ?");
 2675 		push(@addit_binds, $args{region});
 2676 	}
 2677 	if (exists($args{country})) {
 2678 		push(@addit, "country_id = ?");
 2679 		push(@addit_binds, $args{country});
 2680 	}
 2681 	if (@addit) {
 2682 		$addit = 'AND (' . join(' OR ', @addit) . ')';
 2683 	}
 2684 
 2685 	my $sql = qq{
 2686 		SELECT * FROM c_holiday
 2687 		WHERE
 2688 			(day BETWEEN ? AND ?
 2689 			OR day BETWEEN ? AND ?)
 2690 			$addit
 2691 		ORDER BY EXTRACT(DAY FROM day);
 2692 	};
 2693 	#abslog("%%% getHolidayList: SQL: [$sql]");
 2694 
 2695 	# make sure last day in february, 0001 is 28
 2696 	if ($month == 2) { $dim = 28; }
 2697 
 2698 	my @bind_params = (
 2699 		$month_begin, $month_end, "0001-$month-01", "0001-$month-$dim",
 2700 		@addit_binds
 2701 	);
 2702 	my @list = dbSelect($sql, @bind_params);
 2703 	my %unique;
 2704 
 2705 	my @out;
 2706 	#-----------------------------------------------------
 2707 	# eliminate duplicate days (should not happen...) and
 2708 	# format the way the pre-DB version did: a sorted array
 2709 	# containing refs to
 2710 	# 	[ $day, $month, $year, $description ]
 2711 	# (sorting is done in SQL query!)
 2712 	#-----------------------------------------------------
 2713 	foreach my $date (@list) {
 2714 		my $dref = convToAbsenceDate($date->{day});
 2715 		exists($unique{ $dref->{day} }) && next;
 2716 		push(@out, [ $dref->{day}, $dref->{month}, $dref->{year}, $date->{description} ]);
 2717 		$unique{ $dref->{day} } = 1;
 2718 	}
 2719 
 2720 	return @out;
 2721 }
 2722 
 2723 sub getRegionId
 2724 {
 2725 	my $region_name = shift;
 2726 
 2727 	my $sql = qq{
 2728 		SELECT id
 2729 		FROM c_region
 2730 		WHERE name = ?;
 2731 	};
 2732 
 2733 	my $ref = dbSelect($sql, $region_name);
 2734 	return defined($ref) ? $ref->{id} : undef;
 2735 }
 2736 
 2737 sub getCountryId
 2738 {
 2739 	my ($field, $value) = @_;
 2740 
 2741 	my $sql = qq{
 2742 		SELECT id
 2743 		FROM c_country
 2744 		WHERE $field = ?;
 2745 	};
 2746 
 2747 	my $ref = dbSelect($sql, $value);
 2748 	return defined($ref) ? $ref->{id} : undef;
 2749 }
 2750 
 2751 #=======================================================================
 2752 # config-items
 2753 #=======================================================================
 2754 
 2755 sub getConfigItem
 2756 {
 2757 	my $name = shift;
 2758 
 2759 	my $sql = qq{ SELECT * FROM c_config WHERE name = ?; };
 2760 	my $config_item = dbSelect($sql, $name);
 2761 	defined($config_item) || return undef;
 2762 
 2763 	return $config_item->{content};
 2764 }
 2765 
 2766 sub setConfigItem
 2767 {
 2768 	my ($name, $value) = @_;
 2769 
 2770 	my $sql = qq{
 2771 		UPDATE c_config SET content = ? WHERE name = ?;
 2772 	};
 2773 
 2774 	my $rv = $DBH->do($sql, undef, $value, $name);
 2775 	if ($rv == 0) {
 2776 		$sql = qq{
 2777 			INSERT INTO c_config (name,content) VALUES (?,?);
 2778 		};
 2779 		defined($DBH->do($sql, undef, $name, $value))
 2780 			|| die "insert c_config, rv=undef, sql=[$sql]";
 2781 	}
 2782 }
 2783 
 2784 #=======================================================================
 2785 # session functions
 2786 #=======================================================================
 2787 
 2788 sub checkSession
 2789 {
 2790 }
 2791 
 2792 sub getSession
 2793 {
 2794 	my ($sid, $create) = @_;
 2795 
 2796 	$SESSION_PARAMS[1] = $sid;
 2797 
 2798 	my $session = CGI::Session->load(@SESSION_PARAMS)
 2799 		or die CGI::Session->errstr;
 2800 
 2801 	if ( $session->is_expired ) {
 2802 		$DEBUG && abslog("sess expired");
 2803 		$session->delete;
 2804 		$create || return undef;
 2805 
 2806 		$session = $session->new(@SESSION_PARAMS);
 2807 		$session->param(authed => 0);
 2808 		$session->flush;
 2809 	} elsif ( $session->is_empty ) {
 2810 		$create || return undef;
 2811 		$session = $session->new(@SESSION_PARAMS);
 2812 		my $id = $session->id();
 2813 		$DEBUG && abslog("session empty. created new ID=[$id], authed=0");
 2814 		$session->param(authed => 0);
 2815 		$session->flush;
 2816 	} else {
 2817 		my $id = $session->id();
 2818 		my $authed = $session->param('authed');
 2819 		$DEBUG && abslog("session still good, ID=[$id], authed=[$authed]");
 2820 	}
 2821 
 2822 	return $session;
 2823 }
 2824 
 2825 #=======================================================================
 2826 # old session functions
 2827 #=======================================================================
 2828 
 2829 sub old_checkSession
 2830 {
 2831 	my ($user_id, $ip_addr) = @_;
 2832 
 2833 	my $sql = qq{
 2834 		SELECT id, tsz2int(t_stamp)
 2835 		FROM d_session
 2836 		WHERE user_id = ?
 2837 		AND ip_addr = ?;
 2838 	};
 2839 
 2840 	# get record, if exists
 2841 	my $ref = dbSelect($sql, $user_id, $ip_addr);
 2842 	defined($ref) || return 'timeout';
 2843 	
 2844 	if ($SESSION_TIMEOUT == 0) { return 'ok'; }
 2845 
 2846 	my $esecs = time();
 2847 	$DEBUG && abslog("checkSession: now=[$esecs], db_time=[$ref->{tsz2int}]");
 2848 	# check if timestamp is recent
 2849 	if (($esecs - $ref->{tsz2int}) > $SESSION_TIMEOUT * 60) {
 2850 		return 'timeout';
 2851 	}
 2852 
 2853 	# timestamp, is recent, so update it
 2854 	$sql = qq{
 2855 		UPDATE d_session
 2856 		SET t_stamp = int2tsz($esecs)
 2857 		WHERE id = $ref->{id};
 2858 	};
 2859 	$DBH->do($sql);
 2860 
 2861 	return 'ok';
 2862 }
 2863 
 2864 sub addSession
 2865 {
 2866 	my ($user_id, $ip_addr, $id) = @_;
 2867 
 2868 	$DEBUG && abslog("addSession()\ntrying UPDATE");
 2869 	my $esecs = time();
 2870 	my @bind_params;
 2871 	my $sql = qq{
 2872 		UPDATE d_session
 2873 		SET t_stamp = int2tsz($esecs)
 2874 	};
 2875 
 2876 	if (defined($id)) {
 2877 		$sql .= "WHERE id = ?;";
 2878 		@bind_params = ($ref->{id});
 2879 	} else {
 2880 		$sql .= "WHERE user_id = ? AND ip_addr = ?;";
 2881 		@bind_params = ($user_id, $ip_addr);
 2882 	}
 2883 
 2884 	my $rv = $DBH->do($sql, undef, @bind_params);
 2885 	$DEBUG && abslog("sql=[$sql], rv=[$rv]");
 2886 	defined($rv) || die "update session, rv=undef, sql=[$sql]";
 2887 	if ($rv == 0) {
 2888 		$sql = qq{
 2889 			INSERT INTO d_session
 2890 			(user_id,ip_addr,t_stamp)
 2891 			VALUES (?,?, int2tsz($esecs));
 2892 		};
 2893 		$rv = $DBH->do($sql, undef, $user_id, $ip_addr);
 2894 		$DEBUG && abslog("trying INSERT. sql=[$sql]\nrv=[$rv]");
 2895 		$rv || die "insert into d_session failed. user_id=$user_id, ip=$ip_addr, ts=$esecs";
 2896 	}
 2897 }
 2898 
 2899 sub deleteSession
 2900 {
 2901 	my ($user_id, $ip_addr, $id) = @_;
 2902 
 2903 	my $sql = qq{
 2904 		DELETE FROM d_session
 2905 		WHERE user_id = ?
 2906 		AND ip_addr = ?;
 2907 	};
 2908 	$DBH->do($sql, undef, $user_id, $ip_addr);
 2909 }
 2910 
 2911 #=======================================================================
 2912 # misc stuff
 2913 #=======================================================================
 2914 
 2915 sub superset
 2916 {
 2917 	my ($gref1, $gref2) = @_;
 2918 
 2919 	my $count = 0;
 2920 	foreach my $mem (@{$gref2}) {
 2921 		if (inListN($mem, $gref1)) {
 2922 			$count++;
 2923 		}
 2924 	}
 2925 
 2926 	dbg("superset: count=[$count], len(gref2) = [".@{$gref2}."]");
 2927 	($count == @{$gref2}) && return 1;
 2928 	return 0;
 2929 }
 2930 
 2931 sub checkLengths
 2932 {
 2933 	my ($table, $field_ref) = @_;
 2934 
 2935 	my $out;
 2936 	foreach my $field (%{ $field_ref }) {
 2937 		my $content = $field_ref->{$field};
 2938 		my $c_len = defined($content) ? length($content) : 0;
 2939 		my $f_len = getFieldLength($table, $field);
 2940 		defined($f_len) || next;
 2941 		if ($c_len > $f_len) {
 2942 			$out .= "field [$field] too long (max=$f_len).<BR>";
 2943 		}
 2944 	}
 2945 
 2946 	return $out;
 2947 }
 2948 
 2949 #=======================================================================
 2950 # PostgreSQL specific stuff...
 2951 #=======================================================================
 2952 
 2953 sub getFieldDatatype
 2954 {
 2955 	my ($table, $field) = @_;
 2956 
 2957 	if (!exists($META{$table})) {
 2958 		getTableMetadata($table);
 2959 	}
 2960 
 2961 	exists($META{$table}->{$field}) ||
 2962 		confess "field [$field] not in table [$table]";
 2963 
 2964 	return $META{$table}->{$field}->{type};
 2965 }
 2966 
 2967 sub getFieldLength
 2968 {
 2969 	my ($table, $field) = @_;
 2970 
 2971 	if (!exists($META{$table})) {
 2972 		getTableMetadata($table);
 2973 	}
 2974 
 2975 	exists($META{$table}->{$field}) ||
 2976 		die "field [$field] not in table [$table]";
 2977 
 2978 	return $META{$table}->{$field}->{length};
 2979 }
 2980 
 2981 sub getTableMetadata
 2982 {
 2983 	my $table = shift;
 2984 
 2985 	my $sql = qq{
 2986 		SELECT pg_attribute.attname,pg_attribute.atttypmod,pg_type.typname
 2987 		FROM pg_class,pg_attribute,pg_type
 2988 		WHERE pg_attribute.attnum > 0
 2989 		AND pg_attribute.attrelid = pg_class.oid
 2990 		AND pg_class.relname = '$table'
 2991 		AND pg_attribute.atttypid = pg_type.oid;
 2992 	};
 2993 
 2994 	my @list = dbSelect($sql);
 2995 	@list || die "table [$table] not found";
 2996 
 2997 	my $length;
 2998 	foreach my $ref (@list) {
 2999 		# get length. totally non-portable.  pg_attribute.atttypmod stores
 3000 		# the length (presumably) including internal length information
 3001 		# of 4 bytes, which must be subtracted
 3002 		$length = ($ref->{typname} eq 'varchar')
 3003 			? $length = $ref->{atttypmod} - 4
 3004 			: undef;
 3005 		$META{$table}->{$ref->{attname}} = {
 3006 			type	=> $ref->{typname},
 3007 			length	=> $length,
 3008 		};
 3009 	}
 3010 }
 3011 
 3012 1;
 3013 
 3014 __END__
 3015 
 3016 =head1 NAME
 3017 
 3018 AbsenceDB.pm - interface to absence database.
 3019 
 3020 =head1 WARNING
 3021 
 3022 this documentation isn't necessarily accurate.  If you need proper
 3023 documenation, get in touch with me, and I'll make more of an effort.
 3024 -RLU
 3025 
 3026 =head1 SYNOPSIS
 3027 
 3028   use AbsenceDB;
 3029 
 3030 
 3031 Operations on objects (people):
 3032 
 3033   @people_ids = getPeople($group_id);
 3034   
 3035   $ref        = getPerson($person_id);
 3036 	or
 3037   $thing      = getPerson($person_id, 'field-name');
 3038 
 3039   $ref        = getGroup($group_id);
 3040 	or
 3041   $thing      = getGroup($group_id, 'field-name');
 3042 
 3043   $result     = addPerson($person_id, $name, $username, $email,
 3044                 $group_ref, $password, $pacl, $gacl);
 3045 
 3046   $result     = deletePerson($person_id);
 3047 
 3048   $uid        = findUidForObject($oid);
 3049 
 3050 
 3051 Operations on reservations:
 3052 
 3053   @list    = getReservations($person_id);
 3054 
 3055   @list    = getMonthReservations($person_id, $month, $year);
 3056 
 3057   $res_ref = getReservation($reservation_id);
 3058 
 3059   $result  = addReservation($reservation_id, $start, $end, $type, $description);
 3060 
 3061   $result  = deleteReservation($reservation_id);
 3062 
 3063 
 3064 Operations on groups:
 3065 
 3066   $result    = addGroup($group_id, $group_name, $group_password, $description);
 3067 
 3068   $result    = deleteGroup($group_id);
 3069 
 3070   @group_ids = getGroups();
 3071 
 3072   $ref       = getGroup($group_id);
 3073 	or
 3074   $thing     = getGroup($group_id, 'field-name');
 3075 
 3076   $number_of_groups = groupCount();
 3077 
 3078   $mod_time = getModificationTime($group_id, $month, $year);
 3079 
 3080   $result    = groupExists('field', 'value');
 3081 
 3082   addGroupMappings($object_id, @group_ids);
 3083   deleteGroupMappings($object_id, @group_ids);
 3084   removeObjectFromGroup(-pid => $object_id, -gid => $group_id);
 3085 
 3086 =head1 DESCRIPTION
 3087 
 3088 C<AbsenceDB.pm> is a crude interface to a database.  In theory, the
 3089 underlying database could be anything.  You have perhaps noticed that
 3090 elsewhere I refer to B<absences>, but here they are called
 3091 B<reservations>?  That came about as a result of my original intention
 3092 to keep the system generic, i.e., not necessarily only for people.
 3093 Along the way I apparently got a little confused.
 3094 
 3095 =head1 PERSON FUNCTIONS
 3096 
 3097 =over 4
 3098 
 3099 =item getPeople()
 3100 
 3101 returns a list of person_ids belonging to the specified group.
 3102 
 3103 =item getPerson()
 3104 
 3105 retrieves information about the specified person_id.  Without additional
 3106 parameters, returns a ref to a object-row from the DB.  With an optional
 3107 field-name as parameter, returns the value of that field.
 3108 
 3109 =item addPerson()
 3110 
 3111 creates a new person or modifies an existing one.  Parameters are
 3112 C<($person_id, $name, $email, $group_id)>.  If B<$person_id> equals
 3113 'new', a new person is created, otherwise B<$person_id> must
 3114 contain a valid person-id.  If an attempt is made to create a person
 3115 with the same name as an existing one, the operation fails and
 3116 the return-value is 'duplicate'.  On success returns 'ok'.
 3117 
 3118 =item deletePerson()
 3119 
 3120 guess what it does? Takes as single param a person-id.  Returns
 3121 'ok' on success, otherwise 'bad-id' if the person-id was not valid.
 3122 
 3123 
 3124 =head1 RESERVATION FUNCTIONS
 3125 
 3126 =item getReservations()
 3127 
 3128 returns a list of all reservations belonging to the specified person_id.
 3129 
 3130 =item getMonthReservations()
 3131 
 3132 finds all reservations for a given person_id in a given month and year.
 3133 returns a list of hash-refs of the form: 
 3134 
 3135   {
 3136 	res    => reservation-row from DB,
 3137 	bounds => {
 3138 		start => start-day,
 3139 		end   => end-day,
 3140 	}
 3141   }
 3142 	
 3143 =item getReservation()
 3144 
 3145 given a reservation-id it returns a reference to a reservation-row from
 3146 the DB, otherwise undef.
 3147 
 3148 =item addReservation()
 3149 
 3150 adds a new reservation, or modifies an existing one. Parameters
 3151 are C<($res_id, $person_id, $start, $end, $type, $desc)>. If
 3152 B<$res_id> equals 'new', a new reservation is created, otherwise
 3153 B<$res_id> must contain valid reservation-id.
 3154 
 3155 B<$start> and B<$end> must contain dates in the form "D.M.Y".
 3156 
 3157 Returns a list of two items:
 3158 
 3159 =over 4
 3160 
 3161 =item ('disappeared', '')
 3162 
 3163 someone else (presumably) deleted the absence in the meantime
 3164 
 3165 =item ('badday', '')
 3166 
 3167 the start or end day is invalid (i.e., February 30)
 3168 
 3169 =item ('impossible', '')
 3170 
 3171 the start-day is greater than the end-day.
 3172 
 3173 =item ('conflict', $res_id)
 3174 
 3175 there is a conflict with another reservation. B<$res_id> is the
 3176 reservation-id of the conflicting reservation.
 3177 
 3178 =item ('ok', '')
 3179 
 3180 success.
 3181 
 3182 =back
 3183 
 3184 =item deleteReservation()
 3185 
 3186 deletes a reservation.  Takes as single parameter a reservation-id.
 3187 
 3188 returns:
 3189 
 3190 =over 4
 3191 
 3192 =item internalerror
 3193 
 3194 The specified reservation-id does not exist.
 3195 
 3196 =item conflict
 3197 
 3198 The reservation-id disappeared suddenly.  Presumably someone else
 3199 got there before you.
 3200 
 3201 =item ok
 3202 
 3203 success.
 3204 
 3205 =back
 3206 
 3207 
 3208 =head1 GROUP FUNCTIONS
 3209 
 3210 =item addGroup()
 3211 
 3212 creates a new group or modifies an existing one.  parameters are
 3213 ($group_id, $name, $password).  If $group_id equals 'new', a new
 3214 group is created, otherwise $group_id must contain a valid group-id.
 3215 If an attempt is made to create a group with the same name as an
 3216 existing one, returns 'duplicate'.  Returns 'ok' on success.
 3217 
 3218 =item deleteGroup()
 3219 
 3220 guess what this does?  Takes as single parameter the group-id.  Returns
 3221 'ok' on success.
 3222 
 3223 =item getGroups()
 3224 
 3225 returns a list of group-ids corresponding to all existing groups.
 3226 
 3227 =item getGroup()
 3228 
 3229 retrieves information about a group.  Takes as single parameter
 3230 the group-id.  Return-value depends on context: in a scalar
 3231 context, returns group-name, in a list context returns 
 3232 a list consisting of B<($group_name, $group_password)>.
 3233 
 3234 =item getGroup()
 3235 
 3236 returns the group-id to which a person belongs.  Takes as single param
 3237 the person-id.
 3238 
 3239 =item groupCount()
 3240 
 3241 returns the number of defined groups.
 3242 
 3243 =item getModificationTime()
 3244 
 3245 retrieves modification time for a particular group for a particular
 3246 month, if one is known.  This allows C<absence.pl> to determine
 3247 if a month-image needs to be created anew.  Returns the time in
 3248 epoch-second format if available, otherwise undef.
 3249 
 3250 =back
 3251 
 3252 =head1 AUTHOR
 3253 
 3254 Robert Urban <urban@tru64.org>
 3255 
 3256 Copyright (C) 2003 Robert Urban
 3257 
 3258 =cut