$ set noon
$
$!  CDDVD$DEVICE_TEST.COM V1.0-1
$!
$!  Copyright 2005-2006 Hewlett-Packard Development Company, L.P.
$!
$!
$!  Optical recording device compatibility testing procedure
$!
$!  This procedure invokes a series of DCL commands intended to 
$!  display and to verify the operation of COPY/RECORDABLE_MEDIA 
$!  mechanisms, including several of the ancillary CDDVD tools, 
$!  and the compatibility of these tools with the specified target 
$!  optical recording device.
$!
$!  Optical recording devices do not have completely compatible
$!  behaviours, command operations nor command responses, and 
$!  these idiosyncracies can and do lead to problems during the 
$!  recording process.  This undocumented and unsupported procedure
$!  is intended to assist in testing the compatibility of the 
$!  recording tools with a particular optical recording device; 
$!  with a particular CD-R/RW and/or DVD+R/RW device.  This procedure 
$!  is intended solely to provide baseline testing of the recording
$!  process with a specified device, and to confirm compliance with
$!  the various expectations within the recording tools.  (This tool
$!  does NOT verify that the operations of a particular device are 
$!  correct, nor that a device is supported, simply that the device
$!  "mostly works" enough for the purposes of recording on OpenVMS.)
$!
$!  Not all of what is used or referenced here is considered to
$!  be supported and/or documented.  Please see the associated
$!  Software Product Description (SPD) and the platform-specific
$!  support matrix for information on the supported devices and
$!  configurations.
$!
$!  A step-by-step detailed list of operations required as part 
$!  of setting up and performing testing is discussed below.
$!
$!
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$!
$!
$!  Submitting CDDVD$DEVICE_TEST.COM to Batch
$!
$!  The following step-by-step procedure describes how to start
$!  this testing procedure using batch.  This procedure assumes:
$!
$!    o you have sufficient privileges enabled in your 
$!      default username privilege mask, or enabled by
$!      your LOGIN.COM,
$!
$!    o the queue manager has been started,
$!
$!    o the SYS$BATCH default batch queue is available. 
$!
$!    o You have sufficient and appropriate blank recordable 
$!      and rewritable media available for the testing.
$!
$!  You can use SHOW QUEUE SYS$BATCH/FULL to confirm if you
$!  have the queue manager running, and the queue configured.
$!
$!
$!  Here are the basic steps for testing, using the batch
$!  queue:
$!
$!  1: Start LD, if required:
$!
$!     @SYS$STARTUP:LD$STARTUP
$!
$!     This step is required once per system reboot.
$!
$!  2: Enable your terminal as an operator.  
$!
$!     REPLY/ENABLE
$!
$!     The requests generated here are sent specifically 
$!     to the OPCOM DISKS operator.
$!
$!  3: Determine if you have sufficient free space on your 
$!     local SYS$SCRATCH: device:
$!
$!     SHOW DEVICE SYS$SCRATCH:
$!
$!    You will require approximately ten gigabytes on the 
$!    scratch device, and you will need a scratch directory.
$!
$!    If you have sufficient storage, skip to step 5.
$!
$! 4: If you do not have at least ten gigabytes available on 
$!    your scratch device, then locate another disk device 
$!    (DKB100:, in this example) with sufficient SYS$SCRATCH: 
$!    device:
$!
$!    SHOW DEVICE DKB100:
$!
$!    Once you have located a device with sufficient free 
$!    space, create a directory as needed and define the 
$!    CDDVD$SCRATCH process logical name in your LOGIN.COM, 
$!    or define the same logical name in the group or system 
$!    logical name table.  A system logical name definition
$!    is shown:
$!
$!    DEFINE/SYSTEM CDDVD$SCRATCH ddcu:[directory]
$!
$! 5: If your target recording device is DQA0:, then skip 
$!    to step 6.
$!
$!    If your target device is not DQA0:, then pass the 
$!    target device name via the P1 parameter, or define
$!    the logical name CDDVD$DEVICE_TEST_TARGET to be the 
$!    device name of the target recording device.   As in
$!    step 4 above, define a process logical name in your
$!    LOGIN.COM, or define the same logical name in the
$!    group or system logical name table.   A system 
$!    logical name definition for target optical recording
$!    device DKA600: is shown:
$!
$!    DEFINE/SYSTEM CDDVD$DEVICE_TEST_TARGET DKA600:
$!
$! 6: Start the testing run using the SYS$BATCH batch queue:
$!
$!     SUBMIT SYS$ETC:CDDVD$DEVICE_TEST
$!
$!     No options need be passed by parameters (/PARAMETER) 
$!     for the default testing sequence.
$!
$!     The procedure will now run to completion in the batch
$!     queue.
$!
$!     When you receive the OPCOM requests for various 
$!     media, load the requested media into the recording
$!     device, and issue the command REPLY/TO=n to complete
$!     the request, or don't load the media and issue the
$!     REPLY/ABORT=n command to skip the particular test.
$!
$!     Once you submit this procedure, you can monitor
$!     the progress of the batch procedure using a DCL
$!     command similar to:
$!
$!     TYPE/TAIL/CONTINUOUS CDDVD$DEVICE_TEST.LOG 
$!
$!     If required, you can specify optional procedure
$!     parameters using the SUBMIT/PARAMETER mechanism.
$!     For example:
$!
$!     SUBMIT SYS$ETC:CDDVD$DEVICE_TEST/NOTIFY -
$!         /PARAMETER=("DQA1:","NC,RF")
$!
$!     See below for details of the NC and RF options.
$!     (When no parameters are specified, full testing
$!     initialization and full testing are performed.)
$!
$!     Some tests here are expected to succeed, and some
$!     tests are expected to fail.  Tests that are
$!     intended to fail are listed as such.
$!
$!     The procedure will then run to completion, and you
$!     can and must then review the batch procedure's log 
$!     file for details of the success or failure of the 
$!     testing.
$!
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$!
$!  Various command options are available with this tool.
$!
$!  The (Optional) Parameter List:
$!
$!  P1: the target optical-recording device, if not defaulted.
$!      This procedure attempts to use the name passed via P1
$!      or via the first field in SUBMIT/PARAMETER, or attempts
$!      to translate the CDDVD$DEVICE_TEST_DEFAULT logical name,
$!      or attempts to use the physical device named DQA0:.  In 
$!      that order.
$!
$!  P2: comma-separated options list
$!      DP: Double Prompt.  Write prompt-related output to the
$!          SYS$COMMAND device, in addition to SYS$OUTPUT:.  
$!          (This allows you to see the prompt text if you've
$!          used @/OUTPUT=log to redirect the output to a log.)
$!          Ignored and not applicable when submitted to batch.
$!      D5: enable additional diagnostics output on various
$!          commands.  Used to localize potential operational
$!          errors and/or device incompatibilities.
$!      NC: skip the copy and the associated comparision test.
$!          This skips the operational verification of the
$!          CDDVD/COPY and CDDVD/COMPARE commands, and moves
$!          directly to device verification.  If these have
$!          been tested and work in the target environment,
$!          subsequent test passes can be speeded along to
$!          the device-related testing with the NC option.
$!      OP: prompt for media via OPCOM; requires an operator
$!          terminal be enabled via REPLY/ENABLE.  This is
$!          defaulted when this procedure is submitted to and
$!          is operating in batch.
$!      RB: ring the bell; rings the bell when prompting
$!          Not applicable to OPCOM prompting, as that already
$!          rings the bell on every operator terminal.
$!      RF: reuse existing files; skips the creation and patterning
$!          of the test-related master devices and disk image files.
$!          Speeds operations, when existing files are available
$!          and file recreation and re-patterning can be avoided.
$!          Like NC, this option speeds processing along to the 
$!          device-related testing more quickly.
$!      UMF: attempt testing with unsupported media formats.  (Any
$!          attempts to record to these particular recording formats
$!          may or may not work -- different formats have different
$!          I/O command interfaces, and different requirements.)
$!
$!  P3: the scratch area, if not SYS$SCRATCH nor CDDVD$SCRATCH.
$!      Approximately ten gigabytes of free space is required.
$!
$!
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$!
$!    P E R F O R M A N C E    a n d    S E C U R I T Y
$!
$!  If the target disk has highwater marking enabled, the file
$!  creations can potentially be rather slower as the files
$!  can be zeroed before being released back for use here.
$!  For the specific and isolated purposes of this test, the
$!  disk highwater marking on the input can be safely disabled.
$!
$!  This procedure uses CDDVD/PATTERN to avoid potentially
$!  exposing local data within the recorded medium.
$!
$!  When generating optical media in general, do use highwater 
$!  marking, or do perform the INITIALIZE/ERASE command, or do
$!  use the CDDVD/PATTERN command -- always first overwrite the
$!  entire contents of the master LD disk as part of preparing
$!  the master.
$!
$!  This procedure typically uses CDDVD/PATTERN. 
$!
$!  Any of these explicit disk overwrite steps can prevent an 
$!  indirect form of disk scavenging from potentially arising, 
$!  via the unused and un-overwritten blocks likely present 
$!  within the created optical media.  Failure to perform the
$!  initialization (and particularly when highwater or erase
$!  on delete or such is not enabled) could lead to the 
$!  exposure of apparently-deleted data from the host file 
$!  structure of the system generating the disk.
$!
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$!
$!
$
$! In most configurations, enabling verification of a batch 
$! job isn't necessary, but we here explicitly enable it.
$!
$ if f$mode() .eqs. "BATCH" then set verify
$
$
$
$! Process the comma-separated command option list (P2), 
$! or default the options.
$!
$ say = "write sys$output"
$ p2options = "," + f$edit(p2,"UPCASE,COLLAPSE") + ","
$ reuse_files = "FALSE"
$ if f$locate(",RF,",p2options) .ne. f$length(p2options )
$ then 
$   reuse_files = "TRUE"
$ endif
$ double_prompt = "FALSE"
$ if f$locate(",DP,",p2options) .ne. f$length(p2options )
$ then 
$   ! select if SYS$OUTPUT I/O is being redirected.
$   double_prompt = "TRUE"
$ endif
$ opcom_prompt = "FALSE"
$ if f$locate(",OP,",p2options) .ne. f$length(p2options )
$ then 
$   opcom_prompt = "TRUE"
$ endif
$ if (f$mode() .eqs. "BATCH") .or. (f$mode() .eqs. "OTHER")
$ then 
$   opcom_prompt = "TRUE"
$ endif
$ copy_and_compare = "TRUE"
$ if f$locate(",NC,",p2options) .ne. f$length(p2options )
$ then 
$   copy_and_compare = "FALSE"
$ endif
$ test_unsupported_media_formats = "FALSE"
$ if f$locate(",UMF,",p2options) .ne. f$length(p2options )
$ then 
$   test_unsupported_media_formats = "TRUE"
$ endif
$ ring_the_bell = "FALSE"
$ if f$locate(",RB,",p2options) .ne. f$length(p2options )
$ then 
$   ring_the_bell = "TRUE"
$ endif
$ diagnostics_setting = " "
$ if f$locate(",D5,",p2options) .ne. f$length(p2options )
$ then 
$   diagnostics_setting = "/DIAGNOSTICS=LEVEL=5"
$ endif
$ 
$! Process the recording device target, or default it.
$!
$ p1recorder = f$edit(p1,"UPCASE,COLLAPSE")
$ if p1recorder .nes. ""
$ then
$   ! use alternate target
$   if f$getdvi(p1recorder,"EXISTS")
$   then 
$     define/nolog CDDVD$DEVICE_TEST_TARGET 'p1recorder'
$   endif
$ else
$   if f$getdvi("CDDVD$DEVICE_TEST_DEFAULT","EXISTS")
$   then 
$     cddvd_device_test_default = f$trnlnm("CDDVD$DEVICE_TEST_DEFAULT")
$     define/nolog CDDVD$DEVICE_TEST_TARGET 'cddvd_device_test_default'
$   else
$     if f$getdvi("DQA0:","EXISTS")
$     then
$       define/nolog CDDVD$DEVICE_TEST_TARGET DQA0:
$     endif
$   endif
$ endif
$ if .not. f$getdvi("CDDVD$DEVICE_TEST_TARGET","EXISTS") 
$ then 
$   say "Specified or default optical recording device not available"
$   exit
$ endif
$
$
$! Process the scratch area target, or default it.
$!
$ p3scratch = f$edit("''P3'","TRIM")
$ if p3scratch .nes. ""
$ then
$   define/nolog CDDVD$SCRATCH 'p3scratch'
$ endif
$ if f$trnlnm("CDDVD$SCRATCH") .eqs. ""
$ then 
$   define/nolog CDDVD$SCRATCH SYS$SCRATCH
$ endif
$ testexist = f$parse("CDDVD$SCRATCH:")
$ if testexist .eqs. "" 
$ then
$    say "The required scratch directory is not available."
$    say "Define CDDVD$SCRATCH to a disk and directory with"
$    say "sufficient free storage, and reinvoke this procedure."
$   exit
$ endif
$
$
$
$
$! We need specific (and very powerful) privileges for the 
$! (unsupported, undocumented) ancillary recording images, 
$! and we must load the command verbs for the (unsupported, 
$! undocumented) ancillary tools.
$!
$  oldpriv = f$setprv("diagnose,phy_io,syslck")
$ 
$!
$ set command sys$etc:cddvd$tools.cld
$
$ if .not. f$getdvi("LDA0:","EXISTS")
$ then
$    say "The Logical Disk (LD) Utility has not been started."
$    say "Please add @SYS$STARTUP:LD$STARTUP.COM to your startup."
$    exit
$ endif
$
$
$! Process any existing LD devices that might conflict with
$! our tests.  (After a successful run with a clean exit, 
$! these LD devices are disconnected.)
$!
$ if f$getdvi("LDA300:","EXISTS")
$ then
$   if f$getdvi("LDA300:","MNT") 
$   then 
$     say "LDA300: device mounted.  Please dismount it"
$   endif
$   say "LDA300: exists.  Please disconnect it"
$   say "  Command:  LD DISCONNECT LDA300:"
$   exit
$ endif
$ if f$getdvi("LDA600:","EXISTS")
$ then
$   if f$getdvi("LDA600:","MNT")
$   then
$     say "LDA600: device mounted.  Please dismount it"
$   endif
$   say "LDA600: exists.  Please disconnect it"
$   say "  Command:  LD DISCONNECT LDA600:"
$   exit
$ endif
$ if f$getdvi("LDA6000:","EXISTS")
$ then
$   if f$getdvi("LDA6000:","MNT")
$   then 
$     say "LDA6000: device mounted.  Please dismount it"
$   endif
$   say "LDA6000: exists.  Please disconnect it"
$   say "  Command:  LD DISCONNECT LDA6000:"
$   exit
$ endif
$
$ if .not. reuse_files
$ then
$   if f$search("CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_300.ISO") .nes. ""
$   then 
$     delete CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_300.ISO;*
$   endif
$   if f$search("CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_600.ISO") .nes. ""
$   then 
$     delete CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_600.ISO;*
$   endif
$   if f$search("CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_6000.ISO") .nes. ""
$   then 
$     delete CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_6000.ISO;*
$   endif
$ endif
$
$!  See if we have sufficient free space for processing.
$!
$ FreeBlocks = f$getdvi("CDDVD$SCRATCH","FREEBLOCKS")
$ say "CDDVD$SCRATCH: contains ''FreeBlocks' free blocks"
$ if .not. reuse_files
$ then
$   Blocks_300MB = 600000 
$   Blocks_600MB = 1200000
$   Blocks_6000MB = 12000000
$   ReqBlocks = Blocks_300MB + Blocks_600MB + Blocks_6000MB
$   say "This operation requires ''ReqBlocks' free blocks, or more"
$   if FreeBlocks .lt. ReqBlocks
$   then
$     say "There is insufficient free storage on CDDVD$SCRATCH"
$     exit
$   endif
$ endif
$
$
$!  Our last remarks to the (interactive) user. 
$!
$ if .not. opcom_prompt
$ then
$   say " "
$   say "Press CTRL/Z at any prompt to skip the test, ..."
$   say "  ...and press [return] to continue."
$   say " "
$ endif
$
$!  Create the backing storage for the LD devices, if needed.
$!  If we have to create the files, we also cannot reuse them.
$!
$ if f$search("CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_300.ISO") .eqs. "" 
$ then
$   reuse_files = "FALSE"
$   ld create/nocontig/size='blocks_300MB' -
      CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_300.ISO
