/****************************************************************************
*									    *
*  Copyright (c) 1987							    *
*  by DIGITAL Equipment Corporation, Maynard, Mass.			    *
* 									    *
*  This software is furnished under a license and may be used and  copied   *
*  only  in  accordance  with  the  terms  of  such  license and with the   *
*  inclusion of the above copyright notice.  This software or  any  other   *
*  copies  thereof may not be provided or otherwise made available to any   *
*  other person.  No title to and ownership of  the  software  is  hereby   *
*  transferred.							 	    *
* 									    *
*  The information in this software is subject to change  without  notice   *
*  and  should  not  be  construed  as  a commitment by DIGITAL Equipment   *
*  Corporation.							   	    *
* 									    *
*  DIGITAL assumes no responsibility for the use or  reliability  of  its   *
*  software on equipment which is not supplied by DIGITAL.		    *
*									    *
****************************************************************************/

/*
**++
**  FACILITY:
**
**      PLI Sample Program - Phone Book Database
**
**  ABSTRACT:
**
**      This module contains all the necessary routines to manipulate the
**	phone book database.
**
**  AUTHORS:
**
**      Karen Michaels
**
**
**  CREATION DATE:     16-Feb-1987
**
**  MODIFICATION HISTORY:
**--
**/

%include 'constants.pli';
%include 'entry.pli';

dcl phone_file file keyed record update external; /* Phone book datafile    */


/*
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This routine opens the phone book datafile.
**
**  FORMAL PARAMETERS:
**
**      none
**
**  IMPLICIT INPUTS:
**
**      none
**
**  IMPLICIT OUTPUTS:
**
**      phone_file : The phone book datafile.
**
**  RETURN VALUE:
**
**      none
**
**  SIDE EFFECTS:
**
**      none
**
**--
**/
open_phonebook: procedure options(ident('V1.0'));

open file(phone_file) title('phone.dat');

end open_phonebook;


/*
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This routine closes the phone book datafile.
**
**  FORMAL PARAMETERS:
**
**      none
**
**  IMPLICIT INPUTS:
**
**      phone_file : The phone book datafile.
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  RETURN VALUE:
**
**      none
**
**  SIDE EFFECTS:
**
**      none
**
**--
**/
close_phonebook: procedure;

close file(phone_file);

end close_phonebook;


/*
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This routine reads a record with the specified last name and returns
**	a pointer to that record.
**
**  FORMAL PARAMETERS:
**
**      name   : The name of the record to be read.
**	first  : Read the first record that matches this key.
**
**  IMPLICIT INPUTS:
**
**      phone_file : The phone book datafile.
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  RETURN VALUE:
**
**      A pointer to the record that was read, or null if no record was found.
**
**  SIDE EFFECTS:
**
**      none
**
**--
**/
get_a_record: procedure (name, first) returns(pointer);

dcl name character(NAME_SIZE);	    /* The name to read.		    */
dcl first bit(1) aligned value;	    /* True when first record matching key
				       should be read			    */
dcl record pointer;		    /* A pointer to the current record.	    */
dcl name_length fixed binary(31);   /* The length of the current name.	    */
dcl 1 trimmed_name like entry.name; /* The name with all blanks removed.    */
dcl (i,j) fixed binary(31);

/*
 * If an error occurs during the read return null.
 */
on endfile (phone_file),key (phone_file)
    begin;
    record = null();
    end;

/*
 * Remove all blanks.
 */
name_length = length(trim(name));
trimmed_name.full_name = trim(name);

/*
 * If this is a first name last name pair, put in the necessary blanks.
 */
i = index(trimmed_name.full_name,' ');
if i < name_length &: (i ^= size(trimmed_name.last) + 1)
then do;
    j = verify(trimmed_name.full_name,' ',i);
    trimmed_name.first = substr(trimmed_name.full_name,j);
    trimmed_name.last = substr(trimmed_name.full_name,1,i-1);
    trimmed_name.space = ' ';
    name_length = length(trim(trimmed_name.full_name));
    end;
    
/*
 * Read the record
 */
if first
then
    read file(phone_file) set(record) key(trimmed_name.full_name) 
     options(match_greater_equal, index_number(0));
else
    read file(phone_file) set(record);

/*
 * Make sure this record really matches.
 */
if record ^= null() &:
 substr(record->entry.full_name,1,name_length) ^= 
 substr(trimmed_name.full_name,1,name_length)
then
    record = null();

return(record);

end get_a_record;
 

