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