compact the workspace from a script or function

[martinwcole]

The documentation warns they do no guarantee a5.compact() or a5_databasecompact()
I tried using the functions and they work about half the time but the other half they damage some of the files

I am trying to get a script or function that will compact the workspace about 2AM

any ideas

[Al Buchholz]

The documentation warns they do no guarantee a5.compact() or a5_databasecompact()
I tried using the functions and they work about half the time but the other half they damage some of the files

I am trying to get a script or function that will compact the workspace about 2AM

any ideas

Probably wanna zip up the database to a unique name first..

Or build your own with <tbl>.pack() to get a result value.

[Ronald Anusiewicz]

I have written a script to update my application. One of the last actions of this script is to call this function after the update.
The original date of my update script is 2004. I have been running the cleanup for a long time and I have never experienced any kind of data corruption or loss.
There are a couple of lines specific to my application.

If a table has any records where "Transno" field is blank, that record is considered an orphan and is deleted.

In the function Check_Memos, tList holds the names of the memo tables specific to my application.
Otherwise, I think the function should work for you.

FUNCTION Compact_After_Update as L ()
    'Show PleaseWait92 Function, msg declared for title 'Refreshing Data Tables'
    dim shared msg as C
    dim text as c
    dim box as c
    runtime = 1
    msg = "Rebuilding Indexes"
    PleaseWait92(.t.,msg)

    'Pack all of the tables in the Database except for the 'menu' table.
    omit_tables_short = <<%list%
fmenu
%list%
    'convert short table names to fully qualified table names.
    omit_tables = *for_each(x,table.filename_get(x),omit_tables_short)

    dim table_list as c
    table_list = a5.table_enum(2)

    IF omit_tables <> "" THEN
        table_list = word_subtract(table_list,omit_tables,crlf())
    END IF

    'check if any tables are in use. the *for_each() funtion loops through each table
    'and returns a crlf delimited string with table_filename|True, or table_filename|False
    in_use = *for_each(x,x+"|"+table.in_use(x),table_list)

    tables_in_use = filter_string(in_use,"|True",crlf())
    tables_in_use = stritran(tables_in_use,"|True","")

    tables_to_update = filter_string(in_use,"|False",crlf())
    tables_to_update = stritran(tables_to_update,"|False","")

    dim count as n
    count = w_count(tables_to_update,crlf())
    dim i as n
    dim tbl as p

    FOR i = 1 TO count
        table_i = word(tables_to_update,i,crlf())
        pct = round((i/count)*99,0)
        ui_modeless_dlg_refresh(msg)
        ui_yield()

        tbl = table.open(table_i)
        on error goto no_Transno
        Transno_fld = file.filename_parse(table_i,"n") + "->Transno"
        fld = tbl.field_get(Transno_fld)
        tbl.delete_range("isblank(\"Transno\")")
        no_Transno:

        on error goto 0
        deleted_count = tbl.records_deleted()
        IF deleted_count > 0 THEN
            tbl.pack()
        else
            tbl.update_production_index()
        END IF
        Dictionary.update(table_i)
        tbl.close()
    NEXT i

    PleaseWait92(.f.,msg)
    IF tables_in_use <> "" THEN
        count = w_count(tables_in_use,crlf())
        IF count =  1 THEN
            msg = "1 table could not be done because the table was in use." + crlf(2) + tables_in_use
        ELSE
            msg = ""+ count+ " tables could not be done because the tables were in use." + crlf(2) + tables_in_use
        END IF
        'ui_msg_box("Notice",msg,ui_information_symbol)
        END
    END IF

    'Check Memos for linking errors
    Check_Memos()

END FUNCTION


FUNCTION Check_Memos as L ()
    tList = <<%a%
mfix
r_wofix
wofix
%a%

    for each foo in tList
        t = table.open(foo)
        vResults = t.memo_check("v")
        t.close()

        IF vResults = ""
            '"No errors found in connections between memos
        ELSE
            ui_msg_box("Warning - Corrupt Memo",\
            "The next screen will have a list of errors and a file name.  Save this information and Contact the Author.",\
            UI_STOP_SYMBOL)
            vFileName = get_unique_filename(a5.get_path() +chr(92) +"memo_verify.txt")
            save_to_file(vResults, vFileName)
            a5_addtempfile(vFileName)
            sys_open(vFileName)
        END IF
    next
END FUNCTION