$ endif
$ if f$search("CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_600.ISO") .eqs. "" 
$ then
$   reuse_files = "FALSE"
$   ld create/nocontig/size='blocks_600MB' -
      CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_600.ISO
$ endif
$ if f$search("CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_6000.ISO") .eqs. "" 
$ then
$   reuse_files = "FALSE"
$   ld create/nocontig/size='blocks_6000MB' -
      CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_6000.ISO
$ endif
$
$
$! Overwrite the contents of the targets with pattern data -- create
$! the recording master for subsequent recording operations.  (This
$! pattern overwrite provides consistent and reproducible input data
$! for purposes of testing and verification, but this is not strictly
$! necessary.  Most any input, including whatever happens to be 
$! underneath the LD disk device or in the backing storage file when 
$! it is created, could potentially be used as a data source here.)
$!
$! (That a user reading the created disk can potentially find this disk
$! data from the uninitialized areas of the input volume structure is
$! also why production users will want to INITIALIZE/ERASE or otherwise
$! overwrite any potentially sensitive data that might exist underneath
$! the unallocated blocks present within the master; this to avoid this
$! variant of the classic "disk scavenging" security exposure.)
$!
$! For normal recording operations, the disk data to be mastered would
$! be loaded into the LD device, or an ISO (raw, binary, block) disk 
$! image file would be located and loaded, and the LD disk or the ISO
$! file would be the data source.  Not the CDDVD/PATTERN pattern data.
$!
$ ld connect CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_300.ISO lda300:
$ if .not. reuse_files
$ then
$   cddvd/pattern/noconfirm lda300:
$ endif
$ if .not. reuse_files
$ then
$   cddvd/pattern/noconfirm CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_600.ISO
$ endif
$ ld connect CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_600.ISO lda600:
$
$
$! Now start the testing...
$
$!  See if we can verify the basic operation of the CDDVD/COPY
$!  and the CDDVD/COMPARE commands, as a start.
$!
$ if copy_and_compare
$ then
$   if f$search("CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_300_TMP.ISO") .nes. ""
$   then
$     delete CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_300_TMP.ISO;*
$   endif
$
$!  /copy permits the creation of a disk image file from the
$!  specified device -- this is a raw disk or the so-called
$!  ISO image copy.
$!
$   cddvd/copy'diagnostics_setting' lda300: -
      CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_300_TMP.ISO
