openaccess/source/modules/VCS_Main.bas

Option Compare Database

'****
'*
'* Main methods for VCS add-in
'*
'****

Public Const opInterrupted = 10
Public Const opCancelled = 11
Public Const opCompleted = 12

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

    DoCmd.OpenForm "frm_vcs"

End Function


Public Function make_sources(Optional ByVal options As String = "") As Integer
'exports the source-code of the app
On Error GoTo err
Dim step As String

    make_sources = opInterrupted
    
    If InStr(options, "-d") Then set_debug_mode
    
    step = "Initialization"
    
    ' backup of the sources date, in case of error
    Dim old_sources_date As Date
    old_sources_date = vcs_param("sources_date", #1/1/1900#)
    
    '*** If '-f' is not in the options: set the optimizer on
    If Not InStr(options, "-f") > 0 Then
        Dim msg As String
        
        If old_sources_date > #1/1/1900# Then

            msg = msg_list_to_export()
            logger "make_sources", "INFO", "Optimizer: ask for confirmation"
            If Not Len(msg) > 0 Then
                msg = "** VCS OPTIMIZER **" & vbNewLine & ">> Nothing new to export" & vbNewLine & _
                            "Only the following will be exported:" & vbNewLine & _
                            " - included table data" & vbNewLine & _
                            " - relations" & vbNewLine & vbNewLine & _
                            "TIP: use 'makesources -f' to force a complete export (could be long)."
            Else
                msg = "** VCS OPTIMIZER **" & vbNewLine & _
                      ">> Following objects will be exported:" & vbNewLine & _
                      msg & vbNewLine & _
                      "> DATA: " & vbNewLine & get_include_tables() & vbNewLine & vbNewLine & _
                      "> RELATIONS"
            End If
            
            Call activate_optimizer
        
        Else
            ' no sources date recorded, it may be the first export
            msg = "FIRST EXPORT: " & vbNewLine & vbNewLine & _
                  "Everything will be exported, it could be quite long..."
        
        End If
        
        If MsgBox(msg, vbOKCancel + vbExclamation, "Export") = vbCancel Then GoTo cancelOp
        logger "make_sources", "INFO", "Activates Optimizer"
    End If


    ' new sources date, before export so that date will be exported with tbl_vsc
    step = "Updates sources date"
    logger "make_sources", "INFO", step
    Call update_sources_date

    ' zip the app file
    step = "Zip the app file"
    logger "make_sources", "INFO", step
    Call zip_app_file
    
    ' run the export
    step = "Run VCS Export"
    logger "make_sources", "INFO", step
    Call ExportAllSource

    make_sources = opCompleted
    Exit Function
err:
    Call update_vcs_param("sources_date", CStr(old_sources_date))
    logger "make_sources", "CRITICAL", "Unknown error at: " & step & " - " & err.Description
    Exit Function
cancelOp:
    make_sources = opCancelled
    Exit Function
End Function


Public Function update_from_sources(Optional ByVal options As String = "") As Integer
'updates the application from the sources

    Dim backup As Boolean
    Dim step, msg As String
    
    update_from_sources = opInterrupted

    If InStr(options, "-d") Then set_debug_mode

    step = "Creates a backup of the app file"
    logger "update_from_sources", "INFO", step
    backup = make_backup()
    
    If Not backup Then
        logger "update_from_sources", "ERROR", "Error: unable to backup the app file, do it manually, then click OK"
        MsgBox "Error: unable to backup the app file, do it manually, then click OK", vbExclamation, "Backup"
    End If

    step = "Check for unexported work"
    logger "update_from_sources", "INFO", step
    msg = msg_list_to_export()
    If Len(msg) > 0 Then
        msg = "** IMPORT WARNING **" & vbNewLine & _
                    UCase(CurrentProject.name) & " is going to be updated " & _
                    "with the source files. " & vbNewLine & vbNewLine & _
                    "(!) FOLLOWING NON EXPORTED WORK WILL BE LOST (!): " & vbNewLine & _
                    msg & vbNewLine & _
                    "Are you sure you want to continue?"
        If MsgBox(msg, vbOKCancel + vbExclamation, "Warning") = vbCancel Then GoTo cancelOp
        If MsgBox("Really sure?", vbOKCancel + vbQuestion, "Warning") = vbCancel Then GoTo cancelOp
    End If

    step = "Run VCS Import"
    logger "update_from_sources", "INFO", step
    Call ImportAllSource
   
    ' new sources date to keep the optimizer working
    step = "Updates sources date"
    logger "update_from_sources", "INFO", step
    Call update_sources_date
   
    update_from_sources = opCompleted
    Exit Function
err:
    logger "update_from_sources", "CRITICAL", "Unknown error at: " & step & " - " & err.Description
    Exit Function
cancelOp:
    update_from_sources = opCancelled
    Exit Function
End Function

Public Function config_git_repo()
'configure the application GIT repository for VCS use
    
    'verify that it is a git repository
    If Not is_git_repo() Then
        MsgBox "Not a git repository, please use 'git init on this directory first"
        Exit Function
    End If
    
    ' complete the gitignore file
    Call complete_gitignore

End Function

Public Function sync()
'[experimental] complete command to synchronize this app with the distant master branch

    'verify that it is a git repository
    If Not is_git_repo() Then
        MsgBox "Not a git repository, please use 'git init on this directory first"
        Exit Function
    End If

    'Call make_sources

    Call cmd("echo --ADD FILES-- & git add *" & "& timeout 2", vbNormalFocus)
    
    Dim msg As String
    msg = InputBox("Commit message:", "VCS")
    If Not Len(msg) > 0 Then GoTo err_msg
    
    Call cmd("echo --COMMIT-- & git commit -a -m " & Chr(34) & msg & Chr(34) & "& timeout 2", vbNormalFocus)
    
    Call cmd("echo --PULL-- & git pull origin master & pause", vbNormalFocus)
    
    Call update_from_sources
    
    Call cmd("echo --PUSH-- & git push origin master" & "& timeout 2", vbNormalFocus)

Exit Function
err_msg:
    MsgBox "Invalid value", vbExclamation
End Function


Public Function get_include_tables()
    get_include_tables = vcs_param("include_tables")
End Function

Public Function vcs_param(ByVal key As String, Optional ByVal default_value As String = "") As String
    vcs_param = default_value
    On Error GoTo err_vcs_table
    vcs_param = DFirst("val", "ztbl_vcs", "[key]='" & key & "'")
err_vcs_table:
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
    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
    MsgBox "Error during the backup of " & CurrentProject.name & ": " & err.Description & vbNewLine & "Do it manually"
End Function