FUNCTION PleaseWait92 AS C (Show = .F.,msg="" )
    PleaseWait92 = ""

    IF show = .F.
        IF ui_modeless_dlg_exist(msg)
            ui_modeless_dlg_close(msg)
        END IF
        exit function
    END IF

    dim shared pct as N
    box_code = <<%dlg%
{background=Dirty White}
{font=arial,26,i}
  Please Wait!    
{'};
{font=arial,12}
{sp=32}{text=4pct}%;
  {progress=60pct}  {'};
{'}
%dlg%
    ui_modeless_dlg_box(msg,box_code)
    box_event = <<%code%
2=2
%code%
    ui_modeless_dlg_box(msg,box_code,box_event)
END FUNCTION​

[martinwcole]

When you say you run this after "updating" the database -- what do you mean by updating the database?

[Ronald Anusiewicz]

I have an “updatebuild” script in the code tab which contains the code needed to make changes to the application. I copy the latest version of the update build script to the app’s code tab. I assign a build number to my application. When the application is opened, the autoexec runs the script updatebuild. The script will get the current version of the app and compare this version to the latest version I coded in the updatebuild script.

If the build numbers are the same, the script ends. If not, the updatebuild script runs making whatever changes I programed to be executed.

dim t as P
dim CurrentBuild as C
dim NewBuild as C
dim shared buildno as C

buildno = "403"    'Enter new build number here

NewBuild = "Version 1.1  Build "+buildno
t = table.open("fmenu",FILE_RO_SHARED)
CurrentBuild = alltrim(t.Blank)
t.close()

IF CurrentBuild = NewBuild THEN
    END
END IF​

Here are some examples of likely changes to be made:

''7 - *add fields to multiple 'WO_Hdr' tables (2)
''8 - add fields to the table 'fm_items'
''9 - populate the ToolID field in the table 'fm_items'
''10 - set the rule rules for the ToolID field in the table 'fm_items'
''11 - mysettings.Update_Email as C = "[email protected]" a5_save_settings("WO_App", mysettings)
''13 - *update fields in multiple 'WO' tables (9)
''14 - add fields to the table 'vendors'
''18 - *Add the index 'Vendors' to the PO_Hdr table
''19 - Add fields to 'PO_Hdr' table
''20 - Add fields to 'woSquawk' table

​

At the end of the updatebuild script, I have the following code which does a cleanup, sets the new build number and restarts the application.

'compact tables, rebuild indexes and check memo links after this update
Compact_After_Update()

dim vAppVersionNumber as N
vAppVersionNumber = val("1."+buildno)

if a5_getappversionnumber() <> vAppVersionNumber then
    a5_setappversionnumber(vAppVersionNumber)
end if

ui_msg_box(" Success",\
"The Upgrade to Build " + buildno + " is Complete!" + crlf(2) + "The Application will now be Restarted",\
UI_INFORMATION_SYMBOL)

''Restart the application
app_Restart(a5.Get_Name() )

END​

Normally I’m viewing the computer screen when this script is running. With some changes to the code. it should run unattended. May need to incorporate some error trapping which I would then write the errors to a table.

abortscript:
on error goto 0
PleaseWait82(.f.,msg)
err_msg=error_text_get(error_code_get())
err_numb=error_code_get()
line=error_line_number_get()
script=error_script_get()
ui_msg_box("Error",\
err_msg+" Error occurred at line "+alltrim(str(line,4,0))+" in script: "+script)



dim t as P
t = table.open("Sys_Errors")
t.enter_begin()
t.Er_date=date()
t.Er_time=now()
t.Er_computer=api_getmachinename()
t.Er_user=api_getusername()
t.Er_Msg_Text=err_msg
t.Er_msg=error_text_get(error_code_get())
t.Er_line=error_line_number_get()
t.Er_script=error_script_get()
t.enter_end(.t.)
t.close()
END

​

[martinwcole]

Ron, here is an abreviated version of your script which perfectly - thanks!!!
With 1044 tables and 850 indexes it runs in 8.1 minutes

t1=toseconds(time())
temp=a5.Table_Enum(2)
n=w_count(temp,crlf())
for i=1 to n
table_i=word(temp,i,crlf())
'msgbox("","" + table_i)
if table_i = "" .or. ("$$" $ table_i) .or. table.in_use(table_i)
else
tbl=table.open(table_i)
tbl.update_production_index()
Dictionary.update(table_i)
tbl.close()
end if
next
Indexes_RebuildNightly()
t2=toseconds(time())
t3=t2-t1
msgbox("","" + t3/60)

the routine automatically restarts the server at 2AM and then opens the program
at the top of the autoexec this runs
if toseconds(time()) >= 39600 .and. toseconds(time()) < 44000
script_play("zcompact")
a5.close()
end
end if

The current number of seconds are not 2AM but the time I was testing

[Ronald Anusiewicz]

Martin, you are more than welcome. You have helped so many over the years including myself, I very pleased that I was able to return the favor.

Thank you!

[martinwcole]

here is the code for a function that remove extensions with $$ that Stan Mathews helped me with, many years ago.

'Date Created: 26-Oct-2011 02:12:25 PM
'Last Updated: 16-Jul-2023 09:29:18 AM
'Created By : martin cole
'Updated By : administrator
function cleanother2 as L()
DIM path[10] as c
path[1] = a5.get_path() + chr(92)
path[2] = a5.get_private_path() + chr(92)
pcount = 2
IF a5.get_private_path() <> a5.get_exe_path()
path[3] = a5.get_exe_path() + chr(92)
pcount = 3
END IF
fcount = 0
FOR x = 1 to pcount
'type_of_files = 0 + FILE_FIND_ARCHIVE + FILE_FIND_READONLY + FILE_FIND_HIDDEN
'dfiles = filefind.first( path[x] + "$$*.*", type_of_files )
dfiles = filefind.first( path[x] + "*.$$*", FILE_FIND_NOT_DIRECTORY )
WHILE .not.dfiles.eof()
fname = dfiles.name() '*** GET THE FILE NAME.
ON ERROR goto Continue_next '*** FIND OUT IF THE FILE IS LOCKED.
fp = file.open( fname, file_rw_exclusive )
ON ERROR goto 0
fp.close() '*** FILE IS NOT LOCKED SO CLOSE IT AND REMOVE IT.
file.remove( fname )
fcount = fcount + 1
'---------------
Continue_next:
'---------------
ON ERROR goto 0
dfiles.next() '*** GET NEXT FILE IN LIST.
statusbar.robot()
END WHILE
NEXT
end function