$
$!  /compare permits only a device spec as its second parameter
$!
$   cddvd/compare'diagnostics_setting' -
    CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_300_TMP.ISO lda300:
$   if f$search("CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_300_TMP.ISO") .nes. ""
$   then
$     delete CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_300_TMP.ISO;*
$   endif
$ endif
$
$
$! What follows is a table of various of the profile codes used
$! by MMC-compliant devices.  See the T10 documentation for the
$! official list, and see the OpenVMS T10DEF module for the most
$! current list of codes most recently recognized by OpenVMS.
$! (That a profile code is recognized does NOT indicate that the
$! associated media can be recorded, nor that the particular
$! profile is supported.)  
$!
$! Subsequent tests use this list of codes as part of determining
$! what media is loaded into the device, and whether or not the 
$! particular device test can be successfully invoked.
$!
$! Any profiles that are listed as AVAILABLE imply device-level
$! support, while profiles that are listed as AVAILABLE and 
$! CURRENT imply compatible media is loaded into the device.
$! Neither specifically implies software support, obviously.
$!
$!    T10$K_PROF_FIXEDDISK          1         Fixed disk
$!    T10$K_PROF_REMOVABLE          2         Removable disk
$!    T10$K_PROF_MOERASABLE         3         Magneto-optical
$!    T10$K_PROF_WORMDISK           4         Write-Once Disk
$!    T10$K_PROF_ASMO               5         Advance Storage
$!    T10$K_PROF_CDROM              8         CD-ROM; can
$!    T10$K_PROF_CDR                9         CD-R
$!    T10$K_PROF_CDRW               10        CD-RW
$!    T10$K_PROF_DVDROM             16        DVD-ROM
$!    T10$K_PROF_DVDMINUSRSEQ       17        DVD-R
$!    T10$K_PROF_DVDRAM             18        DVD-RAM
$!    T10$K_PROF_DVDMINUSRWRO       19        DVD-RW
$!    T10$K_PROF_DVDMINUSRWSEQ      20        DVD-RW
$!    T10$K_PROF_DVDMINUSRDLSEQ     21        DVD-R DL
$!    T10$K_PROF_DVDMINUSRDLJMP     22        DVD-R DL jump
$!    T10$K_PROF_DVDPLUSRW          26        DVD+RW
$!    T10$K_PROF_DVDPLUSR           27        DVD+R
$!    T10$K_PROF_DDCDROM            32        DDCD-ROM
$!    T10$K_PROF_DDCDR              33        DDCD-R
$!    T10$K_PROF_DDCDRW             34        DDCD-RW
$!    T10$K_PROF_DVDPLUSRWDL        42        DVD+RW DL
$!    T10$K_PROF_DVDPLUSRDL         43        DVD+R DL
$!    T10$K_PROF_BDROM              64        BD-ROM
$!    T10$K_PROF_BDRSRM             65        BD-R SRM
$!    T10$K_PROF_BDRRRM             66        BD-R RRM
$!    T10$K_PROF_BDRE               67        BD-RE
$!    T10$K_PROF_HDDVDROM           80        HD DVD-ROM
$!    T10$K_PROF_HDDVDR             81        HD DVD-R
$!    T10$K_PROF_HDDVDRW            82        HD DVD-RW
$!    T10$K_PROF_NONCONFORM         65536     Logical unit
$!
$! Beware: the codes shown here are represented in decimal, though
$! the T10 documentation tends to use and to assume hexadecimal.
$! (The following eschews the /NOLOG, as we want to see all of
$! what the device claims it can do.)
$!
$ cddvd/inquire CDDVD$DEVICE_TEST_TARGET:
$Retry_Inquire_Available:
$ Retry_Count = 0
$ if $severity .nes. "1"
$ then 
$   Retry_Count = Retry_Count + 1
$   if Retry_Count .ge. 10 then Goto Done
$   Say "Waiting for target test device to be ready"
$   wait 00:00:05
$   goto Retry_Inquire_Available
$ endif
$ CDDVD$$DEVICE_PROFILES == CDDVD$PROFILE_AVAILABLE
$
$
$
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$
$
$! The main test sequence follows.
$!
$ say " "
$ say "+---------------------------------------+"
$ say "| Starting device compatibility testing |"
$ say "+---------------------------------------+"
$ say " "
$
$ Gosub Try_CDRW
$
$ Gosub Try_CDR1
$
$ Gosub Try_CDR2
$
$ GoSub Try_DVDplusR
$
$ Gosub Try_DVDplusRW
$
$ if test_unsupported_media_formats then Gosub Try_DVDplusRDL
$
$
$ say " "
$ say "+----------------------------------------+"
$ say "| Device compatibility testing completed |"
$ say "+----------------------------------------+"
$ say " "
$
$
$
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$
$
$! Main exit starts as follows
$!
$Done:
$ say " "
$ say "Testing sequence ended; disconnecting LD devices."
$ say " "
$
$ if f$getdvi("LDA300:","EXISTS")
$ then 
$   if f$getdvi("LDA300:","MNT") then dismount LDA300:
$   ld disconnect LDA300:
$ endif
$ if f$getdvi("LDA600:","EXISTS") 
$ then 
$   if f$getdvi("LDA600:","MNT") then dismount LDA600:
$   ld disconnect LDA600:
$ endif
$ if f$getdvi("LDA6000:","EXISTS") 
$ then 
$   if f$getdvi("LDA6000:","MNT") then dismount LDA6000:
$   ld disconnect LDA6000:
$ endif
$
$ say " "
$ say "If this is to be the last use of this test procedure,"
$ say "you will likely want to DELETE the following files:"
$ say "    CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_*.ISO;* "
$ say "These files will be automatically recreated when you"
$ say "next invoke this procedure, and no data will be lost."
$ say " "
$ directory/size/width=size=9/noheader/notrailer -
    CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_*.ISO
