Alpha DevCon 2018
Results 1 to 8 of 8

Thread: User Defined Functions in RunTime

  1. #1
    Member
    Real Name
    Paul Verboom
    Join Date
    Apr 2006
    Location
    Halifax, Nova Scotia, Canada
    Posts
    134

    Default User Defined Functions in RunTime

    I've been working on an application for data manipulation and correction, patient demographics to be exact. It allows patient names dates of births and ID's to be compared to reference data, and the reference data to be used to correct the patient demographics.

    For maximum flexibility numerous dialogs allow the end user to use Xbasic expressions to set the different values. If you are interested in this approach, the xDialog Genie allows you to place the Xbasic expression builder in your Dialogs.

    Some of these expressions end up becoming quite long and unmanageable. So I ended up writing global functions for use in the expression builder. However this is not an option for the user of the application with Alpha5 runtime, or least I though it wasn't. As it turns out, Alpha5 has methods for editing and creating functions, that also work in the runtime.

    Using these methods, I was able to create a script that presents the end user with a Dialog that allows User Defined Functions to be Created Edited Renamed and Deleted. This script ensures that all functions created by the end user are preffixed with UDF_ This prevents the end user from messing with functions that are part of the appplication. This Dialog also works in the runtime version of Alpha5.

    The script also shows how the Alpha5 Data Dictionary can be directly manipulated.

    UDF-edit.png

    Code:
    'Date Created: 28-May-2016 01:09:51 PM
    'Last Updated: 30-May-2016 07:20:20 AM
    'Created By  : verboopa2
    'Updated By  : verboopa2
    '--------
    'UDF-Edit
    '--------
    'Edit User Defined Functions 
    'These are functions with the UDF_ prefix
    'A5 provides the following statements that allows basic script editoring.
    'these function work in the runtime version as well.
    
    'a5_modeless_code_editor("UDF_ExtractSecID","Function")
    'a5_script_create_new("UDF_ExtractSECcb","function","xbasic","hello")
    
    '---------------------
    '// Set Debug Flags --
    '---------------------
    DIM DialogTtl as C = "User Defined Functions  (UDF-Edit)"
    DIM Debug as C = ""                                             'use following statement to check for debug flag: if ("m" $ Debug)
    'DbgSet(type::xbasicmodule.get_current(),Debug)                    'set debug values in deployed enviroments
    'c - make standard DBF copy for database dictionary
    'r - trace contents of data dictionary found
    
    '-----------------------------
    '// Opening Data Dictionary --
    '-----------------------------
    'Data Dictionary can be opened with dictionary.open() function.
    'As documented by default this opens the current data dictionary in read only mode
    'However you can specify a different data dictionary and a read write mode
    'by providing parameters. This allows the data dictionary to be edited directly
    '
    'The data dictionary name must include the appropreate dictionary extension
    '    .DDD for dictionaries used for Tables and Sets
    '    .ALB for data base dictionaries. contain information used by more then one table
    
    'Dictionaries have a single index that can be used to lookup objects
    '    tagName: Type_Name
    '    Order: Type + Name
    '
    'Fields located in the data dictionary are
    '    Name,C,24            Name of the object as displayed in the Control Panel
    '    Type,C,4            Object type one of the following type not all types are found in both dictionary types
    '            append         -ALB
    '            bitmap         -ALB
    '            browse         -DDD
    '            copy        -ALB
    '            export        -ALB
    '            form        -DDD
    '            import        -ALB
    '            join        -ALB
    '            label    
    '            letter    
    '            mark
    '            menu        -ALB
    '            post        -ALB
    '            query    
    '            report    
    '            summarize
    '            toolbar        -ALB
    '            update        -ALB
    '            xtab
    '            script        -ALB
    '            function    -ALB
    
    '    Contents_C,C,64        Contents of the obect if it later short seems to be mainly used for version flags
    '    Contents_M,M,10        Contents of the object if it is strictly text
    '    Vendor,M,10            Contents of object if it is binary and thus proprietary to the vendor of Alpha5
    
    IF ("c" $ Debug)                                                'copy dictionary to standard DBF for debugging
        DIM SrcName as C                                            'get base name of tables without extensions
        DIM DestName as C 
        SrcName = file.filename_parse(a5.Get_Name(),"dpn")            
        DestName = file.filename_parse(a5.Get_Name(),"dpn") + "_DICT"
        file.copy(SrcName + ".ALB",DestName + ".DBF")
        file.copy(SrcName + ".ALM",DestName + ".FPT")
        file.copy(SrcName + ".ALX",DestName + ".CDX")
        file_add_to_db(Destname + ".DBF")
    end if
    
    '----------------------
    '// Setup for Dialog --
    '----------------------
    DIM List as C                                                    'List of all functions
    DIM UDFList as C                                                'Functions with the prefic UDF_
    List = A5.UDF_enum(2)                                            'Get a list of all functions and     
    FOR EACH Line IN List                                            'Build list of User defined Functions 
        IF *FIRST(Line.value,"UDF_")
            UDFList = *concat_lines(UDFList,Line.Value)
        end if
    NEXT
    UDFlist = SORTSUBSTR(UDFlist,crlf())
                                                                     'List of return types and character types
    DIM ParaType as C                                                'this is subset of A5 types        
    ParaType =<<%txt%
    Character
    Numeric
    Logical
    Date
    Time
    %txt%
    
    '-----------------
    '// User Dialog --
    '-----------------
    DIM UDFselected as C
    DIM UDFnew as C
    DIM ReturnType as C
    DIM P1 as C
    DIM PT1 as C
    DIM Result as C
    DIM ptext as p                                                     'The User Defined Function has name restrictions
    DIM ptext.text as c                                             'These variables used for editing this value 
    DIM ptext.object as p                                             'allow direct manipulation of cursor in editer        
    
    Dialog =<<%dlg%
    {can_exit=exit}
    {region}
    {region}
    {blueframe=1,1:Existing UDFs}
    [.25,18UDFselected^#UDFlist]{space=1}
    {endregion}
    |{sp=1}|
    {region}
    {blueframe=2,13:Create new User Defined Function}
    {cellspillover=on}
    A prefix of UDF_ will be added to name.; 
    Underscore is only permitted Non AlphaNumeric.;
    {cellspillover=off}
    Function Name:|[%;%20.24ptext!change];
    Return Type:|[%v%.17ReturnType^=ParaType];
    {lf};
    {cellspillover=on}
    Optional arguments taken by this function;
    {cellspillover=off}
    Name|Type;
    [.20A1]|{Sp}[%v%.15AT1^=ParaType];
    [.20A2]|{Sp}[%v%.15AT2^=ParaType];
    [.20A3]|{Sp}[%v%.15AT3^=ParaType];
    [.20A4]|{Sp}[%v%.15AT4^=ParaType];
    [.20A5]|{Sp}[%v%.15AT5^=ParaType];
    {endregion};
    {endregion};
    {line=1,0};
    {region}
    <*10&Refresh!refresh> <*10&Edit!edit> <10&Delete!delete> <10&Rename!rename> <10&Create!create> <Exit!exit>
    {endregion};
    %dlg%
    
    Code =<<%code%                                                    
    DIM errspot as C = ""                                            'flag for error handler that record alter is under way
    DIM Commit_flag as L                                            'Can record be commited set to False if Error incountered
    DIM Commit_error as C                                            'Text error message detected during record entry
    ON ERROR GOTO ERRORHANDLER
    DIM Mess as C                                                    'Message to give user
    Mess = ""
        
    if a_dlg_button = "exit" then                                     'Event handlers for Dialog
        ui_modeless_dlg_close(DialogTtl)                            'Used to cancel out of dialog
        end 
    end if 
    
    if a_dlg_button = "edit" then                                     'Used to proceed after dialog            
        IF isnull(UDFselected)
            Mess = *concat_lines(Mess,"Select UDF to edit first")
        ELSE
            a5_modeless_code_editor(UDFselected,"Function")
        end if
        a_dlg_button = ""                                            'keep us from continously processing this button press
    end if 
    
    IF a_dlg_button = "refresh"                                     'Refresh List of UDF functions use function built for this
        UDFlist = UDFlistBld()                                        
        a_dlg_button = ""
    end if
    
    if a_dlg_button = "create"            
        DIM RT as C                                                    'Single letter return type for the function
        DIM Arguments as C                                            'Arguments to send to the function
        DIM FuncTemp as C                                            'Help users by building a template for the function
        FuncTemp =<<%txt%
    FUNCTION {UDFnew} AS {RT} ({Arguments})
        'Write your custome code in here using xbasic
        'You can use the variables passed into the function as Arguments in the first line
        'A value is returned by assigning it to variable with the same name as the function 
        {UDFnew} = 'Assign your return value here
    END FUNCTION
    %txt%
        RT = LEFT(ReturnType + "C",1)                                'Set the function return type C is the default and added in case none was selected
        FOR x = 1 to 5                                                'up too 5 arguments can be defined build the function parameters from them
            Para = eval("A"+x)                                        'Is a argument name given in this slot
            IF Para                                                    'if so add it and add variable type using character as default
                                                                    'add a space seperator if we already have a parameter
                Arguments = Arguments + IIF(isnull(Arguments),"",", ") + Para + " AS " + LEFT(eval("AT"+x)+"C",1)
            end if
        NEXT        
        UDFnew = ptext.text                                            'get the file name user wanted to use                            
        Mess = VerifyName(UDFnew)
        IF isnull(Mess)
            a5_script_create_new(UDFnew,"function","xbasic",evaluate_string(FuncTemp))
        end if
        UDFlist = UDFlistBld()                                        
        a_dlg_button = ""                                            'keep us from continously processing this button press
    end if
        
    IF a_dlg_button = "delete" .OR. a_dlg_button = "rename" then
        While .T.                                                    'Not a real loop just easy way to exit block of code
            IF isnull(UDFselected)
                Mess = *concat_lines(Mess,"Select UDF to alter first")
                exit while
            end if
            DIM DictName as C                                        'Determine the name of the dictionary file
            DictName = file.filename_parse(a5.Get_Name(),"dpn") + ".ALB"            
            DIM DebugList as C = ""                                    'list of what was found in dictionary for debugging
            DIM Tbl as P
            DIM FndRec as N = 0                                        'record number of found browse definition
            
            Tbl = dictionary.open(DictName,FILE_RW_SHARED)            'open the dictionary in shared read write mode    go to first
            Tbl.fetch_first()                                        'we should not can not build queries in on dictionary
            while .NOT. Tbl.fetch_eof()                                'so loop through records looking for the function of interest    
                DebugList = *concat_Lines(DebugList,Tbl.Name + " " + Tbl.Type)
                IF rtrim(Tbl.Name) = UDFselected .AND. rtrim(Tbl.Type) = "GUDF"    'Is this a match to the Global User Defined Function we want to alter
                    FndRec = Tbl.recno()                            'record record number so we can find it again                                                                
                end if                                                'we read through each record so we can see all    
                Tbl.fetch_next()                                    'for when function definition can't be found
            wend
            IF ("r" $ Debug)                                        'debug output what we found in dictionary
                zTraceStamp(type::xbasicmodule.get_current())
                Trace.WriteLn("Database Dictionary: " + DictName)
                Trace.WriteLn("Function: " + UDFselected)
                Trace.WriteLn("Function Defination " + IF(FndRec > 0,"Found","NOT Found"))
                Trace.WriteLn("--- START Data Dictionary Entries ---")
                Trace.Write(DebugList)
                Trace.WriteLn("--- END Data Dictionary Entries ---")
            end if
            
            IF FndRec = 0                                            'error if we can't find the UDF 
                Mess = *concat_lines(Mess,"Unable to locate selected UDF in dictionary: " + UDFselected)
                Tbl.close()
                exit while
            end if
            
            Tbl.fetch_goto(FndRec)                                    'Return to the found record
                    
            errspot = "CommitRec"
            commit_flag = .T.
            Tbl.change_begin(.F.)                                    'Start Change mode
        
            If Tbl.mode_get() <> 1                                    'Optional check for chnage mode enterred
                errspot = ""                                        'catches table lock conflicts
                Mess = "Unable to place database dictionary in change mode"
                exit while
            end if
        
            IF a_dlg_button = "delete"                                 'Confirm deletion using name from actual record
                IF ui_msg_box(DialogTtl,"Delete Function: " + alltrim(Tbl.Name),UI_YES_NO) = UI_YES_SELECTED
                    Tbl.delete()
                end if
                a_dlg_button = ""                                    'keep us from continously processing this button press
            ELSEIF a_dlg_button = "rename" 
                UDFnew = ptext.text
                Mess = VerifyName(UDFnew)                            'Verify new name is valid
                IF isnull(Mess)                                        'If it is change the name
                    Tbl.Name = UDFNew                                
                end if
                a_dlg_button = ""                                    'keep us from continously processing this button press
            end if
                
            Tbl.change_end(commit_flag)                                'complete the change    
            errspot = ""                                            'do record entry/change error processing 
            If .NOT. commit_flag THEN                                'can only be FALSE if error entering record
                Mess = *concat_lines("Unable to update database dictionary",Commit_Error)
            end if
            Tbl.close()
            UDFlist = UDFlistBld()
            exit while
        wend
    end if
    
        
    IF a_dlg_button = "change"                                         'Live correction of function name
        DIM ip as N                                                    'insertion point of cursor
        DIM tp as N                                                    'test point character to test in name
        DIM Char as C                                                'Character to test in function name
        a_dlg_button = ""                                            'list of chacaters to be removed         
        ip = ptext.object.get_cursor()                                 'insertion point of cursor
        IF .NOT. (*first("UDF_",ptext.text) .OR. *first(ptext.text,"UDF_"))                        
            ptext.text = "UDF_" + ptext.text                        'add prefic to name if it is not there of partialially there
            ip = ip + 4                                                'partial check allows user to enter it
            ptext.text = left(ptext.text,24)                        'in case file table name gets to long
            ip = min(ip,24)                                            
        end if
        oldlen = len(ptext.text)                                    'get orginal length of string so we can reposition cursor
        tp = 1                                                        'starting position for testing characters in function name
        While tp <= len(ptext.text)                                    'any more characters to test loop
            Char = substr(ptext.text,tp,1)                            'is next character to test allowed
            IF isalpha(Char) .OR. isdigit(Char) .OR. Char = "_"
                tp = tp + 1                                            'character ok mve on to next
            ELSE                                                    'character not Ok so remove it 
                ptext.text = stuff(ptext.text,tp,1,"")                'everything moves left next character is in same spot
            end if
        WEND
        ip = ip - (oldlen - len(ptext.text))                        'reset insertion point to adjust for characters removed    
        ptext.object.set_cursor(ip)
    end if
    
    IF Mess
        ui_msg_box(DialogTtl,Mess,UI_ATTENTION_SYMBOL+UI_OK)
    end if
    end 
    
    '-------------------
    '// ERROR Handler --
    '-------------------
    ERRORHANDLER:
    IF errspot = "CommitRec"                                        'Trap things that can go wrong during data entry
        Commit_flag = .F.                                            'Set flag so change/entry is not completed and record error for later
        Commit_error = *concat_lines(Commit_error,error_text_get() + " Line: " + TrimNum(error_line_number_get()))
        resume next                                                    'Return to code so Record Entry/Change can be completed taking
    End if                                                            'table out of change entry mode.
    
    ON ERROR GOTO 0                                                    'No more special error traps that continue the code
        Mess2 =<<%txt%
    ERROR: {error_text_get()}
    Script: {error_script_get()}
    Line: {error_line_number_get()}
    %txt%
        Mess = *concat_lines(Mess,evaluate_string(Mess2))
        ui_msg_box(DialogTtl,Mess,UI_ATTENTION_SYMBOL+UI_OK)
    END
    
    '---------------------------------
    '// In Dialog Support Functions --
    '---------------------------------
    FUNCTION UDFlistBld AS C ()                                        'Build list of UDF_ prefixxed functions    
        controlpanel.refresh()                                        'Refresh control panel from Databasr dictionary
        DIM UDFlist AS C = ""                                        'Functions are enumerated from control panel
        List = A5.UDF_enum(2)                                        'at users request or 
        FOR EACH Line IN List                                        'before creating new so we don't overwrite
            IF *FIRST(Line.value,"UDF_")                            'one just created
                UDFList = *concat_lines(UDFList,Line.Value)        
            end if
        NEXT
        UDFlistBld = SORTSUBSTR(UDFlist,crlf())
    END FUNCTION
    
    FUNCTION VerifyName AS c(NewName)                                'Verify new function name is unique and fits requirements
        DIM Mess AS C = ""
        IF isnull(NewName)
            Mess = *concat_lines(Mess,"New name required.")
            a_dlg_button = ""                                        'prevent any other functions from happening
        ELSEIF NewName = "UDF_"
            Mess = *concat_lines(Mess,"Full name required for new name.")
            a_dlg_button = ""
        ELSEIF .NOT. *FIRST(NewName,"UDF_")
            Mess = *concat_lines(Mess,"Name must have prefix UDF_")
            a_dlg_button = ""
        ELSEIF word_exists(UDFlistBld(),NewName,crlf())
            Mess = *concat_lines(Mess,"Function already exist with this name.")
        end if
        VerifyName = Mess
    END FUNCTION
    
    %code%
    
    ui_modeless_dlg_box(DialogTtl,Dialog,Code)                        'Last thing script does all required code must be in event handlers

  2. #2
    "Certified" Alphaholic MoGrace's Avatar
    Real Name
    Robin
    Join Date
    Mar 2006
    Location
    Los Angeles
    Posts
    3,408

    Default Re: User Defined Functions in RunTime

    Hi Paul,
    Trying to copy and paste a long scrolling window is a bit tedious, would you export it as a text file and upload it here? I would love to try this script!
    Robin

    Discernment is not needed in things that differ, but in those things that appear to be the same. - Miles Sanford

  3. #3
    "Certified" Alphaholic Stan Mathews's Avatar
    Real Name
    Stan Mathews
    Join Date
    Apr 2000
    Location
    Bowling Green, KY
    Posts
    25,011

    Default Re: User Defined Functions in RunTime

    There can be only one.

  4. #4
    "Certified" Alphaholic MoGrace's Avatar
    Real Name
    Robin
    Join Date
    Mar 2006
    Location
    Los Angeles
    Posts
    3,408

    Default Re: User Defined Functions in RunTime

    Thanks Stan
    Robin

    Discernment is not needed in things that differ, but in those things that appear to be the same. - Miles Sanford

  5. #5
    Member
    Real Name
    Paul Verboom
    Join Date
    Apr 2006
    Location
    Halifax, Nova Scotia, Canada
    Posts
    134

    Default Re: User Defined Functions in RunTime

    Ops, never tried copying code out of one of those windows. MoGrace you are correct it is much harder than pasting it in.
    I should have tested the code more before posting, ran into two problems. Functions created by the script are not available till after A5 is restarted, however I have worked out a fix for this. Also functions created or changes made in a shadow copy are not reflected in the master copy and will be overwritten when the shadow is updated. This is a harder fix but is addressable. Should have a new version posted in a few days.
    Last edited by pboomwork; 06-01-2016 at 12:19 PM.

  6. #6
    Member
    Real Name
    Paul Verboom
    Join Date
    Apr 2006
    Location
    Halifax, Nova Scotia, Canada
    Posts
    134

    Default Re: User Defined Functions in RunTime

    The issues listed in my last post have been addressed. The script now comes with two functions that will sync the User Defined Functions between the Shadow and Master Data Dictionaries. The two functions are optional and only required if you are using Shadow databases.

    While working on this I've come across a whole bunch of xbasic functions for directly dealing with the UDFs. Direct data dictionary manipulation is only required in the two functions that sync the UDFs between Shadow and Master Databases. If you are interested in how this done this turn on the debug flags at the start of these functions and view the output in the trace window.

    In the process of writing this I've learned a bunch about how A5 uses functions and how they are actually loaded into the variable spaces. A bunch of things I found strange at one time now make sense, for example why functions are sometimes listed as a variable type. This stuff is documented in the code if you are interested.

    The main editor window has been updated a bit

    UDF-Edit.png
    Attached Files Attached Files

  7. #7
    "Certified" Alphaholic MoGrace's Avatar
    Real Name
    Robin
    Join Date
    Mar 2006
    Location
    Los Angeles
    Posts
    3,408

    Default Re: User Defined Functions in RunTime

    I haven't looked into your code yet, but it should be possible to create user *.alb files that are loaded as local libraries with the app. Ie., If each user's .alb is named the same (eg, "user_scr.alb") and it is stored in the shadow or runtime directory. Then each user can save his scripts in his own local library and they won't be overwritten with a version update.

    Forgive me if your code already is doing something similar...
    Robin

    Discernment is not needed in things that differ, but in those things that appear to be the same. - Miles Sanford

  8. #8
    Member
    Real Name
    Paul Verboom
    Join Date
    Apr 2006
    Location
    Halifax, Nova Scotia, Canada
    Posts
    134

    Default Re: User Defined Functions in RunTime

    The A5 functions used to manipulate the Global User Defined Functions will only operate on the current database data dictionary. They provide no provissions for manipulating other ALB files. My intent is End user functions can be shared between installations, hence the syncronization between Master and Shadow databases. I am planning an other method for retaining user settings between application revisions.

Similar Threads

  1. User-defined functions in Web Components
    By jfg in forum Application Server Version 10 - Web/Browser Applications
    Replies: 3
    Last Post: 07-16-2010, 05:33 PM
  2. user defined functions
    By davidv43 in forum Alpha Five Version 9 - Desktop Applications
    Replies: 4
    Last Post: 03-30-2009, 12:52 PM
  3. user defined functions
    By dik_coleman in forum Alpha Five Version 7
    Replies: 10
    Last Post: 12-24-2005, 10:42 AM
  4. User defined functions on WAS
    By Karen Snyder in forum Web Application Server v6
    Replies: 2
    Last Post: 09-29-2005, 08:44 PM
  5. user-defined functions
    By Tim Stephens in forum Alpha Five Version 5
    Replies: 3
    Last Post: 12-05-2002, 05:33 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •