From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 17-MAR-1989 23:05
To:	MRGATE::"ARISIA::EVERHART"
Subj:	detype facility


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Thu, 16 MAR 89 07:28:20 PDT
Received: from CUNYVM.CUNY.EDU by KL.SRI.COM with TCP; Thu, 16 Mar 89 07:01:42 PST
Received: from hdetud51.bitnet by CUNYVM.CUNY.EDU (IBM VM SMTP R1.1) with BSMTP id 7714; Thu, 16 Mar 89 10:01:04 EST
Date: Thu, 16 Mar 89 15:56 UT+1
From: GDFGEJO%HDETUD51.BITNET@CUNYVM.CUNY.EDU
Subject: detype facility
To: info-vax@kl.sri.com
X-VMS-To: IN%"info-vax@kl.sri.com"

Hi,

The following facility will allow you to detype files (which I call grand
summary or .gs files) made by the VMS $ type/output= facility. I use it to
compress the amount of space allocated on disk e.g. if you have some few
hunderd subroutines of a subroutine package.

How it works,

Suppose you got a directory of 1000 small *.sub files which are all as large
as about 2 to 4 blocks. Practice learns that these directories become real
large (e.g. 5000 blocks) since VMS allocates files being a multiple of the
cluster factor on disk (in my case 4 blocks). An efficient way of reducing
the amount of disk space and time to backup this mess is:

$ purge *.sub                     ! do not type old versions
$ type/output=project.gs *.sub    ! compress the mess
$ del *.sub;*                     ! a friendly gesture to the sys manager

Well, you will see that (depending on the average file size) the amount of
space is reduced by a factor of 3 or sometimes even more. These .gs files
are nice for archiving purposes. Now, how to detype this .gs file? VMS can't
but the following program can. Make sure that the prefix string matches what
$ type produces.

--------------------------- cut here ----------------------------------
c------------------------------------------------------------------------------
c
c Rules for detyping a grand summary (.gs) file:
c
c 1) Use TYPE to create a .gs file, do not include different versions.
c    e.g. $ type/output=subfils.gs *.sub   (valid)
c         $ type/output=subfils.gs *.sub;* (might cause errors)
c
c 2) Make sure that the prefix and prelen (length of prefix string) match
c    the output of type. Change the first parameter statements where needed
c    Type puts the full file spec including disk unit on the first position.
c    Avoid to type file contents having the prefix string at the beginning.
c
c 3) If parameter skipfirst=.true. then the first record after the fileid
c    string is skipped. (standard type output)
c
c 4) Header records before the first fileid string are ignored as comment
c    (you can use this facility to comment the .gs files)
c
c 5) Leading spaces at the end of a output record are ignored
c
c------------------------------------------------------------------------------
      program detype
      implicit none

      parameter prefix='QSA2:'   ! look what type produces.....
      parameter prelen=5
      parameter skipfirst=.true.

      character*255 file,record,outfile
      integer i,unit,long,outlen,end,lines,files
      logical continue,starting

 10   write(6,'('' Enter .gs file -->'',$)')
      read(5,'(q,a)',end=9999) long,file(1:long+1)
      if (long.eq.0) goto 10

      open(unit=1,name=file(1:long),status='old',readonly,err=10)

      write(6,*)
      write(6,'('' Directory of file '',a)') file(1:long)
      write(6,*)

 20   read(1,'(q,a)',end=30) long,record(1:long+1)
        if (long.gt.prelen) then
          if (record(1:prelen).eq.prefix) then
            call trimfilespec( record,long,outfile,outlen )
            write(6,'(x,a,t50,a)') record(1:long),' alias '//outfile(1:outlen)
          end if
        endif
      goto 20

 30   write(6,*)
 40   write(6,'('' End of directory, Convert file(s) (t/f) :'',$)')
      read(5,*,end=40) continue

      if (.not.continue) then
        close(unit=1)
        goto 10
      end if

      starting=.true.
      write(6,*)
      lines=0
      files=0
      rewind 1
 50   read(1,'(q,a)',end=60) long,record(1:long+1)
        if (long.gt.prelen) then
          if (record(1:prelen).eq.prefix) then
            if (starting) then
              starting=.false.
            else
              close(unit=2)
            end if
            call trimfilespec( record,long,outfile,outlen )
            write(6,'(x,''Writing in '',a)') outfile(1:outlen)
            files=files+1
            open(unit=2,name=outfile(1:outlen),status='new',carriagecontrol='lis
   t')
            if (skipfirst) read(1,*)
            goto 50
          end if
        endif
        if (.not.starting) then
          end=0
          do i=long,1,-1
            if (record(i:i).ne.' ') then
              end=i
              goto 70
            end if
          end do
 70       if (end.eq.0) then
            write(2,*)
          else
            write(2,'(a)') record(1:end)
          end if
          lines=lines+1
        end if
      goto 50
 60   continue

      close(unit=1)
      close(unit=2)
      write(6,*)
      write(6,'('' Number of lines written :'',i5)') lines
      write(6,'('' Number of files made    :'',i5)') files
      write(6,*)

      goto 10

 9999 stop 'end of program.'
      end
c------------------------------------------------------------------------
      subroutine trimfilespec( record,long,outfile,outlen )
      implicit none

      character*(*) record,outfile
      integer long,outlen

      integer i,j,pos1,pos2

c step#1 ... scan for ] or > character

      do i=1,long
        if ((record(i:i).eq.']').or.(record(i:i).eq.'>')) then
          pos1=i
          goto 10
        end if
      end do

      stop 'illegal file specification, you probably did not use $ type'

c step#2 ... scan for ; character

 10   do i=pos1+1,long
        if ((record(i:i).eq.';').or.(record(i:i).eq.' ')) then
          pos2=i
          goto 20
        end if
      end do

      pos2=long+1

 20   j=0
      do i=pos1+1,pos2-1
        j=j+1
        outfile(j:j)=record(i:i)
      end do
      outlen=j

      end
--------------------------- cut here ----------------------------------

No funny stories today, It keeps the doctor away.

Ejo Schrama

gdfgejo.hdetud51.bitnet