$ say " "
$
$ oldpriv = f$setprv(oldpriv)
$!
$ exit
$
$
$
$ Exit
$
$
$
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$
$PROMPT_NEXT: subroutine
$
$!  Chat with the user as needed, using whatever I/O path(s) 
$!  were requested.
$!
$
$ if opcom_prompt
$ then 
$
$!  We'll generally see "%X10058029" (alles ist gut), "%X1005801C" (which
$!  is the condition status that results from the REPLY/ABORT operation),
$!  or  "%X10058061" (OPCOM$_NOOPERATOR, No Operator Coverage) returned 
$!  by REQUEST/REPLY.   The condition value %X10058062 is an error-level
$!  version of the OPCOM$_NOOPERATOR message, a condition value we have 
$!  here borrowed for (re)use as a (failing) return value.
$!
$   say "REQUEST/REPLY wait is starting at " + f$time()
$   request/to=disks/reply "''p1'"
$   reqrep_status = $status
$   say "REQUEST/REPLY wait completed at " + f$time()
$   if f$integer(reqrep_status) .eq. f$integer("%X10058061")
$   then 
$     reqrep_status = %X10058062
$   endif
$   exit 'reqrep_status'
$ endif
$
$!  The default output prompt text is written to SYS$OUTPUT, per the
$!  usual DCL norms.  We can also optionally prompt to SYS$COMMAND, 
$!  which is very useful if the procedure output has been redirected
$!  elsewhere via, say, a @CDDVD$DEVICE_TEST.COM/OUTPUT=file command.
$!
$ say p1
$ if double_prompt then write sys$command p1
$
$!  If the caller has requested we ring the keyboard bell as part of
$!  the prompting sequence, construct the ASCII 7 character sequence 
$!  (the beep), and ring our bell.  (This sequence could also have
$!  used the COPY/RECORDABLE_MEDIA/BELL or CDDVD/INFORMATION/BELL
$!  qualifiers for this auditory reminder, but this DCL approach 
$!  avoids having to code optional /BELL specifications elsewhere.)
$!
$ if ring_the_bell
$ then 
$   beep = "*"
$   beep[0,7] = 7
$   write sys$command beep
$ endif
$
$ read/prompt="  and press [return] "/error=prompt_done sys$command rtn 
$ exit 1
$prompt_done:
$ exit %X10058062
$ endsubroutine
$
$
$
$ Exit
$
$
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$
$PROFILE_CURRENT: subroutine
$
$! Determine if the specified profile is available and current.
$!
$! There are easier ways to process the available-profile list-string
$! stored in CDDVD$PROFILE_AVAILABLE, particularly if we simply assume 
$! that just one profile could be available and current at any one time. 
$! (nb: CDDVD$PROFILE_AVAILABLE contains the |-delimited list of current
$! and available profile code(s),  then a || delimiter, and a |-delimited 
$! list of the available profile code(s).  The codes are in decimal.)
$!
$! This code very deliberately does not make this (unsafe) assumption.
$! Why?  Well, because there are recording devices that present more 
$! than one profile as current.
$!
$! The scheme here works when more than profile is active and current, 
$! or if the display-only text string stored in CDDVD$PROFILE_CURRENT
$! happens to be internationalized, or if CDDVD$PROFILE_CURRENT becomes
$! an aggregate of multiple text strings for current profiles.
$!
$! This subroutine returns SS$_WASCLR (1) or SS$_WASSET (9) if the
$! device CDDVD$PROFILE_AVAILABLE symbol indicates the specified 
$! profile code (P1) is not current or is current, respectively.
$!
$ ProfTarget = "|''p1'|"
$ cddvd/inquire/nolog CDDVD$DEVICE_TEST_TARGET:
$Retry_Inquire_Current:
$ Retry_Count = 0
$ if $severity .nes. "1"
$ then 
$   Retry_Count = Retry_Count + 1
$   if Retry_Count .ge. 10 then Exit 1
$   Say "Waiting for target test device to be ready"
$   wait 00:00:05
$   goto Retry_Inquire_Current
$ endif
$ CDDVD$$DEVICE_PROFILES == CDDVD$PROFILE_AVAILABLE
$ ProfDelim = f$locate("||",CDDVD$PROFILE_AVAILABLE)
$ if ProfDelim .eq. f$Length(CDDVD$PROFILE_AVAILABLE) then exit 1
$ ProfCurr = f$extract(0,ProfDelim,CDDVD$PROFILE_AVAILABLE) + "|"
$ ProfCurrLen = f$length(ProfCurr)
$ if f$locate(ProfTarget,ProfCurr) .eq. ProfCurrLen then exit 1
$ exit 9
$ endsubroutine
$
$
$
$ Exit
$
$
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$
$PROFILE_AVAILABLE: subroutine
$
$! Determine if the specified profile is available.  (The requested
$! profile may or may not be current, obviously -- this subroutine
$! is only concerned with whether or not the capability is present,
$! and not if the capability is immediately ready for any testing.)
$!
$! This subroutine returns SS$_WASCLR (1) or SS$_WASSET (9) if the
$! device (ancestral) CDDVD$PROFILE_AVAILABLE symbol indicates the
$! specified profile code (P1) is not available or is available, 
$! respectively.
$!
$ ProfTarget = "|''p1'|"
$ ProfLen = f$length(CDDVD$$DEVICE_PROFILES) 
$ if f$locate(ProfTarget,CDDVD$$DEVICE_PROFILES) .eq. ProfLen then exit 1
$ exit 9
$ endsubroutine
$
$
$
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$
$!  The following is the first CD-R test.
$!
$ Exit
$Try_CDR1:
$ Call PROFILE_AVAILABLE 9
$ if $status .eqs. "%X00000001" then return 1
$Retry_CDR1:
$ Call PROMPT_NEXT "Please insert a scratch CD-R disk ..."
$ if $severity .nes. "1" then return 1553
$ Call PROFILE_CURRENT 9
$ if $status .eqs. "%X00000001" then goto Retry_CDR1
$! start the testing...
$ copy/record/nowrite'diagnostics_setting' -
    lda300: CDDVD$DEVICE_TEST_TARGET:
