 |
» |
|
|
|
This HP Pascal/XL program example illustrates how you can update a particular
record of a shared data file. In addition, this program example uses file
system locking intrinsics (FLOCK, FUNLOCK) to ensure exclusive access to the
file while the update occurs. Program Algorithm | |
The task specified above is accomplished by following the steps described
below. Also indicated are the intrinsics used to accomplish file access tasks
and the name of the procedure where the task is accomplished: Open (HPFOPEN) three files, $STDLIST, $STDIN, and a permanent disk file
containing data to update (see procedure open_file). In a loop, lock (FLOCK) a shared data file; read (FREAD) data from disk
file; write (FWRITE) data to $STDLIST; read (FREAD) new data from $STDIN;
update (FUPDATE) shared data file with data read from $STDIN. The loop ends
when EOF of disk file is reached (see procedure update_file). Close (FCLOSE) the disk file (see procedure close_disk_file); let
normal program termination close the other files.
If a file system intrinsic returns an unsuccessful condition code, procedure
handle_file_error is called to print file information (PRINTFILEINFO) and then
abort (QUIT) the program. Source code listing | |
Example A-5. Updating a Shared File
$standard_level 'hp3000'$
$lines 100$
$code_offsets on$
$tables on$
$list_code on$
program access_file3(input,output);
{************************************************************************}
{ DECLARATION PART }
{************************************************************************}
const
ccg = 0; { condition code warning }
ccl = 1; { condition code warning }
cce = 2; { condition code successful }
{ HPFOPEN item values}
permanent = 1;
read = 0;
write = 1;
update = 5;
save = 1;
shared = 4;
locking = 1;
type
pac256 = packed array [1..256] of char;
pac80 = packed array [1..80] of char;
{ HPFOPEN status type }
status_type = record
case integer of
0 : (info : shortint;
subsys : shortint);
1 : (all : integer);
end;
var
disk_file : integer;
filename : pac80;
std_list : integer;
std_in : integer;
outbuf : pac80;
function FREAD: shortint; intrinsic; { sequential reads }
procedure HPFOPEN; intrinsic; { open files }
procedure FCLOSE; intrinsic; { close files }
procedure FWRITE; intrinsic; { sequential writes }
procedure FWRITEDIR; intrinsic; { random access writes }
procedure FUNLOCK; intrinsic; { unlock locked file }
procedure PRINTFILEINFO; intrinsic; { use in error handler }
procedure FLOCK; intrinsic; { lock file }
procedure FUPDATE; intrinsic; { update record }
procedure QUIT; intrinsic; { use in error handler }
|
procedure handle_file_error
(
file_num : shortint;
quit_num : shortint
);
{************************************************************************}
{ procedure handle_file_errorPrints the file information on the }
{ session/job list device. }
{************************************************************************}
begin
PRINTFILEINFO (file_num);
QUIT (quit_num);
end; { end handle_file_error }
procedure open_file
(
var file_num : integer;
file_name : pac80;
domain : integer;
access : integer;
excl : integer
lockable : integer;
);
{************************************************************************}
{ procedure open_file is a generic file opening procedure that allows you}
{ to specify the designator, domain, access type, ASCII/binary, and }
{ exclusive options for the file. }
{************************************************************************}
const
{**define HPFOPEN item numbers**}
formal_designator_option = 2;
domain_option = 3;
access_type_option = 11;
ascii_binary_option = 53;
exclusive_option = 13;
dynamic_locking_option = 12;
var
ascii : integer;
{define scratch variables }
msgbuf : pac80;
status : status_type;
begin
ascii := 1;
HPFOPEN (file_num, status, formal_designator_option, file_name,
domain_option, domain,
ascii_binary_option, ascii,
access_type_option, access,
exclusive_option, excl
dynamic_locking_option, lockable);
if status.all <> 0 then
handle_file_error (file_num, 1);
|
end; { end open_file }
procedure update_file
(
old_discfile : integer
);
{************************************************************************}
{ procedure update_file pdates records in the disk file with the }
{ replacement read from the stdin. }
*************************************************************************}
var
dummy : integer;
inbuf : array [1..80] of char;
end_of_file : boolean;
read_length : integer;
begin
{Lock the file and suspend }
end_of_file := false;
FLOCK (old_discfile,1);
if ccode = ccl then
handle_file_error (old_discfile, 3);
repeat
{ Read record from disk file, write employee name to $stdlist }
{ and read corresponding record number from $stdin and update }
{ the disk file with the input record and unlock disk file. }
read_length := FREAD (old_discfile, inbuf, 128);
if ccode = ccl then
handle_file_error (old_discfile, 4)
else
if ccode = ccg then
end_of_file := true
else
begin
FWRITE (std_list, inbuf, -20, octal('320'));
if ccode <> cce then
handle_file_error (std_list, 5);
dummy := FREAD (std_in, inbuf[20], 5);
if ccode = ccl then
handle_file_error (std_in, 6)
else
if ccode = ccg then
end_of_file := true;
FUPDATE (old_discfile, inbuf, 128);
if ccode <> cce then
handle_file_error (old_discfile, 7);
end
until end_of_file;
FUNLOCK (old_discfile); { final unlock of disk file }
if ccode <> cce then
handle_file_error (file_num, 2);
end; { end update_file }
|
procedure close_disk_file
(
file_num : integer;
disp : integer
);
{*************************************************************************}
{procedure close_disk_file is a generic file closing procedure that }
{allows you to specify the final disposition of the file you are closing. }
{*************************************************************************}
var
msgbuf : pac80;
begin
FCLOSE (file_num, disp, 0);
if ccode = ccl then
handle_file_error (file_num, 8);
end; { end close_disk_file }
{*************************************************************************}
{ MAIN PROGRAM }
{*************************************************************************}
begin
filename := '&$stdlist&';
open_file (std_list, filename, permanent,write,0,0); { STEP 1}
filename := '&$stdin&';
open_file (std_in, filename, permanent,read,0,0); { STEP 1}
filename := '&dataone&';
open_file (disk_file, filename, permanent,update,shared,locking);{STEP 1}
update_file(disk_file); { STEP 2}
close_disk_file(disk_file, save); { STEP 3}
end. { end main program }
|
|
