101 lines
3.1 KiB
Plaintext
101 lines
3.1 KiB
Plaintext
|
********************************************************************************
|
||
|
|
*
|
||
|
|
* Support of PR1ME INFORMATION subroutine '!CHECK.TYPE1.ID'
|
||
|
|
*
|
||
|
|
* Module %M% Version %I% Date %H%
|
||
|
|
*
|
||
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
||
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
||
|
|
* The copyright notice above does not evidence any actual or intended
|
||
|
|
* publication of such source code.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Maintenence log - insert most recent change descriptions at top
|
||
|
|
*
|
||
|
|
* Date.... GTAR# WHO Description.........................................
|
||
|
|
* 10/14/98 23801 SAP Change copyrights.
|
||
|
|
* 10/08/93 12299 LA Initial implementation.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* This subroutine serves no purpose in uniVerse as invalid type1/type19 ids
|
||
|
|
* are converted on the fly and can only be accessed using the name they
|
||
|
|
* were created with.
|
||
|
|
*
|
||
|
|
* However, the routine IS needed for compatibility with accounts coming
|
||
|
|
* from PI/open which may already have records created with invalid
|
||
|
|
* record ids. We need to perform the same mapping as PI/open, otherwise
|
||
|
|
* the records will not be accessible.
|
||
|
|
*
|
||
|
|
* This means we need to map the following:
|
||
|
|
*
|
||
|
|
* null record id --> &
|
||
|
|
* record id of '.' --> &
|
||
|
|
* record id of '..' --> &&
|
||
|
|
* / --> &
|
||
|
|
*
|
||
|
|
* We don't need to worry about converting '?' in the record ids (which
|
||
|
|
* is invalid in uniVerse) as the account convert program will already
|
||
|
|
* have sorted these out. We do, however, have to count them as two
|
||
|
|
* characters rather than one when working out whether to truncate the
|
||
|
|
* record id. This is because if a record id contains a '?' character,
|
||
|
|
* uniVerse will write this as '??' in the actual file name.
|
||
|
|
*
|
||
|
|
* This functionality is only needed in PI/open flavour uniVerse accounts.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
|
||
|
|
$OPTIONS DEFAULT
|
||
|
|
|
||
|
|
subroutine PR1ME(NEWID, OLDID)
|
||
|
|
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE CHK.ID.H ;* Contains value for MAX.ENTRYNAME.LENGTH
|
||
|
|
|
||
|
|
EQUATE PIOPEN.FLAVOUR TO 64
|
||
|
|
|
||
|
|
flavour = system(1001)
|
||
|
|
if flavour eq PIOPEN.FLAVOUR then
|
||
|
|
|
||
|
|
* Create temporary id with '?' expanded to check length
|
||
|
|
|
||
|
|
tmpid = change(OLDID, '?', '??')
|
||
|
|
if len(tmpid) > MAX.ENTRYNAME.LENGTH then
|
||
|
|
tmpid = tmpid[1,MAX.ENTRYNAME.LENGTH]
|
||
|
|
|
||
|
|
* Check for a single question mark at the end of the id, which means
|
||
|
|
* that the truncation has split a question mark pair, and remove it
|
||
|
|
* if it exists
|
||
|
|
|
||
|
|
numq = count(tmpid, '?')
|
||
|
|
tmplen = len(tmpid)
|
||
|
|
if mod(numq, 2) ne 0 and tmpid[tmplen, 1] eq '?' then
|
||
|
|
tmpid = tmpid[1, tmplen - 1]
|
||
|
|
end
|
||
|
|
end
|
||
|
|
|
||
|
|
* Now contract '??' to get back to the real id
|
||
|
|
|
||
|
|
tmpid = change(tmpid, '??', '?')
|
||
|
|
|
||
|
|
* If the last character is a
|
||
|
|
* Now cater for the special cases
|
||
|
|
|
||
|
|
begin case
|
||
|
|
case tmpid = ''
|
||
|
|
NEWID = '&'
|
||
|
|
case tmpid = '.'
|
||
|
|
NEWID = '&'
|
||
|
|
case tmpid = '..'
|
||
|
|
NEWID = '&&'
|
||
|
|
case 1
|
||
|
|
NEWID = convert('/', '&', tmpid)
|
||
|
|
end case
|
||
|
|
end else
|
||
|
|
NEWID = OLDID
|
||
|
|
end
|
||
|
|
|
||
|
|
|
||
|
|
return
|
||
|
|
end
|