$ if $severity .nes. "1" then return 1
$ say "The following test should fail:"
$ copy/record/diag=level=2/verify -
    lda300: CDDVD$DEVICE_TEST_TARGET:
$ if $severity .nes. "1" then return 1
$ say "The following test should fail:"
$ copy/record/format/diag=level=2 -
    lda300: CDDVD$DEVICE_TEST_TARGET:
$ say "The following test should fail:"
$ copy/record/diag=level=2 -
    lda300: CDDVD$DEVICE_TEST_TARGET:
$! finish the testing...
$ cddvd/inquire CDDVD$DEVICE_TEST_TARGET:
$ say "Test with profile " + CDDVD$PROFILE_CURRENT + " completed."
$ say " "
$ return 1
$
$
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$
$!  The following is the second CD-R test.
$!
$ Exit
$Try_CDR2:
$ Call PROFILE_AVAILABLE 9
$ if $status .eqs. "%X00000001" then return 1
$Retry_CDR2:
$ Call PROMPT_NEXT "Please insert a second scratch CD-R disk ..."
$ if $severity .nes. "1" then return 1553
$ Call PROFILE_CURRENT 9
$ if $status .eqs. "%X00000001" then Goto Retry_CDR2
$! start the testing...
$ copy/record lda600: CDDVD$DEVICE_TEST_TARGET:/diag=level=2/verify
$ if $severity .nes. "1" then return 1
$! finish the testing...
$ cddvd/inquire CDDVD$DEVICE_TEST_TARGET:
$ say "Test with profile " + CDDVD$PROFILE_CURRENT + " completed."
$ say " "
$ return 1
$
$
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$
$!  The following is the CD-RW test.
$!
$ Exit
$Try_CDRW:
$ Call PROFILE_AVAILABLE 10
$ if $status .eqs. "%X00000001" then return 1
$Retry_CDRW:
$ Call PROMPT_NEXT "Please insert a scratch CD-RW disk ..."
$ if $severity .nes. "1" then return 1553
$ Call PROFILE_CURRENT 10
$ if $status .eqs. "%X00000001" then goto Retry_CDRW
$! start the testing...
$ copy/record/format=erase/verify'diagnostics_setting' -
    lda300: CDDVD$DEVICE_TEST_TARGET:/log