/*
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This routine reads a record for an event that occurs in the specified
**	month.  It returns a pointer to the record.
**
**  FORMAL PARAMETERS:
**
**      month  : The name of the selected month.
**	first  : True when first record matching key should be read.
**	bday   : True when the birthdate should be used as the key.
**
**  IMPLICIT INPUTS:
**
**      phone_file : The phone book datafile.
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  RETURN VALUE:
**
**      A pointer to the record that was read, or null if no record was found.
**
**  SIDE EFFECTS:
**
**      none
**
**--
**/
get_a_month_record: procedure (month, first, bday) returns(pointer);

dcl month character(MONTH_SIZE);    /* The month to be checked		    */
dcl first bit(1) aligned value;	    /* True when first record matching key
				       should be read			    */
dcl bday bit(1) aligned value;	    /* True when the birthdate should be    
				       used as the key.			    */
dcl record pointer;		    /* A pointer to the current record.	    */

/*
 * Check for blank month.
 */
if trim(month) = ''
then
    return(null());
    
/*
 * If an error occurs during the read return null.
 */
on endfile (phone_file),key (phone_file)
    begin;
    record = null();
    end;

/*
 * Read the record
 */
if first
then
    if bday
    then
	read file(phone_file) set(record) key(month) options(index_number(2));
    else
	read file(phone_file) set(record) key(month) options(index_number(4));
else do;
    read file(phone_file) set(record);
    /*
     * Make sure the dates really match.
     */
    if record ^= null() 
    then
	if bday 
	then do;
	    if month ^= record->birthdate.month
	    then
		record = null();
	    end;
	else
	    if month ^= record->anniversary.month
	    then
		record = null();
    end;

return(record);

end get_a_month_record;
 

/*
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This routine reads a record for an event that occurs on the specified
**	specified date.  It returns a pointer to the record.
**
**  FORMAL PARAMETERS:
**
**      date   : The selected date.
**	first  : True when first record matching key should be read.
**	bday   : True when the birthdate should be used as the key.
**
**  IMPLICIT INPUTS:
**
**      phone_file : The phone book datafile.
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  RETURN VALUE:
**
**      A pointer to the record that was read, or null if no record was found.
**
**  SIDE EFFECTS:
**
**      none
**
**--
**/
get_a_date_record: procedure (date, first, bday) returns(pointer);

dcl date character(DATE_SIZE);	    /* The date to be checked		    */
dcl first bit(1) aligned value;	    /* True when first record matching key
				       should be read			    */
dcl bday bit(1) aligned value;	    /* True when the birthdate should be    
				       used as the key.			    */
dcl record pointer;		    /* A pointer to the current record.	    */

/*
 * Check for blank date.
 */
if trim(date) = ''
then
    return(null());

/*
 * If an error occurs during the read return null.
 */
on endfile (phone_file),key (phone_file)
    begin;
    record = null();
    end;

/*
 * Read the record
 */
if first
then
    if bday
    then
	read file(phone_file) set(record) key(date) options(index_number(1));
    else
	read file(phone_file) set(record) key(date) options(index_number(3));
else do;
    read file(phone_file) set(record);

    /*
     * Make sure the dates really match.
     */
    if record ^= null() 
    then
	if bday 
	then do;
	    if date ^= record->birthdate.date
	    then
		record = null();
	    end;
	else
	    if date ^= record->anniversary.date
	    then
		record = null();
    end;

return(record);

end get_a_date_record;
 

/*
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This routine writes the specified record into the phone book database.
**
**  FORMAL PARAMETERS:
**
**      record_ptr : A pointer to the record to be written.
**
**  IMPLICIT INPUTS:
**
**      phone_file : The phone book datafile.
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  RETURN VALUE:
**
**      none
**
**  SIDE EFFECTS:
**
**      none
**
**--
**/
write_a_record: procedure (record_ptr);

dcl record_ptr pointer value;	/* A pointer to the record to be written    */

on key (phone_file)
    rewrite file(phone_file) from(record_ptr->entry) 
     key(record_ptr->full_name) options(index_number(0));

/*
 * Write the record.
 */
write file(phone_file) from(record_ptr->entry) keyfrom(record_ptr->full_name);

end write_a_record;
 

/*
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This routine deletes the specified record from the phone book database.
**
**  FORMAL PARAMETERS:
**
**      name	  : The name of the record to be deleted.
**
**  IMPLICIT INPUTS:
**
**      phone_file : The phone book datafile.
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  RETURN VALUE:
**
**      It returns true if the operation was sucessful.
**
**  SIDE EFFECTS:
**
**      none
**
**--
**/
delete_a_record: procedure (name) returns(bit(1) aligned);

dcl name character(NAME_SIZE);		/* The name of the record to be
					   deleted			      */
dcl status bit(1) aligned init(true);	/* The status of the delete operation */

on key (phone_file)
   status = false;

delete file(phone_file) key(name) options(index_number(0));

return(status);

end delete_a_record;