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
    
    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_modified()
            
            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
            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
        
    End If


    ' new sources date, before export so that date will be exported with tbl_vsc
    step = "Updates sources date"
    Debug.Print step
    Call update_sources_date
    Debug.Print "> done"

    ' zip the app file
    step = "Zip the app file"
    Debug.Print step
    Call zip_app_file
    Debug.Print "> done"
    
    ' run the export
    step = "Run VCS Export"
    Debug.Print step
    Call ExportAllSource
    Debug.Print "> done"

    make_sources = opCompleted
    Exit Function
err:
    Call update_vcs_param("sources_date", CStr(old_sources_date))
    MsgBox "make_sources - Unknown error at: " & step & vbNewLine & err.Description, vbCritical, "Error"
    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

    step = "Creates a backup of the app file"
    Debug.Print step
    backup = make_backup()
    
    If backup Then
        Debug.Print "> done"
    Else
        MsgBox "Error: unable to backup the app file, do it manually, then click OK", vbExclamation, "Backup"
    End If

    step = "Check for unexported work"
    Debug.Print step
    msg = msg_list_modified()
    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
    End If

    step = "Run VCS Import"
    Debug.Print step
    Call ImportAllSource
    Debug.Print "> done"
   
    update_from_sources = opCompleted
    Exit Function
err:
    MsgBox "update_from_sources - Unknown error at: " & vbNewLine & step & vbNewLine & err.Description, vbCritical, "Error"
    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()
    If CurrentProject.name = "VCS.accda" Then
        get_include_tables = "tbl_commands,modele_ztbl_vcs"
    Else
        get_include_tables = vcs_param("include_tables")
    End If
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 err
    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")
    
    
    zip_app_file = True

fin:
    Exit Function
UnknownErr:
    MsgBox "Unknown error: unable to ZIP the app file, do it manually"
    GoTo fin
err:
    MsgBox "Error while zipping file app: " & err.Description
    GoTo fin
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))
    
    make_backup = True
    Exit Function
err:
        MsgBox "Error during backup: " & err.Description
End Function