program FHOOKTST1,1.0(102)   ! demo of setting a file hook
!-------------------------------------------------------------------------
!EDIT HISTORY
![100] January 18, 2010 03:05 PM        Edited by jacques
!   Created
![101] January 19, 2010 03:05 PM        Edited by jacques
!   Misc changes
![102] June 09, 2011 03:36 PM           Edited by jack
!   Add no-change writes to test HFF_DATA_CHG_ONLY
!-------------------------------------------------------------------------
!NOTES:
!   This demo program uses MX_FILEHOOK to establish open, write and
!   close hooks for a sample file, FHOOKTST1.DAT, and then does some
!   operations on the file to test it.  The hook is serviced by
!   FHOOK1.SBX (which outputs a log to OPR:FHOOK1.LOG
!-------------------------------------------------------------------------
!
++include ashinc:ashell.def
++include ashinc:hook.def
++include fhooktst1.def


map1 misc
    map2 ch,b,2,150
    map2 recno,f
    map2 status,f
    map2 fileid,i,2
    map2 hookproc$,s,12
    map2 hookevents,b,4
    map2 hookflags,b,4
    map2 hookop,b,2
    map2 a,b,1
    map2 chgonly,b,1            ! [102]

map1 testrec,ST_TESTHOOKREC

    filebase 1

    ? tab(-1,0);"Test MX_HOOKFILE"

    ! establish the hook (note this can be done before
    ! even creating the file)

    hookop = HOOKOP_ADD             ! add a new hook
    hookproc$ = "SBX:FHOOK1"        ! Hook is handled by FHOOK1.SBX
    hookevents = HFE_POST_OPEN or HFE_POST_WRITE or HFE_POST_WRITEL &
        or HFE_POST_CLOSE or HFE_PRE_ALLOC      ! [101]

    ! [101] add a dummy hook (this is a test just to make sure the hook
    ! [101] table search isn't just picking up the first entry in the table
    xcall MIAMEX, MX_FILEHOOK,hookop,status,"test.dat",FHOOKTST1_ID+1, &
        hookproc$,0,hookflags

    ! the hookflags don't actually do much with SBX: hooks, except the
    ! HFF_DATA and HFF_DATA_WAS; everything else
    ! is passed to the SBX (including the hookflags)
    hookflags = HFF_PROG or HFF_SBX or HFF_RECNO or HFF_TIME or HFF_DATE  &
        or HFF_USER or HFF_DATA or HFF_DATA_WAS ! [101]

    hookflags = hookflags or HFF_AUTO_DEL   ! test auto delete operation

    input "Enter 1 to install hooks, 0 to skip: ",a
    if a then
        input "Enter 1 to set HFF_DATA_CHG_ONLY flag: ",chgonly ! [102]
        if chgonly then                                         ! [102]
            hookflags = hookflags or HFF_DATA_CHG_ONLY          ! [102]
        endif                                                   ! [102]
        ? "Setting hook for ";FHOOKTST1_FILE$;" ..."
        xcall MIAMEX, MX_FILEHOOK,hookop,status,FHOOKTST1_FILE$,FHOOKTST1_ID, &
            hookproc$,hookevents,hookflags
        ? "Status = ";status
        if status < 0 then
            ? "Error setting hook!"
            end
        endif
    endif


    if lookup(FHOOKTST1_FILE$) = 0 then
        ? "Allocating ";FHOOKTST1_FILE$;" (10 blocks)"
        allocate FHOOKTST1_FILE$,10

        ! test if hook altered the allocate (we set the HFE_PRE_ALLOC flag
        ! to allow the hook to do so, just as a test)
        ? "Actual allocated size (possibly altered by hook: ";abs(lookup(FHOOKTST1_FILE$)) + ")"  ![101]
    endif

    ? "Opening ";FHOOKTST1_FILE$;" ..."
    open #ch,FHOOKTST1_FILE$, random'forced, 64, recno

    ? "Initializing records 1-25..."
    testrec = fill$("]",len(testrec))
    for recno = 1 to 25
        writel #ch, testrec
    next recno

    ! Now update a few records
    ? "Updating rec #5..."
    recno = 5
    readl #ch, testrec
    testrec.id = recno using "#####Z"
    testrec.name = "John Doe, V"
    testrec.balance = 999.99
    testrec.limit = 5000
    write #ch, testrec

    ? "Updating rec #10..."
    recno = 10
    readl #ch, testrec
    testrec.id = recno using "#####Z"
    testrec.name = "Fred Smith, X"
    testrec.balance = 555.55
    testrec.limit = 1000
    write #ch, testrec

    ? "Updating rec #15..."
    recno = 15
    readl #ch, testrec
    testrec.id = recno using "#####Z"
    testrec.name = "Sally Jones"
    testrec.balance = 7777.77
    testrec.limit = 7500
    write #ch, testrec

    ? "Redundant update of rec #15..."      ! [102]-
    recno = 15
    readl #ch, testrec
    testrec.id = recno using "#####Z"
    testrec.name = "Sally Jones"
    testrec.balance = 7777.77
    testrec.limit = 7500
    write #ch, testrec                      ! -[102]

    ? "Closing file"
    close #ch

    ! [101] send an application-defined event to the hook
    ! [101] note: we can use either the filespec or the fid to
    ! [101] locate the file's hook; replace the handler parameter
    ! [101] with our own text
    xcall MIAMEX, MX_FILEHOOK,HOOKOP_APPEVENT,status,"",FHOOKTST1_ID, &
        "(This is a custom hook event message)",HFE_APP_EVENT1


    ? "Test complete - see OPR:FHOOK1.LOG for audit trail"
    end