$ if $severity .nes. "1" then return 1
$! On success, the following command should generate no output.
$ copy/record/format/nolog/verify -
    lda300: CDDVD$DEVICE_TEST_TARGET:
$ if $severity .nes. "1" then return 1
$ ld disconnect lda300:
$ copy/record/format -
  CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_300.ISO -
  CDDVD$DEVICE_TEST_TARGET: -
  /diag=level=2/verify
$ if $severity .nes. "1" then return 1
$ ld connect CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_300.ISO lda300:
$ cddvd/inquire CDDVD$DEVICE_TEST_TARGET:
$ say "Test with profile " + CDDVD$PROFILE_CURRENT + " completed."
$ say " "
$ return 1
$
$
$
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$
$!  The following is the DVD+R test.
$!
$ Exit
$Try_DVDplusR:
$ Call PROFILE_AVAILABLE  27
$ if $status .eqs. "%X00000001" then return 1
$Retry_DVDplusR:
$ Call PROMPT_NEXT "Please insert a scratch DVD+R disk ..."
$ if $severity .nes. "1" then return 1553
$ Call PROFILE_CURRENT  27
$ if $status .eqs. "%X00000001" then goto Retry_DVDplusR
$! start the testing...
$ copy/record/diag=level=2/verify -
    lda600: CDDVD$DEVICE_TEST_TARGET:
