[comp.os.vms] anyone have any clues why this doesn't work

ABSTINE@CLVMS.CLARKSON.EDU (Art Stine - Network Engineer) (04/21/88)

     
Folks:
        I am trying to whip up a quick and dirty program which will
        emulate the Unix tail program, ie, read the last n lines of
        a file. I wrote up the following code, which seems like it
        should work, but it doesn't seem to position the file at EOF.
        any clues what i'm doing wrong?
     
        thanks
     
art stine
network engineer
clarkson u
     
     
     
        character*80 inline
        external open_eof
        integer*4 for_len
        open(1, name='SYS$MANAGER:LPR_SERVER.LOG', type='OLD',
     &          useropen=open_eof)
     
        print 100
100     format('$Number of records from end? ')
        accept*,nback
        read(1,'(a)', end=5) inline
5       do i = 1, nback
                backspace 1
        enddo
10      read(1,'(a)', end=99) inline
        print *, inline
        goto 10
     
99      close(unit=1)
        call exit
        end
     
     
     
        INTEGER FUNCTION open_eof(fab, rab, lun)
        IMPLICIT NONE
!
! Include definition files
!
        INCLUDE '($SYSSRVNAM)'
        INCLUDE '($FABDEF)'
        INCLUDE '($RABDEF)'
!
! Parameter declarations
!
        RECORD /FABDEF/ fab
        RECORD /RABDEF/ rab
        INTEGER*4 lun
!
! Local storage
!
        INTEGER*4 status
     
     
!
! open file
!
        status = sys$open(fab)
!
! if opened ok, then connect stream to file
!
     
        IF (status) THEN
!
! set open at EOF flag
!
        rab.rab$l_rop = rab.rab$l_rop .OR. rab$m_eof
        status = sys$connect(rab)
     
        ENDIF
     
        open_eof = status
        return
        end

MCGEE@NUACC.ACNS.NWU.EDU (Randy McGee) (05/19/88)

>        I am trying to whip up a quick and dirty program which will
>        emulate the Unix tail program, ie, read the last n lines of
>        a file. I wrote up the following code, which seems like it
>        should work, but it doesn't seem to position the file at EOF.
>        any clues what i'm doing wrong?
     
Your program is attempting to use BACKSPACE illegaly.  The following was 
extracted from the "Programming in VAX FORTRAN" reference manual (V4.0, order 
number AA-D034D-TE) page 13-27:

   "You must no issue a BACKSPACE statement for a file that is open for 
   direct, keyed, or append access.  Backspacing from record n is done by
   rewinding to the start of the file and then performin n-1 successive reads
   to reach the previous record.  For direct, keyed, and append access, the
   current record count (n) is not available to the FORTRAN I/O system." 

The same thing is true when you use the USEROPEN option to position the 
file.  The following modified version of your program will work.

V(AX/VMS W)izard
Randy McGee (MAGOO) <mcgee@nuacc.acns.nwu.edu>     Phone:    (312) 491 4079
Academic Computing and Network Services            USPost:   2129 Sheridan Road
Northwestern University                                      Evanston, IL  60208

---[ TAIL.FOR ]---------------------------------------------------------------

        program tail

        implicit none

        integer*4 max_lines
        parameter (max_lines = 100)

        character*80 inline(max_lines)
        integer*4 lines, nback, P, I

        open( 1, name='SYS$MANAGER:LPR_SERVER.LOG', type='OLD', READONLY
     -      ,  SHARED )

        print 100, max_lines
100     format('$Number of records from end (<', I3, ')? ')
        accept*,nback
        if ( nback .gt. max_lines ) then
           type 101, max_lines
           nback = max_lines
        end if
101     format( ' Number greater than maximum allowed.  Using ', I3 )

        lines = 0
        do while( .true. )
           read(1,'(a)', end=5) inline( mod( lines, nback ) + 1 )
           lines = lines + 1
        end do
5       continue

        lines = lines - 1
        P = mod( lines, nback ) + 1

        if ( lines .eq. 0 ) then
           print *, 'File is empty'
        else
           if ( lines .gt. nback ) then
              if ( nback .ne. P ) then
                 do I = P + 1, nback
                    print *, inline( I )
                 end do
              end if
           end if
           do I = 1, P
              print *, inline( I )
           end do
        end if

        close(unit=1)

        call exit

        end