openaccess/source/modules/OA_Main.bas

Option Compare Database
Option Explicit

'****
'*
'* Main methods for OpenAccess add-in
'*
'****
Public Const opInterrupted = 10
Public Const opCancelled = 11
Public Const opCompleted = 12
Public Const opCompletedWithErrors = 13

Dim debug_mode As Boolean
Public Sub activate_debug_mode()
    debug_mode = True
End Sub

'>> main function, called when addin is run
Public Function main()

    DoCmd.OpenForm "OpenAccess"

End Function

Public Function make_sources(Optional ByVal newer_only As Boolean = False, _
                             Optional ByVal zip As Boolean = True) As Integer
    'exports the source-code of the app
    If Not debug_mode Then On Error GoTo err
    Dim step As String
    Dim msg As String
    
    make_sources = opInterrupted
    step = "Initialization"
    
    'Save is needed to correctly list objects to export
    SaveProject

    step = "Prompt for confirmation"
    msg = "****   OPENACCESS EXPORT   ****" & vbNewLine & _
          "You're going to export:" & vbNewLine & vbNewLine & _
          msg_list_to_export(newer_only) & _
          ""
    If Not OA_MsgBox(msg, vbOKCancel + vbExclamation, "Confirm") = vbOK Then
        GoTo cancelOp
    End If

    If zip Then
        ' zip the app file
        step = "Zip the app file"
        logger "make_sources", "INFO", step
        Call zip_app_file
    End If
    
    ' run the export
    step = "Run Open Access Export"
    logger "make_sources", "INFO", step
    
    ExportAll newer_only

    ' new sources date
    step = "Updates sources date"
    logger "make_sources", "INFO", step
    Call update_sources_date

    ' cleans the obsolete files (see CleanDirs in optimizer)
    msg = CleanDirs(True)
    If Len(msg) > 0 Then
        msg = "# CLEANING # " & vbNewLine & "Following objects do not exist anymore, do you want to DELETE their source FILES?" & vbNewLine & _
          "" & msg
        If OA_MsgBox(msg, vbYesNo, "Cleaning Source Files") = vbYes Then
            Call CleanDirs
        End If
    End If

    If errors_occured() Then
        make_sources = opCompletedWithErrors
    Else
        make_sources = opCompleted
    End If
    
    Exit Function
    
err:
    OA_MsgBox "Unknown error - " & err.Description & " (#" & err.Number & ")" & vbNewLine & "See the log file for more information", vbCritical, "CRITICAL ERROR"
    If err.Number <> "60000" Then
        logger "make_sources", "ERROR", "Unknown error at: " & step & " - " & err.Description & "(#" & err.Number & ")"
    End If
    
    Exit Function
cancelOp:
    make_sources = opCancelled
    Exit Function
End Function


Public Function update_from_sources(Optional ByVal backup As Boolean) As Integer
'updates the application from the sources

    If Not debug_mode Then On Error GoTo err

    Dim backup_ok As Boolean
    Dim step As String
    Dim msg As String
    
    update_from_sources = opInterrupted
    
    step = "Prompt for confirmation"
    msg = "****   OPENACCESS IMPORT   ****" & vbNewLine & _
          "You're going to update " & UCase(CurrentProject.name) & " with the sources files" & vbNewLine & vbNewLine & _
          "WARNING: Any non exported work would be lost!"
    If Not OA_MsgBox(msg, vbOKCancel + vbExclamation, "Confirm") = vbOK Then
        GoTo cancelOp
    End If
    
    If backup Then
        step = "Creates a backup of the app file"
        logger "update_from_sources", "INFO", step
        backup_ok = make_backup()
    
        If Not backup_ok Then
            logger "update_from_sources", "ERROR", "Error: unable to backup the app file, do it manually, then click OK"
            OA_MsgBox "Error: unable to backup the app file, do it manually, then click OK", vbExclamation, "Backup"
        End If
    End If

    step = "Run Open Access Import"
    logger "update_from_sources", "INFO", step
    
    Call ImportAll
   
    step = "Cleaning obsolete objects in app"
    
    msg = CleanApp(True)
    If Len(msg) > 0 Then
        msg = "Following objects do not exist in the sources, do you want to delete them?" & vbNewLine & _
          "" & msg
        If OA_MsgBox(msg, vbYesNo, "Cleaning") = vbYes Then
            Call CleanApp
        End If
    End If
    
    ' new sources date to keep the optimizer working
    step = "Updates sources date"
    logger "update_from_sources", "INFO", step
    Call update_sources_date
    
    If errors_occured() Then
        update_from_sources = opCompletedWithErrors
    Else
        update_from_sources = opCompleted
    End If
    Exit Function