$ if $severity .nes. "1" then return 1
$! finish the testing...
$ cddvd/inquire CDDVD$DEVICE_TEST_TARGET:
$ say "Test with profile " + CDDVD$PROFILE_CURRENT + " completed."
$ say " "
$ return 1
$
$
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$
$!  Test with (unsupported) DVD+R DL.
$!
$ Exit
$Try_DVDplusRDL:
$ Call PROFILE_AVAILABLE 43
$ if $status .eqs. "%X00000001" then return 1
$Retry_DVDplusRDL:
$ Call PROMPT_NEXT "Please insert a scratch DVD+R DL disk ..."
$ if $severity .nes. "1" then return 1553
$ Call PROFILE_CURRENT  43
$ if $status .eqs. "%X00000001" then Retry_DVDplusRDL
$ cddvd/inquire CDDVD$DEVICE_TEST_TARGET:
$ say "Current target profile: " + CDDVD$PROFILE_CURRENT
$ if .not. reuse_files
$ then
$   cddvd/pattern/algorithm=(sequential,address) -
    /noconfirm'diagnostics_setting' -
      CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_6000.ISO
$   if $severity .nes. "1" then return 1
$ endif
$ ld connect CDDVD$SCRATCH:CDDVD_TEST_SCRATCH_6000.ISO lda6000:
$ copy/record/format/verify'diagnostics_setting' -
    lda6000: CDDVD$DEVICE_TEST_TARGET:
