!TITLE Source of PD ANAL
!<
%SYSTEM %STRING %FN %SPEC FAILURE MESSAGE(%INTEGER FAULT)

%EXTERNAL %ROUTINE %SPEC DEFINE(%STRING(255) NUMBER NAME)
%EXTERNAL %ROUTINE %SPEC CLEAR(%STRING(255) NUMBER)

%SYSTEM %INTEGER %FN %SPEC pdaddr(%STRING(255) pdfile)
%SYSTEM %ROUTINE %SPEC pd list(%INTEGER CONNECT ADDRESS, %C
                                        TYPES FLAG)
!(PD ANAL
!   PDANAL  PDFILE, * / OUTPUT
!
!  PDFILE MAY BE TOP LEVEL FILE, OR A MEMBER OF ANOTHER PDFILE
! TO ANY DEPTH.
!
!  OUTPUT MAY BE A FILE, OR ONE OF ".OUT" OR ".TT"
! - ".OUT" MEANS THE CURRENTLY SELECTED OUTPUT STREAM,
! - ".TT"  MEANS THE INTERACTIVE TERMINAL.
!
!  * MEANS EXTRA DATA IS WANTED (FILE-TYPES OF MEMBERS)
!
%EXTERNAL %ROUTINE PD ANAL(%STRING(255) PARM)
!)
%STRING(255) PD, OUT, TYPES, MESS
%INTEGER CAD, FAIL, LEN, SPFLAG, TFLAG
%CONST %STRING(1) SNL="
"

CAD = -202 %AND -> FAIL %IF PARM=""

OUT = "" %UNLESS PARM->PARM.("/").OUT

PD = PARM %AND TYPES = "" %UNLESS PARM->PD.(",").TYPES

OUT=".TT" %IF OUT=""

%IF TYPES="*" %THEN TFLAG = 1 %ELSE TFLAG = 0

CAD = pdaddr(PD)

FAIL:
%IF CAD=0 %THEN MESS="MEMBER ".PD." DOES NOT EXIST"
%IF CAD<0 %THEN MESS=FAILURE MESSAGE(-CAD)

%IF CAD<=0 %THEN PRINTSTRING("PD ANAL FAILS - ".MESS.SNL) %AND %RETURN

%IF INTEGER(CAD+12)#6 %THEN %START
   PRINTSTRING("PD ANAL FAILS - FILE ". %C
      PARM." IS NOT A PARTITIONED FILE".SNL)
   %RETURN
%FINISH
%IF INTEGER(CAD+20)=0 %THEN PRINTSTRING("** EMPTY **".SNL) %AND %RETURN

SPFLAG = 0

%IF OUT#".OUT" %AND OUT#".TT" %START
   DEFINE("80,".OUT)
   SELECT OUTPUT(80)
   pd list(CAD,TFLAG)
   SELECT OUTPUT(0)
   CLOSE STREAM(80)
   CLEAR("80")
%FINISH %ELSE %START
   %IF OUT=".TT" %THEN SELECT OUTPUT(0)
   pd list(CAD,TFLAG)
%FINISH

%END

%END %OF %FILE
!>