cvs diff frmAddFunction.frx frmAddFunction.frm (in directory F:\CVS\pgadmin\)
Index: frmAddFunction.frm
===================================================================
RCS file: /usr/local/cvsroot/pgadmin/pgadmin/frmAddFunction.frm,v
retrieving revision 1.1.1.1
diff -r1.1.1.1 frmAddFunction.frm
2c2
< Object = "{D4E5B983-69B8-11D3-9975-009027427025}#1.4#0"; "VSAdoSelector.ocx"
---
> Object = "{D4E5B983-69B8-11D3-9975-009027427025}#1.4#0"; "vsadoselector.ocx"
4,5c4,5
< Caption = "Create Function"
< ClientHeight = 3705
---
> Caption = "Function"
> ClientHeight = 5595
8c8
< ClientWidth = 4155
---
> ClientWidth = 8880
12,82c12,202
< ScaleHeight = 3705
< ScaleWidth = 4155
< Begin vsAdoSelector.VS_AdoSelector vssLanguage
< Height = 315
< Left = 1080
< TabIndex = 15
< ToolTipText = "Select the the language that the function is written in."
< Top = 2115
< Width = 3030
< _ExtentX = 5345
< _ExtentY = 556
< BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
< Name = "MS Sans Serif"
< Size = 8.25
< Charset = 0
< Weight = 400
< Underline = 0 'False
< Italic = 0 'False
< Strikethrough = 0 'False
< EndProperty
< SQL = "SELECT ""lanname"", ""lanname"" FROM ""pg_language"" WHERE ""lanname"" <> 'Internal'"
< End
< Begin VB.ComboBox cboArguments
< Height = 315
< Left = 1080
< Sorted = -1 'True
< Style = 2 'Dropdown List
< TabIndex = 14
< Top = 675
< Width = 2085
< End
< Begin VB.ComboBox cboReturnType
< Height = 315
< Left = 1080
< Sorted = -1 'True
< Style = 2 'Dropdown List
< TabIndex = 13
< Top = 360
< Width = 2085
< End
< Begin VB.CommandButton cmdDown
< Caption = "&Down"
< Height = 285
< Left = 3195
< TabIndex = 12
< Top = 1410
< Width = 915
< End
< Begin VB.CommandButton cmdRemove
< Caption = "&Remove"
< Height = 285
< Left = 3195
< TabIndex = 11
< Top = 1755
< Width = 915
< End
< Begin VB.CommandButton cmdUp
< Caption = "&Up"
< Height = 285
< Left = 3195
< TabIndex = 10
< Top = 1080
< Width = 915
< End
< Begin VB.CommandButton cmdAdd
< Caption = "&Add"
< Height = 285
< Left = 3195
< TabIndex = 9
< Top = 720
< Width = 915
---
> ScaleHeight = 5595
> ScaleMode = 0 'User
> ScaleWidth = 8931.034
> Begin VB.Frame fraDetails
> Caption = "Function Details"
> Height = 5595
> Left = 4500
> TabIndex = 2
> Top = 0
> Width = 4335
> Begin VB.ListBox lstArguments
> Height = 1230
> Left = 900
> TabIndex = 21
> Top = 2205
> Width = 2355
> End
> Begin VB.CommandButton cmdAdd
> Caption = "&Add"
> Height = 330
> Left = 3330
> TabIndex = 20
> Top = 1845
> Width = 915
> End
> Begin VB.CommandButton cmdUp
> Caption = "&Up"
> Height = 330
> Left = 3330
> TabIndex = 19
> Top = 2205
> Width = 915
> End
> Begin VB.CommandButton cmdRemove
> Caption = "&Remove"
> Height = 330
> Left = 3330
> TabIndex = 18
> Top = 3105
> Width = 915
> End
> Begin VB.CommandButton cmdDown
> Caption = "&Down"
> Height = 330
> Left = 3330
> TabIndex = 17
> Top = 2565
> Width = 915
> End
> Begin VB.ComboBox cboArguments
> Height = 315
> Left = 900
> Sorted = -1 'True
> Style = 2 'Dropdown List
> TabIndex = 16
> Top = 1845
> Width = 2310
> End
> Begin VB.ComboBox cboReturnType
> Height = 315
> Left = 900
> Sorted = -1 'True
> Style = 2 'Dropdown List
> TabIndex = 14
> Top = 1485
> Width = 3345
> End
> Begin VB.TextBox txtName
> Height = 285
> Left = 900
> MaxLength = 31
> TabIndex = 12
> Top = 1170
> Width = 3345
> End
> Begin VB.TextBox txtComments
> BackColor = &H8000000F&
> Height = 2010
> Left = 900
> Locked = -1 'True
> MultiLine = -1 'True
> ScrollBars = 2 'Vertical
> TabIndex = 5
> Top = 3525
> Width = 3345
> End
> Begin VB.TextBox txtOwner
> BackColor = &H8000000F&
> Height = 285
> Left = 900
> Locked = -1 'True
> TabIndex = 4
> Top = 540
> Width = 3345
> End
> Begin VB.TextBox txtOID
> BackColor = &H8000000F&
> Height = 285
> Left = 900
> Locked = -1 'True
> TabIndex = 3
> Top = 225
> Width = 3345
> End
> Begin vsAdoSelector.VS_AdoSelector vssLanguage
> Height = 315
> Left = 900
> TabIndex = 10
> ToolTipText = "Select the the language that the function is written in."
> Top = 855
> Width = 3345
> _ExtentX = 5900
> _ExtentY = 556
> BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
> Name = "MS Sans Serif"
> Size = 8.25
> Charset = 0
> Weight = 400
> Underline = 0 'False
> Italic = 0 'False
> Strikethrough = 0 'False
> EndProperty
> SQL = "SELECT ""lanname"", ""lanname"" FROM ""pg_language"" WHERE ""lanname"" <> 'Internal'"
> End
> Begin VB.Label lblReturnType
> AutoSize = -1 'True
> Caption = "Returns"
> Height = 195
> Left = 90
> TabIndex = 15
> Top = 1530
> Width = 510
> End
> Begin VB.Label lblName
> AutoSize = -1 'True
> Caption = "Name:"
> Height = 195
> Left = 90
> TabIndex = 13
> Top = 1215
> Width = 600
> End
> Begin VB.Label lblLanguage
> AutoSize = -1 'True
> Caption = "Language"
> Height = 195
> Left = 90
> TabIndex = 11
> Top = 900
> Width = 810
> End
> Begin VB.Label Label1
> AutoSize = -1 'True
> Caption = "Comments"
> Height = 195
> Index = 8
> Left = 90
> TabIndex = 9
> Top = 3510
> Width = 735
> End
> Begin VB.Label Label1
> AutoSize = -1 'True
> Caption = "Arguments"
> Height = 195
> Index = 2
> Left = 90
> TabIndex = 8
> Top = 1845
> Width = 780
> End
> Begin VB.Label Label1
> AutoSize = -1 'True
> Caption = "Owner"
> Height = 195
> Index = 1
> Left = 90
> TabIndex = 7
> Top = 585
> Width = 465
> End
> Begin VB.Label Label1
> AutoSize = -1 'True
> Caption = "OID"
> Height = 195
> Index = 0
> Left = 90
> TabIndex = 6
> Top = 270
> Width = 285
> End
85,102c205,207
< Caption = "&Create Function"
< Height = 375
< Left = 2655
< TabIndex = 8
< ToolTipText = "Create the new function."
< Top = 3285
< Width = 1455
< End
< Begin VB.ListBox lstArguments
< Height = 1035
< Left = 1080
< TabIndex = 4
< Top = 1035
< Width = 2085
< End
< Begin VB.TextBox txtName
< Height = 285
< Left = 1080
---
> Caption = "&Save"
> Height = 330
> Left = 45
103a209
> ToolTipText = "Create the new function."
105c211
< Width = 3030
---
> Width = 1402
108,109c214,215
< Height = 735
< Left = 1080
---
> Height = 5520
> Left = 1477
112,157d217
< TabIndex = 7
< Top = 2475
< Width = 3030
< End
< Begin VB.Label lblPath
< AutoSize = -1 'True
< Caption = "Function or Library Path"
< Height = 390
< Left = 90
< TabIndex = 6
< Top = 2565
< Width = 930
< WordWrap = -1 'True
< End
< Begin VB.Label lblLanguage
< AutoSize = -1 'True
< Caption = "Language"
< Height = 195
< Left = 90
< TabIndex = 5
< Top = 2160
< Width = 720
< End
< Begin VB.Label lblArguments
< AutoSize = -1 'True
< Caption = "Arguments"
< Height = 195
< Left = 90
< TabIndex = 3
< Top = 765
< Width = 750
< End
< Begin VB.Label lblReturnType
< AutoSize = -1 'True
< Caption = "Return Type"
< Height = 195
< Left = 90
< TabIndex = 2
< Top = 405
< Width = 885
< End
< Begin VB.Label lblName
< AutoSize = -1 'True
< Caption = "Name:"
< Height = 195
< Left = 90
159,160c219,220
< Top = 90
< Width = 465
---
> Top = 45
> Width = 2968
185a246,247
> Dim rsFunc As New Recordset
> Dim OpenFunction_OID As Long
217a280,284
> Private Sub Form_Unload(Cancel As Integer)
> On Error Resume Next
> Set rsFunc = Nothing
> End Sub
>
220a288
> Dim ArgList As String
245,247c313,319
< CreateStr = "CREATE FUNCTION " & QUOTE & txtName.Text & QUOTE & " ("
< For X = 0 To lstArguments.ListCount - 2
< CreateStr = CreateStr & lstArguments.List(X) & ", "
---
>
>
>
> ' Build function arguments
> ArgList = ""
> For X = 0 To lstArguments.ListCount - 1
> ArgList = ArgList & lstArguments.List(X) & ", "
249,255c321,329
< CreateStr = CreateStr & lstArguments.List(X) & ") "
< CreateStr = CreateStr & "RETURNS " & cboReturnType.Text & " "
< CreateStr = CreateStr & "AS '" & txtPath.Text & "' "
< CreateStr = CreateStr & "LANGUAGE '" & vssLanguage.Text & "'"
< LogMsg "Executing: " & CreateStr
< gConnection.Execute CreateStr
< LogQuery CreateStr
---
> If ArgList <> "" Then ArgList = Left(ArgList, Len(ArgList) - 2)
>
> ' Drop function if exists
> cmp_Function_DropIfExists txtName.Text, ArgList
>
> ' Create function
> cmp_Function_Create txtName.Text, ArgList, cboReturnType.Text, txtPath.Text, vssLanguage.Text
>
> ' Refresh function list
317,318c391,392
< If Me.Width < 4275 Then Me.Width = 4275
< If Me.Height < 4110 Then Me.Height = 4110
---
> If Me.Width < 9000 Then Me.Width = 9000
> If Me.Height < 6000 Then Me.Height = 6000
319a394,398
> txtPath.Height = Me.ScaleHeight
> txtPath.Width = Me.ScaleWidth - txtPath.Left - fraDetails.Width - 25
> fraDetails.Left = txtPath.Left + txtPath.Width + 25
> fraDetails.Height = Me.ScaleHeight
> txtPath.Height = fraDetails.Height - txtPath.Top - 100
329a409,410
>
> ' Retrieve data types
344a426,427
>
> ' Retrieve languages
350a434,435
>
> ' Write query
352a438,442
>
> ' Retrieve function if exists
> OpenFunction_OID = gOpenFunction_OID
> If gOpenFunction_OID <> 0 Then Function_Load
>
379a470,504
>
> Private Sub Function_Load()
> On Error GoTo Err_Handler
> Dim temp_arg_list As Variant, temp_arg_item As Variant
>
> StartMsg "Entering Function information..."
>
> If rsFunc.State <> adStateClosed Then rsFunc.Close
> LogMsg "Executing: SELECT * FROM pgadmin_functions WHERE Function_OID = " & OpenFunction_OID
> rsFunc.Open "SELECT * FROM pgadmin_functions WHERE function_OID = " & OpenFunction_OID, gConnection, adOpenDynamic
>
> ' Initialize form with values from pgadmin_function
> txtName = rsFunc!function_name & ""
> txtPath = Replace(rsFunc!function_source & "", "'", "''")
> vssLanguage.Text = rsFunc!function_language & ""
>
> If (rsFunc!function_returns & "" <> "") Then
> cboReturnType.Text = rsFunc!function_returns & ""
> Else
> cboReturnType.Text = "opaque" ' Strange. Opaque does not appear in pgadmin_function. Why ?
> End If
>
> temp_arg_list = Split(rsFunc!function_arguments, ",")
> For Each temp_arg_item In temp_arg_list
> cboArguments.Text = Trim(temp_arg_item)
> cmdAdd_Click
> Next
>
> EndMsg
> Exit Sub
> Err_Handler:
> EndMsg
> If Err.Number <> 0 Then LogError Err, "frmFunctions, cmdRefresh_Click"
> End Sub
>
*****CVS exited normally with code 1*****
cvs diff frmFunctions.frx frmFunctions.frm (in directory F:\CVS\pgadmin\)
Index: frmFunctions.frm
===================================================================
RCS file: /usr/local/cvsroot/pgadmin/pgadmin/frmFunctions.frm,v
retrieving revision 1.1.1.1
diff -r1.1.1.1 frmFunctions.frm
4c4
< ClientHeight = 4050
---
> ClientHeight = 5595
7c7
< ClientWidth = 8205
---
> ClientWidth = 8880
11,12c11,30
< ScaleHeight = 4050
< ScaleWidth = 8205
---
> ScaleHeight = 5595
> ScaleWidth = 8880
> Begin VB.CommandButton Command1
> Caption = "&Compile project"
> Height = 330
> Left = 45
> TabIndex = 23
> ToolTipText = "Edit the comment for the selected function."
> Top = 1485
> Width = 1410
> End
> Begin VB.CommandButton cmdModifyFunc
> Caption = "&Modify Function"
> Height = 330
> Left = 45
> TabIndex = 22
> ToolTipText = "Create a new function."
> Top = 405
> Width = 1410
> End
18c36
< Top = 1485
---
> Top = 2445
35a54,78
> Top = 1125
> Width = 1410
> End
> Begin VB.ListBox lstFunc
> Height = 5520
> Left = 1485
> TabIndex = 5
> Top = 45
> Width = 2985
> End
> Begin VB.CommandButton cmdRefresh
> Caption = "&Refresh"
> Height = 330
> Left = 45
> TabIndex = 3
> ToolTipText = "Refresh the list of function."
> Top = 1845
> Width = 1410
> End
> Begin VB.CommandButton cmdDropFunc
> Caption = "&Drop Function"
> Height = 330
> Left = 45
> TabIndex = 1
> ToolTipText = "Delete the selected function."
41c84
< Height = 4020
---
> Height = 5595
45c88,97
< Width = 3660
---
> Width = 4335
> Begin VB.TextBox txtName
> BackColor = &H8000000F&
> Height = 285
> Left = 900
> Locked = -1 'True
> TabIndex = 25
> Top = 1170
> Width = 3345
> End
52,53c104,105
< Top = 2655
< Width = 2670
---
> Top = 855
> Width = 3345
57,58c109,110
< Height = 870
< Left = 900
---
> Height = 1020
> Left = 45
63,64c115,116
< Top = 1755
< Width = 2670
---
> Top = 4530
> Width = 4215
72,73c124,125
< Top = 1440
< Width = 2670
---
> Top = 1500
> Width = 3345
82c134
< Width = 2670
---
> Width = 3345
91c143
< Width = 2670
---
> Width = 3345
95c147
< Height = 555
---
> Height = 1635
101,102c153,154
< Top = 855
< Width = 2670
---
> Top = 1845
> Width = 3345
106,107c158,159
< Height = 735
< Left = 90
---
> Height = 795
> Left = 900
112,113c164,175
< Top = 3195
< Width = 3480
---
> Top = 3525
> Width = 3345
> End
> Begin VB.Label Label1
> AutoSize = -1 'True
> Caption = "Name"
> Height = 195
> Index = 7
> Left = 90
> TabIndex = 24
> Top = 1215
> Width = 780
142,143c204,205
< Top = 900
< Width = 750
---
> Top = 1845
> Width = 780
153c215
< Width = 555
---
> Width = 645
162,163c224,225
< Top = 1800
< Width = 615
---
> Top = 4275
> Width = 870
168c230
< Height = 195
---
> Height = 285
172,173c234,235
< Top = 2700
< Width = 720
---
> Top = 900
> Width = 735
182c244
< Top = 2970
---
> Top = 3510
186,210d247
< Begin VB.ListBox lstFunc
< Height = 3960
< Left = 1485
< TabIndex = 5
< Top = 45
< Width = 2985
< End
< Begin VB.CommandButton cmdRefresh
< Caption = "&Refresh"
< Height = 330
< Left = 45
< TabIndex = 3
< ToolTipText = "Refresh the list of function."
< Top = 1125
< Width = 1410
< End
< Begin VB.CommandButton cmdDropFunc
< Caption = "&Drop Function"
< Height = 330
< Left = 45
< TabIndex = 1
< ToolTipText = "Delete the selected function."
< Top = 405
< Width = 1410
< End
245a283,304
>
> Private Sub cmdModifyFunc_Click()
> ' On Error GoTo Err_Handler
>
> If txtOID <> "" Then
> ' This means we will open the function
> gOpenFunction_OID = Val(txtOID)
>
> ' Load form
> Load frmAddFunction
> frmAddFunction.Show
> End If
>
> Exit Sub
> Err_Handler: If Err.Number <> 0 Then LogError Err, "frmFunctions, cmdModifyFunc_Click"
> End Sub
>
> Private Sub Command1_Click()
> comp_Project_Initialize
> comp_Project_Compile
> End Sub
>
247c306
< On Error GoTo Err_Handler
---
> ' On Error GoTo Err_Handler
258c317
< On Error GoTo Err_Handler
---
> ' On Error GoTo Err_Handler
265c324
< On Error GoTo Err_Handler
---
> ' On Error GoTo Err_Handler
279c338,342
< On Error GoTo Err_Handler
---
> ' On Error GoTo Err_Handler
> ' This means we will create the function
> gOpenFunction_OID = 0
>
> ' Load form
287c350
< On Error GoTo Err_Handler
---
> ' On Error GoTo Err_Handler
311c374
< On Error GoTo Err_Handler
---
> ' On Error GoTo Err_Handler
341c404
< On Error GoTo Err_Handler
---
> ' On Error GoTo Err_Handler
351c414
< On Error GoTo Err_Handler
---
> ' On Error GoTo Err_Handler
354,355c417,418
< If Me.Width < 8325 Then Me.Width = 8325
< If Me.Height < 4455 Then Me.Height = 4455
---
> If Me.Width < 9000 Then Me.Width = 9000
> If Me.Height < 6000 Then Me.Height = 6000
361c424
< txtComments.Height = fraDetails.Height - txtComments.Top - 100
---
> txtFunction.Height = fraDetails.Height - txtFunction.Top - 100
368c431
< On Error GoTo Err_Handler
---
> ' On Error GoTo Err_Handler
373c436
< txtOID.Text = rsFunc!function_oid & ""
---
> txtOID.Text = rsFunc!function_OID & ""
375a439
> If txtReturns.Text = "" Then txtReturns.Text = "opaque" ' Strange
387a452
>
*****CVS exited normally with code 1*****
cvs diff basMisc.bas basGlobal.bas (in directory F:\CVS\pgadmin\)
Index: basGlobal.bas
===================================================================
RCS file: /usr/local/cvsroot/pgadmin/pgadmin/basGlobal.bas,v
retrieving revision 1.2
diff -r1.2 basGlobal.bas
67a68
> Public gOpenFunction_OID As Long 'OID of function to open
*****CVS exited normally with code 1*****
Option Explicit
Dim ContinueCompilation As Boolean
Sub cmp_Trigger_Create(ByVal trigger_name As String, ByVal trigger_table As String, ByVal trigger_function As String, ByVal trigger_type As String)
'On Error GoTo Err_Handler
Dim queryStr As String
Dim iType As Integer
Dim trigger_ForEach As String
Dim trigger_Executes As String
Dim trigger_Event As String
' retrieve values from trigger
iType = CInt(trigger_type)
If (iType And 1) = 1 Then
trigger_ForEach = " Row"
Else
trigger_ForEach = " Statement"
End If
If (iType And 2) = 2 Then
trigger_Executes = " Before"
Else
trigger_Executes = " After"
End If
If (iType And 4) = 4 Then trigger_Event = trigger_Event & "Insert OR "
If (iType And 8) = 8 Then trigger_Event = trigger_Event & "Delete OR "
If (iType And 16) = 16 Then trigger_Event = trigger_Event & "Update OR "
queryStr = "CREATE TRIGGER " & trigger_name
queryStr = queryStr & " " & trigger_Executes & " " & Left(trigger_Event, Len(trigger_Event) - 3)
queryStr = queryStr & trigger_table & " FOR EACH" & trigger_ForEach
queryStr = queryStr & " EXECUTE PROCEDURE " & trigger_function & "()"
' Log information
LogMsg "Creating trigger " & trigger_name & "..."
LogMsg "Executing: " & queryStr
' Execute drop query and close log
gConnection.Execute queryStr
Exit Sub
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, cmp_Trigger_SQL"
End Sub
Sub cmp_Trigger_DropIfExist(ByVal trigger_name As String, ByVal trigger_table As String)
'On Error GoTo Err_Handler
Dim queryStr As String
Dim DropStr As String
Dim rsComp As New Recordset
queryStr = "SELECT * FROM pgadmin_dev_triggers "
queryStr = queryStr & "WHERE trigger_name = '" & trigger_name & "' "
queryStr = queryStr & "AND trigger_table = '" & trigger_table & "'"
' retrieve name and arguments of function to drop
LogMsg "Testing existence of trigger " & trigger_name & " on table " & trigger_table & "..."
LogMsg "Executing: " & queryStr
If rsComp.State <> adStateClosed Then rsComp.Close
rsComp.Open queryStr, gConnection
If Not rsComp.EOF Then
' create drop query
DropStr = "DROP TRIGGER " & QUOTE & trigger_name & QUOTE & " ON " & QUOTE & trigger_table & QUOTE
' Log information
LogMsg "Droping trigger " & trigger_name & " on table " & trigger_table & "..."
LogMsg "Executing: " & DropStr
' Execute drop query and close log
gConnection.Execute DropStr
End If
Exit Sub
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, cmp_Trigger_SQL"
End Sub
Public Sub cmp_Function_DropIfExists(ByVal function_name As String, ByVal function_arguments As String)
'On Error GoTo Err_Handler
Dim queryStr As String
Dim DropStr As String
Dim rsComp As New Recordset
queryStr = "SELECT * FROM pgadmin_functions "
queryStr = queryStr & "WHERE function_name = '" & function_name & "' "
queryStr = queryStr & "AND function_arguments = '" & function_arguments & "'"
' retrieve name and arguments of function to drop
LogMsg "Testing existence of function " & function_name & " (" & function_arguments & ")..."
LogMsg "Executing: " & queryStr
If rsComp.State <> adStateClosed Then rsComp.Close
rsComp.Open queryStr, gConnection
'Drop function if exists
If Not rsComp.EOF Then
' create drop query
DropStr = "DROP FUNCTION " & QUOTE & rsComp!function_name & QUOTE & " (" & rsComp!function_arguments & ");"
' Log information
LogMsg "Droping function " & function_name & " (" & function_arguments & ")..."
LogMsg "Executing: " & DropStr
' Execute drop query and close log
gConnection.Execute DropStr
End If
Exit Sub
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, cmp_Function_DropIfExists"
End Sub
Public Sub cmp_Function_Create(ByVal function_name As String, ByVal function_argumentlist As String, ByVal function_returns As String, ByVal function_source As String, ByVal function_language As String)
'On Error GoTo Err_Handler
Dim CreateStr As String
CreateStr = "CREATE FUNCTION " & QUOTE & function_name & "" & QUOTE & " ("
CreateStr = CreateStr & function_argumentlist & "" & ") "
CreateStr = CreateStr & "RETURNS " & function_returns & " "
CreateStr = CreateStr & "AS '" & function_source & "' "
CreateStr = CreateStr & "LANGUAGE '" & function_language & "'"
'Log
LogMsg "Creating function " & function_name & " ..."
LogMsg "Executing: " & CreateStr
'Execute
gConnection.Execute CreateStr
Exit Sub
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, cmp_Function_Create"
End Sub
Public Sub cmp_Function_Compile(ByVal function_OID As Long)
On Error GoTo Err_Handler
Dim queryStr As String
Dim rsComp As New Recordset
Dim function_name As String
Dim function_arguments As String
Dim function_returns As String
Dim function_language As String
Dim function_source As String
' Retrive latest version of function
queryStr = "SELECT * FROM pgadmin_functions WHERE function_OID = " & Str(function_OID)
If rsComp.State <> adStateClosed Then rsComp.Close
rsComp.Open queryStr, gConnection
' Compile function if exists
If Not rsComp.EOF Then
function_name = rsComp!function_name & ""
function_arguments = rsComp!function_arguments & ""
function_returns = rsComp!function_returns & ""
If function_returns = "" Then function_returns = "opaque" 'strange
function_language = rsComp!function_language & ""
function_source = Replace(rsComp!function_source, "'", "''") & ""
' Attempt to create a temporary function to see if it compiles
LogMsg "Checking if " & function_name & " (" & function_arguments & ") can be compiled ..."
cmp_Function_DropIfExists "pgadmin_dev_temp_function", function_arguments
cmp_Function_Create "pgadmin_dev_temp_function", function_arguments, function_returns, function_source, function_language
' If it does, compile the real function
cmp_Function_DropIfExists function_name, function_arguments
cmp_Function_Create function_name, function_arguments, function_returns, function_source, function_language
' Tell PgAdmin that the function was compiled
cmp_Function_SetIsCompiled function_name, function_arguments
LogMsg function_name & " (" & function_arguments & ") was successfuly compiled."
End If
Exit Sub
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, cmp_Function_Compile"
MsgBox "Function " & function_name & " (" & function_arguments & ") could not compile. Check source code of the function and compile again."
cmp_Function_DropIfExists "pgadmin_dev_temp_function", function_arguments
ContinueCompilation = False
End Sub
Public Sub cmp_Function_Dependency_Initialize(ByVal function_OID As Long, ByVal function_name As String)
'On Error GoTo Err_Handler
Dim DependencyStr As String
Dim rsComp As New Recordset
' Drop existing dependencies
cmp_Function_Dependency_Drop function_OID
' Scan pgadmin_dev_functions for dependencies
DependencyStr = "SELECT * FROM pgadmin_dev_functions WHERE function_source ILIKE '%" & function_name & "%'"
DependencyStr = DependencyStr & " AND function_oid <> " & function_OID
If rsComp.State <> adStateClosed Then rsComp.Close
rsComp.Open DependencyStr, gConnection, adOpenDynamic
' Write dependencies in pgadmin_dev_dependencies
If Not rsComp.EOF Then
DependencyStr = "INSERT INTO pgadmin_dev_dependencies (dependency_from, dependency_to) "
DependencyStr = DependencyStr & " SELECT pgadmin_dev_functions.function_oid, text(" & function_OID & ") "
DependencyStr = DependencyStr & " FROM pgadmin_dev_functions WHERE "
DependencyStr = DependencyStr & " function_source ilike '%" & function_name & "%' "
DependencyStr = DependencyStr & " AND function_oid <> " & function_OID
gConnection.Execute DependencyStr
End If
Exit Sub
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, cmp_Function_Dependency_Initialize"
End Sub
Public Sub cmp_Function_Dependency_Drop(ByVal function_OID As Long)
'On Error GoTo Err_Handler
On Error Resume Next
Dim DependencyStr As String
DependencyStr = "DELETE * FROM pgadmin_dev_dependencies WHERE dependency_from = " & Str(function_OID)
gConnection.Execute DependencyStr
Exit Sub
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, cmp_Function_Dependency_Drop"
End Sub
Public Sub cmp_Function_SetIsCompiled(ByVal function_name As String, ByVal function_arguments As String)
'On Error GoTo Err_Handler
Dim queryStr As String
queryStr = "UPDATE pgadmin_dev_functions SET function_iscompiled = 't'"
queryStr = queryStr & " WHERE function_name = '" & function_name & "'"
queryStr = queryStr & "AND function_arguments = '" & function_arguments & "'"
LogMsg "Setting function " & function_name & " (" & function_arguments & "" & ") to Compiled..."
LogMsg "Executing: " & queryStr
gConnection.Execute queryStr
Exit Sub
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, cmp_Function_SetIsCompiled"
End Sub
Public Function cmp_Function_HasSatisfiedDependencies(ByVal function_OID As Long) As Boolean
'On Error GoTo Err_Handler
Dim queryStr As String
Dim rsComp As New Recordset
' Test existence of unsatisfied dependencies
queryStr = "SELECT pgadmin_dev_functions.function_oid, pgadmin_dev_functions.function_name, pgadmin_dev_functions_1.function_iscompiled"
queryStr = queryStr & " From pgadmin_dev_functions"
queryStr = queryStr & " INNER JOIN pgadmin_dev_dependencies"
queryStr = queryStr & " ON pgadmin_dev_functions.function_oid = pgadmin_dev_dependencies.dependency_from"
queryStr = queryStr & " INNER JOIN pgadmin_dev_functions AS pgadmin_dev_functions_1"
queryStr = queryStr & " ON pgadmin_dev_dependencies.dependency_to = pgadmin_dev_functions_1.function_oid"
queryStr = queryStr & " WHERE ((pgadmin_dev_functions.function_oid = " & Str(function_OID) & ") AND (pgadmin_dev_functions_1.function_iscompiled = 'f'));"
If rsComp.State <> adStateClosed Then rsComp.Close
rsComp.Open queryStr, gConnection
cmp_Function_HasSatisfiedDependencies = False
If rsComp.EOF Then
cmp_Function_HasSatisfiedDependencies = True
End If
Exit Function
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, cmp_Function_HasSatisfiedDependencies"
End Function
Public Sub cmp_Table_DropIfExists(ByVal Table_name As String)
'On Error GoTo Err_Handler
Dim DropStr As String
Dim rsComp As New Recordset
' Log
LogMsg "Drop table " & Table_name & " if exists ..."
LogMsg "Executing: SELECT * FROM pgadmin_tables WHERE Table_Name = " & Table_name
' Test existence of the table
If rsComp.State <> adStateClosed Then rsComp.Close
rsComp.Open "SELECT * FROM pgadmin_tables WHERE Table_Name = '" & Table_name & "'", gConnection, adOpenDynamic
' Drop if exists
If Not rsComp.EOF Then
StartMsg "Dropping Table..."
DropStr = "DROP TABLE " & QUOTE & Table_name & QUOTE
LogMsg "Executing: " & DropStr
gConnection.Execute DropStr
End If
EndMsg
Exit Sub
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, cmp_Table_DropIfExists"
End Sub
Public Sub comp_Project_Drop()
'On Error GoTo Err_Handler
'Drop compilation tables if exist
cmp_Table_DropIfExists ("pgadmin_dev_functions")
cmp_Table_DropIfExists ("pgadmin_dev_dependencies")
cmp_Table_DropIfExists ("pgadmin_dev_triggers")
Exit Sub
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, comp_Project_Drop"
End Sub
Public Sub comp_Project_Initialize()
'On Error GoTo Err_Handler
Dim InitializeStr As String
Dim rsComp As New Recordset
StartMsg "Entering compiler ..."
' Drop previous project
comp_Project_Drop
' Create pgadmin_dev_functions table
' ********************************************************
' This table is used during compilation process
' to determine which function is compiled and which is not
' ********************************************************
InitializeStr = "CREATE TABLE pgadmin_dev_functions AS"
InitializeStr = InitializeStr & " SELECT * FROM pgadmin_functions WHERE"
InitializeStr = InitializeStr & " function_language <> 'internal'"
InitializeStr = InitializeStr & " AND function_owner <> 'postgres'"
InitializeStr = InitializeStr & " AND substring (function_name, 1,7) <> 'pgadmin'"
InitializeStr = InitializeStr & " AND function_name <> 'plpgsql_call_handler';"
InitializeStr = InitializeStr & " ALTER TABLE pgadmin_dev_functions ADD function_iscompiled boolean DEFAULT 'f' ;"
InitializeStr = InitializeStr & " UPDATE pgadmin_dev_functions SET function_iscompiled = 'f';"
InitializeStr = InitializeStr & " UPDATE pgadmin_dev_functions SET function_returns = 'opaque' WHERE function_returns = NULL;"
LogMsg "Creating table pgadmin_dev_functions"
LogMsg "Executing: " & InitializeStr
gConnection.Execute InitializeStr
' Create pgadmin_dev_functions table
' ********************************************************
' This table is used during compilation process
' to determine which function is compiled and which is not
' ********************************************************
InitializeStr = "CREATE TABLE pgadmin_dev_triggers AS "
InitializeStr = InitializeStr & " SELECT * FROM pgadmin_triggers WHERE trigger_oid > " & LAST_SYSTEM_OID & " AND trigger_name NOT LIKE 'pgadmin_%' AND trigger_name NOT LIKE 'pg_%' AND trigger_name NOT LIKE 'RI_ConstraintTrigger_%' ORDER BY trigger_name;"
InitializeStr = InitializeStr & " ALTER TABLE pgadmin_dev_triggers ADD trigger_iscompiled boolean DEFAULT 'f' ;"
InitializeStr = InitializeStr & " UPDATE pgadmin_dev_triggers SET trigger_iscompiled = 'f';"
LogMsg "Creating table pgadmin_dev_triggers"
LogMsg "Executing: " & InitializeStr
gConnection.Execute InitializeStr
' Create pgadmin_dev_dependencies table
' ********************************************************
' This table is used during compilation process
' to determine the dependencies of each function
' ********************************************************
InitializeStr = "CREATE TABLE pgadmin_dev_dependencies ("
InitializeStr = InitializeStr & " dependency_from int4,"
InitializeStr = InitializeStr & " dependency_to int4);"
LogMsg "Creating table pgadmin_dev_dependencies:"
LogMsg "Executing: " & InitializeStr
gConnection.Execute InitializeStr
' Fill pgadmin_dev_dependencies table
InitializeStr = "SELECT * FROM pgadmin_dev_functions ORDER BY function_OID"
If rsComp.State <> adStateClosed Then rsComp.Close
rsComp.Open InitializeStr, gConnection, adOpenDynamic
While Not rsComp.EOF
cmp_Function_Dependency_Initialize rsComp!function_OID, rsComp!function_name
rsComp.MoveNext
Wend
Exit Sub
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, comp_Project_Initialize"
End Sub
Public Function comp_Project_FindNextFunctionToCompile() As Long
'On Error GoTo Err_Handler
Dim queryStr As String
Dim rsComp As New Recordset
queryStr = "SELECT * From pgadmin_dev_functions WHERE function_iscompiled = 'f' ORDER BY function_oid"
LogMsg "Looking for next function to compile..."
LogMsg "Executing: " & queryStr
If rsComp.State <> adStateClosed Then rsComp.Close
rsComp.Open queryStr, gConnection, adOpenDynamic
comp_Project_FindNextFunctionToCompile = 0
While Not rsComp.EOF
If cmp_Function_HasSatisfiedDependencies(rsComp!function_OID) = True Then
comp_Project_FindNextFunctionToCompile = rsComp!function_OID
LogMsg "OID function to compile is : " & Str(comp_Project_FindNextFunctionToCompile) & "..."
Exit Function
End If
rsComp.MoveNext
Wend
Exit Function
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, comp_Project_FindNextFunctionToCompile"
End Function
Public Sub comp_Project_CreateTriggers()
On Error GoTo Err_Handler
Dim rsTrigger As New Recordset
Dim queryStr As String
' Obviously this does not work
queryStr = "SELECT * From pgadmin_dev_triggers"
LogMsg "Creating triggers..."
If rsTrigger.State <> adStateClosed Then rsTrigger.Close
rsTrigger.Open queryStr, gConnection, adOpenDynamic
While Not rsTrigger.EOF
' First create a temporary trigger
cmp_Trigger_DropIfExist "pgadmin_dev_temptrigger", rsTrigger!trigger_table
cmp_Trigger_Create rsTrigger!trigger_name, rsTrigger!trigger_table, rsTrigger!trigger_function, rsTrigger!trigger_type
cmp_Trigger_DropIfExist "pgadmin_dev_temptrigger", rsTrigger!trigger_table
' If it works, create the trigger
cmp_Trigger_DropIfExist rsTrigger!trigger_name, rsTrigger!trigger_table
cmp_Trigger_Create rsTrigger!trigger_name, rsTrigger!trigger_table, rsTrigger!trigger_function, rsTrigger!trigger_type
rsTrigger.MoveNext
Wend
Exit Sub
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, comp_Project_CreateTriggers"
End Sub
Public Sub comp_Project_Compile()
On Error GoTo Err_Handler
Dim NextFunctionToCompile_OID As Long
ContinueCompilation = True
NextFunctionToCompile_OID = comp_Project_FindNextFunctionToCompile
While (NextFunctionToCompile_OID > 0) And (ContinueCompilation = True)
cmp_Function_Compile (NextFunctionToCompile_OID)
NextFunctionToCompile_OID = comp_Project_FindNextFunctionToCompile
Wend
comp_Project_CreateTriggers
If ContinueCompilation = True Then MsgBox ("Compilation successfull")
Exit Sub
Err_Handler:
If Err.Number <> 0 Then LogError Err, "basCompiler, comp_Project_Compile"
End Sub