err:
    OA_MsgBox "Unknown error - " & err.Description & " (#" & err.Number & ")" & vbNewLine & "See the log file for more information", vbCritical, "CRITICAL ERROR"
    If err.Number <> "60000" Then
        logger "update_from_sources", "ERROR", "Unknown error at: " & step & " - " & err.Description & "(#" & err.Number & ")"
    End If
    
    Exit Function
cancelOp:
    update_from_sources = opCancelled
    Exit Function
End Function


Public Function zip_app_file() As Boolean
    On Error GoTo UnknownErr
    Dim command, shortname As String
    
    zip_app_file = False
    
    shortname = Split(CurrentProject.name, ".")(0)
    
    'run the shell comand
    Call cmd("cd " & CurrentProject.path & " & " & _
             "zip tmp_" & shortname & ".zip " & CurrentProject.name & _
             " & exit")
    
    'remove the old zip file
    If dir(CurrentProject.path & "\" & shortname & ".zip") <> "" Then
        Kill CurrentProject.path & "\" & shortname & ".zip"
    End If
    
    'rename the temporary zip
    Call cmd("cd " & CurrentProject.path & " & " & _
            "ren tmp_" & shortname & ".zip" & " " & shortname & ".zip" & _
            " & exit")
    
    logger "zip_app_file", "INFO", CurrentProject.path & "\" & CurrentProject.name & " zipped to " & CurrentProject.path & "\" & shortname & ".zip"
    zip_app_file = True

end_:
    Exit Function
UnknownErr:
    logger "zip_app_file", "ERROR", "Unable to zip " & CurrentProject.path & "\" & CurrentProject.name & " - " & err.Description
    OA_MsgBox "Unknown error: unable to ZIP the app file, do it manually"
    GoTo end_
End Function

Public Function make_backup() As Boolean
    On Error GoTo err
    
    make_backup = False
    If dir(CurrentProject.path & "\" & CurrentProject.name & ".old") <> "" Then
        Kill CurrentProject.path & "\" & CurrentProject.name & ".old"
    End If

    Call cmd("copy " & Chr(34) & CurrentProject.path & "\" & CurrentProject.name & Chr(34) & _
             " " & Chr(34) & CurrentProject.path & "\" & CurrentProject.name & ".old" & Chr(34))
    
    logger "make_backup", "INFO", CurrentProject.path & "\" & CurrentProject.name & " copied to " & CurrentProject.path & "\" & CurrentProject.name & ".old"
    
    make_backup = True
    Exit Function
err:
    logger "make_backup", "ERROR", "Error during the backup of " & CurrentProject.name & ": " & err.Description
    OA_MsgBox "Error during the backup of " & CurrentProject.name & ": " & err.Description & vbNewLine & "Do it manually"
End Function


Public Function silent_export()
    'used for tests
    
    OA_Msg.activate_SilentMode
    OA_Log.set_debug_mode

    Dim result As Variant
    result = make_sources(newer_only:=False, zip:=True)

    logger "silent_export", "INFO", "make_sources returned " & result

End Function

Public Function silent_import()
    'used for tests
    
    OA_Msg.activate_SilentMode
    OA_Log.set_debug_mode
    
    Dim result As Variant
    result = update_from_sources(backup:=True)

    logger "silent_export", "INFO", "update_from_sources returned " & result
    

End Function