Announcement

Collapse
No announcement yet.

Manage Class Aliases

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Manage Class Aliases

    The other day I wanted to profile InfoView. A bit to my dismay I soon discovered that PB support for classes doesn't quite appear finished yet... Seeing that 13 Count properties were called and took various amounts of time wasn't the most helpful. Support mentioned I could simply add an alias to each method and property. Bit disapointing when I realized I had 977 properties and methods scattered over 11,923 lines of code... Anyway not one to be disapointed for long, I decided to write this little utility. It will either add an alias to each method and property or remove an alias. Usage:

    ManageAlias /add
    ManageAlias /remove

    Class methods look like className_cm_methodName
    Methods look like className_interfaceName_methodName
    Properties look like className_interfaceName_get/set_propertyName

    Seems to work well here, I highly recommend backing up said files before trying it since it alters every .inc and .bas file in the subtree from where you executed it. Needless to say if you find a small bug, you probabbly don't want to wiping out lots of original hard work, you've been warned.

    ManageAliases.bas
    Code:
    #Compile Exe
    #Dim All
     
    Global addAlias As Long
     
    Function PBMain () As Long
      Local i As Long
      Local cmd As String
      Local filename As String
      Local v As String
      Local p As Long
      Local q As Long
      Local className As String
      Local interfaceName As String
      Local n As String
      Local t As String
     
      i = 1
      While Command$(i)<>""
        cmd = LCase$(Command$(i))
        If Left$(cmd,1)="-" Then Mid$(cmd,1,1)="/"
        If Left$(cmd,1)="/" Then
          Select Case cmd
            Case "/add": addAlias = -1
            Case "/remove": addAlias = 0
            Case Else
              Exit Function
          End Select
        End If
        Incr i
      Wend
      Shell "cmd /C Dir *.bas;*.inc /b /s >filelist.tmp"
      Open "filelist.tmp" For Input As #1
     
      While Not Eof(1)
        Line Input #1, filename
        If Trim$(filename)<>"" Then
          Open filename For Input As #2
          Open "tmp.txt" For Output As #3
          className = ""
          interfaceName = "cm"
          While Not Eof(2)
            Line Input #2, v
            Call ParseName( v, n, t )
            Select Case t
              Case "class"
                className = n
                interfaceName = "cm"
              Case "interface"
                interfaceName = n
              Case "method"
                p = InStr(v, "(" )
                q = InStr( LCase$(v), " alias " )
                If p>0 Then
                  If addAlias Then
                    If q=0 Then
                      v = Left$(v, p-1) + Build$(" Alias ",$Dq, className, "_", interfaceName, "_", n, $Dq, " ") + Mid$(v, p)
                    End If
                  Else
                    If q>0 Then
                      v = Left$(v, q) + Mid$(v, p)
                    End If
                  End If
                End If
              Case "get","set"
                p = InStr(v, "(" )
                q = InStr( LCase$(v), " alias " )
                If p>0 Then
                  If addAlias Then
                    If q = 0 Then
                      v = Left$(v, p-1) + Build$(" Alias ",$Dq, className, "_", interfaceName, "_", t, "_", n, $Dq, " ") + Mid$(v, p)
                    End If
                  Else
                    If q>0 Then
                      v = Left$(v, q) + Mid$(v, p)
                    End If
                  End If
                End If
            End Select
            Print #3, v
          Wend
          Close #3
          Close #2
          Kill filename
          Name "tmp.txt" As filename
        End If
       Wend
       Close #1
       Kill "filename.tmp"
    End Function
     
    Sub ParseName( value As String, n As String, t As String )
      Local v As String
      Local p As Long
      Local cnt As Long
     
      v = value
      Replace $Tab With " " In v
      Replace "(" With " (" In v
      Replace "  " With " " In v
      v = Trim$(v)
      cnt = ParseCount( v, " ")
      Dim l(cnt-1) As String
      Parse v, l(), " "
      t = ""
      n = ""
      If LCase$(l(0)) = "interface" Then
        n = l(1)
        t = "interface"
      ElseIf LCase$(l(0)) = "class" And LCase$(l(1))<>"method" Then
        n = l(1)
        t = "class"
      ElseIf LCase$(l(0)) = "class" And LCase$(l(1))="method" Then
        n = l(2)
        t = "method"
      ElseIf LCase$(l(0)) = "property" And LCase$(l(1)) = "get" Then
        n = l(2)
        t = "get"
      ElseIf LCase$(l(0)) = "property" And LCase$(l(1)) = "set" Then
        n = l(2)
        t = "set"
      ElseIf LCase$(l(0)) = "method" And Mid$(l(1),1,1)<>"=" Then
        n = l(1)
        t = "method"
      End If
      If n<>"" Then
        p = InStr(n, "(")
        If p>0 Then
          n = Left$(n, p-1 )
        End If
      End If
    End Sub
    Here's a before sample:
    Column1,Column2,Column3
    CREATE,1,0
    CREATE,1,0
    DESTROY,0,0
    DESTROY,0,0
    LEFT,0,0
    LEFT,0,0
    LEFT>,1,0
    LEFT>,1,0
    NEWTEST1,1,0
    NEWTEST2,1,0
    ONE,0,0
    ONE,1,0
    PBMAIN,1,0
    RIGHT,1,0
    RIGHT,1,0
    RIGHT>,1,0
    RIGHT>,1,0
    THREE,0,0
    THREE,1,0
    TWO,0,0
    TWO,1,0


    Here's an after adding aliases sample:
    Column1,Column2,Column3
    cTest1_cm_Create,1,0
    cTest1_cm_Destroy,0,0
    cTest1_iTest1_get_Left,0,0
    cTest1_iTest1_get_Right,1,0
    cTest1_iTest1_One,1,0
    cTest1_iTest1_set_Left,1,0
    cTest1_iTest1_set_Right,1,0
    cTest1_iTest1_Three,1,0
    cTest1_iTest1_Two,1,0
    cTest2_cm_Create,1,0
    cTest2_cm_Destroy,0,0
    cTest2_iTest2_get_Left,0,0
    cTest2_iTest2_get_Right,1,0
    cTest2_iTest2_One,0,0
    cTest2_iTest2_set_Left,1,0
    cTest2_iTest2_set_Right,1,0
    cTest2_iTest2_Three,0,0
    cTest2_iTest2_Two,0,0
    NEWTEST1,1,0
    NEWTEST2,1,0
    PBMAIN,1,0

    And for those wanting truely pointless code, here's the sample code that does absolutely nothing.

    Test.bas
    Code:
    #Compile Exe
    #Dim All
     
    Function PBMain () As Long
    Dim a As iTest1
    Dim b As iTest2
     
    a = NewTest1()
    b = NewTest2()
    a.Right=5
    b.Right=5
    a.Left = a.Right
    b.Left = b.Right
     
    a.one()
    a.Two()
    a.Three()
     
     
    Profile "test.csv"
    End Function
     
     
    Function NewTest2() Common Export As iTest2
      Local obj As iTest2
      obj = Class "cTest2"
      Function = obj
    End Function
     
     
    Function NewTest1() Common Export As iTest1
      Local obj As iTest1
      obj = Class "cTest1"
      Function = obj
    End Function
     
    Class cTest1 Guid$("{a55ba212-933b-4861-b2a8-34c60667e161}") Common
      Instance left_ As Long
      Instance right_ As Long
     
      Class Method Create ()
      End Method
      Class Method Destroy ()
      End Method
     
      Interface iTest1 Guid$("{8cf5fa33-e9ec-4809-ae24-f00b78c94e88}")
        Inherit IUnknown
     
        Property Get Left () As Long
          Property = left_
        End Property
        Property Set Left ( ByVal value As Long )
          left_ = value
        End Property
     
        Property Get Right () As Long
          Property = right_
        End Property
        Property Set Right ( ByVal value As Long )
          right_ = value
        End Property
     
        Method One () As String
        End Method
     
        Method Two () As String
        End Method
     
        Method Three () As String
        End Method
      End Interface
    End Class
     
    Class cTest2 Guid$("{4df269b1-39df-4b2b-9294-532b6aa0b962}") Common
      Instance left_ As Long
      Instance right_ As Long
     
      Class Method Create ()
      End Method
      Class Method Destroy ()
      End Method
     
      Interface iTest2 Guid$("{2f3882e0-da9a-42b3-9804-6bfe061f90e9}")
        Inherit IUnknown
     
        Property Get Left () As Long
          Property = left_
        End Property
        Property Set Left ( ByVal value As Long )
          left_ = value
        End Property
     
        Property Get Right () As Long
          Property = right_
        End Property
        Property Set Right ( ByVal value As Long )
          right_ = value
        End Property
     
        Method One () As String
        End Method
     
        Method Two () As String
        End Method
     
        Method Three () As String
        End Method
      End Interface
    End Class
    Hope someone else finds a use for this.
    Last edited by Larry Charlton; 6 Oct 2011, 08:35 PM.
    LarryC
    Website
    Sometimes life's a dream, sometimes it's a scream

  • #2
    Aliases for profiling take 2

    Ran into a small issue with profiling. Apparently while identifiers can be up to 256 characters in length the profiler will only show the first 32 characters. As a result I update the code with a flag /arbitrary.

    If you use /arbitrary, the naming format for aliases will be:
    method_interface_class
    In addition if the name exceeds 32 characters, it will shorten the name by the length of the current value of a sequence and create a unique 32 character name. It's not perfect, but it will allow you to search and find the aliases an possibly even be able to directly tell what they are.

    You can also get the code from here, it includes the exe compiled with PBCC.

    ManageAliases.bas
    Code:
    #Compile Exe
    #Dim All
     
    Global addAlias As Long
    Global className As String
    Global interfaceName As String
    Global arbitrary As Long
    Global arbitraryId As Long
     
    Function PBMain () As Long
      Local i As Long
      Local cmd As String
      Local filename As String
      Local v As String
      Local p As Long
      Local q As Long
      Local n As String
      Local t As String
     
      i = 1
      While Command$(i)<>""
        cmd = LCase$(Command$(i))
        If Left$(cmd,1)="-" Then Mid$(cmd,1,1)="/"
        If Left$(cmd,1)="/" Then
          Select Case cmd
            Case "/add": addAlias = -1
            Case "/remove": addAlias = 0
            Case "/arbitrary": arbitrary = -1
            Case Else
              Exit Function
          End Select
        End If
        Incr i
      Wend
      Shell "cmd /C Dir *.bas;*.inc /b /s >filelist.tmp"
      Open "filelist.tmp" For Input As #1
     
      While Not Eof(1)
        Line Input #1, filename
        If Trim$(filename)<>"" Then
          Open filename For Input As #2
          Open "tmp.txt" For Output As #3
          className = ""
          interfaceName = "cm"
          While Not Eof(2)
            Line Input #2, v
            Call ParseName( v, n, t )
            Select Case t
              Case "class"
                className = n
                interfaceName = "cm"
              Case "interface"
                interfaceName = n
              Case "method"
                p = InStr(v, "(" )
                q = InStr( LCase$(v), " alias " )
                If p>0 Then
                  If addAlias Then
                    If q=0 Then
                      v = Left$(v, p-1) + GetAlias( n, t ) + Mid$(v, p)
                    End If
                  Else
                    If q>0 Then
                      v = Left$(v, q-1) + Mid$(v, p)
                    End If
                  End If
                End If
              Case "get","set"
                p = InStr(v, "(" )
                q = InStr( LCase$(v), " alias " )
                If p>0 Then
                  If addAlias Then
                    If q = 0 Then
                      v = Left$(v, p-1) + GetAlias( n, t ) + Mid$(v, p)
                      'v = Left$(v, p-1) + Build$(" Alias ",$Dq, className, "_", interfaceName, "_", t, "_", n, $Dq, " ") + Mid$(v, p)
                    End If
                  Else
                    If q>0 Then
                      v = Left$(v, q-1) + Mid$(v, p)
                    End If
                  End If
                End If
            End Select
            Print #3, v
          Wend
          Close #3
          Close #2
          Kill filename
          Name "tmp.txt" As filename
        End If
       Wend
       Close #1
       Kill "filename.tmp"
    End Function
     
    Function GetAlias( n As String, acc As String ) As String
      Local nm As String
      Local idName As String
     
      If arbitrary Then
        Incr arbitraryId
        idName = "_" + Format$( arbitraryId, "0" )
        nm = Build$(n, "_" )
        If acc<>"method" Then
          ' Get or Set
          nm = Build$( nm, acc, "_" )
        End If
        nm = Build$(nm, interfaceName, "_", className  )
        If Len( nm ) + Len(idName) > 32 Then
          nm = Left$( nm, 32 - Len(idName) )
          nm += idName
        End If
        nm = Build$( " Alias ", $Dq, nm, $Dq, " " )
      Else
        nm = Build$(" Alias ",$Dq, className, "_", interfaceName, "_", n, $Dq, " ")
      End If
      Function = nm
    End Function
     
    Sub ParseName( value As String, n As String, t As String )
      Local v As String
      Local p As Long
      Local cnt As Long
     
      v = value
      Replace $Tab With " " In v
      Replace "(" With " (" In v
      Replace "  " With " " In v
      v = Trim$(v)
      cnt = ParseCount( v, " ")
      Dim l(cnt-1) As String
      Parse v, l(), " "
      t = ""
      n = ""
      If LCase$(l(0)) = "interface" Then
        n = l(1)
        t = "interface"
      ElseIf LCase$(l(0)) = "class" And LCase$(l(1))<>"method" Then
        n = l(1)
        t = "class"
      ElseIf LCase$(l(0)) = "class" And LCase$(l(1))="method" Then
        n = l(2)
        t = "method"
      ElseIf LCase$(l(0)) = "property" And LCase$(l(1)) = "get" Then
        n = l(2)
        t = "get"
      ElseIf LCase$(l(0)) = "property" And LCase$(l(1)) = "set" Then
        n = l(2)
        t = "set"
      ElseIf LCase$(l(0)) = "method" And Mid$(l(1),1,1)<>"=" Then
        n = l(1)
        t = "method"
      End If
      If n<>"" Then
        p = InStr(n, "(")
        If p>0 Then
          n = Left$(n, p-1 )
        End If
      End If
    End Sub
    LarryC
    Website
    Sometimes life's a dream, sometimes it's a scream

    Comment

    Working...
    X