$ if $severity .nes. "1" then return 1
$! finish the testing...
$ cddvd/inquire CDDVD$DEVICE_TEST_TARGET:
$ say "Current target profile: " + CDDVD$PROFILE_CURRENT
$ say "Test with profile " + CDDVD$PROFILE_CURRENT + " completed."
$ say " "
$ return 1
$
$
$!  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
$
$!  See what happens with DVD+RW.
$!
$ Exit
$Try_DVDplusRW:
$ Call PROFILE_AVAILABLE  26
$ if $status .eqs. "%X00000001" then return 1
$Retry_DVDplusRW:
$ Call PROMPT_NEXT "Please insert a scratch DVD+RW disk ..."
$ if $severity .nes. "1" then return 1553
$ Call PROFILE_CURRENT  26
$ if $status .eqs. "%X00000001" then goto Retry_DVDplusRW
$ copy/record/format lda600: CDDVD$DEVICE_TEST_TARGET:
$ if $severity .nes. "1" then return 1
$ copy/record/format/diag=level=2/verify -
    lda300: CDDVD$DEVICE_TEST_TARGET:
$ if $severity .nes. "1" then return 1
$! finish the testing...
$ cddvd/inquire CDDVD$DEVICE_TEST_TARGET:
$ say "Test with profile " + CDDVD$PROFILE_CURRENT + " completed."
$ say " "
$ return 1
$