[Fwd: Modifying Protoclass]
4 views
Skip to first unread message
Bill Farrell
Feb 1, 2012, 9:58:18 AM2/1/12
to intersy...@googlegroups.com
Hi Rich,
The short answer is "you certainly can". The longer answer is a bit more complicated due to the fact that I did a custom Protoclass based on the latest PROTOCLASS MVB code. I don't know at which version this came out in. I've been using 2012.1 field test which unfortunately expired this morning. You can accomplish the same goal in either version by finding the section in your version that sets parameters for individual properties. A good string to search for in your code would be "MVBATTRIBUTE" since that gets set in either version. You can add some code to look in %dictionary to find the MV attribute you want and look at the DICT properties underneath that to grab the length and add a MAXLENGTH parameter to your property.
The quickest thing I could advise is to run PROTOCLASS on a scratch file that has dictionary items (you can always delete the file and class right after), then at the command line type
USER> [ zw %dictionary
Then you can see the structure of %dictionary. This array gets built by a parseDict call in the code and persists after you run PROTOCLASS. It's not quite as complicated as it seems.
I'm enclosing my custom class and the routine that runs it. The stock PROTOCLASS says "modify the code", so I did exactly that :)
Best regards,
Bill
The library ClassMethod:
ClassMethod Protoclass(Filename As %String = "", PackageName As %String = "MVFile", DeleteExistingClass As %Boolean = 0, GenerateXData As %Boolean = 1, MaxRealAttribute As %Integer = 8999)
{
If $Get( %MVBCommon ) = "" Then %MVBCommon = "MVBooster.Common"->%New()
CompleteClassName = PackageName : "." : Filename
DefaultQueryFields = %MVBCommon->nil
************************************
* PROTOCLASS.mvb
*
* Creates the verb PROTOCLASS which the shell will also find
* if it is called as PROTOCLASS.
*
* This MVBASIC program shows how to parse the dictionary of an MV
* file and use some or all of the DICT elements to create a Cache' class
* definition. The class is then compiled and is available in the namespace/class
* whence the program was run. It also serves as a useful example of how to utilize
* standard Cache' classes, as this is what it uses to build the class definition.
*
* A class is first defined and saved, which produces a class that can then be edited
* using Cache' studio, then it is compiled, which is then the basis for all other
* projections such as SQL tables.
*
* Because no one set of files is defined in the same way as any other, you are free
* to make copies of this program and modify it to suit your own application requirements.
*
* +--------------------------------------------------------+
* | Copyright 2007-2009 by InterSystems Corporation, |
* | Cambridge, Massachusetts, U.S.A. |
* | All rights reserved. |
* | |
* | Confidential, unpublished property of InterSystems. |
* | |
* | This media contains an authorized copy or copies |
* | of material copyrighted by InterSystems and is the |
* | confidential, unpublished property of InterSystems. |
* | This copyright notice and any other copyright notices |
* | included in machine readable copies must be reproduced |
* | on all authorized copies. |
* +--------------------------------------------------------+
*
*
* Declare some global (cross program) variables that are
* multivalued in the Cache' sense, not just the standard MV style.
* To do this we DIM the variables, but do not supply any dimensions
* which tells the compiler that it is a standard COS style variable
* that needs no dimension sizing and just works.
*
* jwwf - Obviously this is a highly-modified version that works with MVBooster.
* I left the original InterSystems copyright intact.
*
DIM %dictionary()
Dim %MVBFileInfo() ; * utilize the MVBooster file information structure
* Now some variables that are only local to this program
DIM ClassCrossReference()
UseAsciiHex = 0
*
* Parse the command line. We have access to MV TCL II processing
* through the %SYSTEM.MV class, and so we do not need to program
* all of that in BASIC. Note, that you can produce the list of
* DICTionary elements to process in any way you choose, then just call
* the parseDict() method as below to add it to the %dictionary() multilevel
* array.
"MVBooster.Library"->FileInfo( Filename )
If Status() <> %MVBCommon->successful Then
%MVBTrace->WriteError()
Return
End
FileDataLevel = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoFilePropertiesSubscript )
FileDataLevel->OpenDict()
FileDictLevel = FileDataLevel->DictHandle
* We must not run protoclass against system globals
If FileDataLevel->FileHandle->%Global[1,1]= "%" Then ABORT 446,fileName
* We must not run protoclass from a different account
If FileDataLevel->FileHandle->%TargetAccount <> FileDataLevel->FileHandle->%Account Then
%MVBTrace->WriteEntry( "Protoclass for this file must be run in the ":FileDataLevel->%TargetAccount:" account." )
Stop
End
If FileDataLevel->FileHandle->%StorageType <> 0 Then
%MVBTrace->WriteEntry( "Protoclass can only be used against files stored in globals in inode format." )
Stop
End
*
* Make sure our dictionary tracking structure is clean
*
$KILL %dictionary
%DictNumber = 0
*
* Initialize the list of items to add to XDATA
*
XDATAList = %MVBCommon->nil
*
* Now we can loop on each item ID from the DICTionary and parse
* it into the %dictionary variable. This will make it much easier
* to traverse it multiple times to see what special processing we
* may need to define the class.
*
@ID = %MVBCommon->nil
Loop
@ID = $Order( %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictionaryStructureSubscript, @ID ) )
Until @ID = %MVBCommon->nil Do ; *"%SYSTEM.MV"->TCL2Next() = 1 DO
* One more DICT element was found, read this in from the
* DICT
FileDataLevel->DictRead( @ID )
If FileDataLevel->DictRecord = %MVBCommon->nil Then
%MVBTrace->WriteEntry( "Could not find " : @ID : " in DICT " : Filename )
Continue
End
* Is this a type of DICT entry that this method can handle? Sometimes
* people purposefully or accidentally store things in the DICT that
* should not really be there. These must be filtered out in favor
* of DICT types that can be processed.
Record = FileDataLevel->DictRecord
type = UPCase( Record< 1 >[ 1, 1 ] )
If INDEX("ADSIV", type, 1) <> 0 Then
*
* Test for any specific names not to generate properties for
*
If @ID <> "@ID" Then
* Now parse the entry. There is another %SYSTEM.MV class method
* to call that will do this.
*
"%SYSTEM.MV"->parseDict(FileDictLevel, Record, @ID)
*
* Examine the string in attribute 8
*
pattr8 = $Get( %dictionary( %DictNumber, "attr8" ) )
If pattr8 <> %MVBCommon->nil Then
statusString = "%SYSTEM.MV"->ConvAnalyze(pattr8)
errorTypeCode = FIELD(statusString,",",1)
If errorTypeCode < 0 Then
%MVBTrace->WriteEntry( "DICT entry '":@ID:"' ignored due to errors in dict item." )
%dictionary(%DictNumber,"processed") = 1
Continue
End
* save the bit pattern that indicates the codes found
%dictionary(%DictNumber, "attr8bits") = FIELD(statusString,",",2)
* Save the list of referenced attributes
%dictionary(%DictNumber, "attr8refs") = FIELD(statusString,",",3,999)
End Else
* this would be a reasonable place to setup sqlname
* %dictionary(%DictNumber,"sqlname")=....
End
End
Continue
End
* This block is run when an item can not be processed into an property. If GenerateXData
* is set to @true then add it to the XDATA block, else throw it away.
If GenerateXData = @true Then
XDATAList<-1> = @ID
End Else
%MVBTrace->WriteEntry( "DICT entry '" : @ID : "' ignored." )
End
Repeat
* All manageable DICT items have been parsed. Begin the first phase
* of processing them into class properties.
*
* A Cache' class can only define one class property as being stored
* in the dynamic array. This means that if the dictionary contains
* multiple references to the same attribute, we must create
* a raw entry for the attribute and 'calculate' the value of each
* of the duplicate properties from this value.
*
* In practice, it is not usually a good idea to have duplicate references
* in the class because once the property is calculated, we cannot
* easily determine if the calculation is reversible. Therefore, we
* make such properties read only.
*
* The nature of a SQL table of Cache' Class means that duplicate definitions
* of the same attribute are generally redundant (as formatting and
* so on is performed outside the table/class.) However it is sometimes valid.
* Where there are no duplicates we can refer to the attribute
* directly. The property will then only be calculated if it is subject
* to an Itype or Attribute 8 (referred to as MVTOLOGICAL) transformation.
* (See comments later on these types of transformations...)
*
* Now loop through the parsed dictionary elements and find
* out which are duplicates. We will ignore references to attribute
* 0 as being the Item ID or a calculated field. Furthermore, we will
* assume that fields marked as attribute MaxRealAttribute or higher are also calculated.
* (This is fairly common practice, though highly inefficient
* for various reasons.)
*
* You may need to change the code here to adapt it to the practices
* at your own site.
** Note: (JWWF) That's exactly what I did with the entire routine.
*
* See if we have a class for this file already
*
ClassDefinition = "%SYSTEM.MV"->getPrimaryMVClass( FileDataLevel->FileHandle, 0, %MVBCommon->nil )
*
* If desired we can delete the existing class and start from scratch. The DeleteExistingClass
* argument in the formal spec controls this. (It defaults to @false.)
*
If DeleteExistingClass = @true Then
If ClassDefinition <> %MVBCommon->nil Then ClassToDelete = ClassDefinition->Name Else ClassToDelete = CompleteClassName
"%Dictionary.ClassDefinition"->%DeleteId( ClassToDelete ) ; * delete the class object
"%ExtentMgr.Util"->DeleteExtentDefinition( ClassToDelete ) ; * also delete the definition else the rest of this method may go awry.
ClassDefinition = %MVBCommon->nil
End
If ClassDefinition= %MVBCommon->nil Then
* Create the primary MV class for the file. The name comes from a concatenation of
* the package name (supplied in the formal spec), a period, and the class name (also
* in the formal spec).
ClassDefinition = "%SYSTEM.MV"->getPrimaryMVClass( FileDataLevel->FileHandle, 1, CompleteClassName )
End
* Extract the unqualified classname: the last '.' delimited substring
className = FIELD( ClassDefinition->Name, ".", DCOUNT(ClassDefinition->Name, "." ) )
properties = ClassDefinition->Properties
* Now Build a cross refrence array of any existing properties that will make updating
* the class a lot easier. This will be empty for a new class and is updated every
* time we add or modify a property.
*
* The layout is: ClassCrossReference(sub1,sub2) = value
* where the subscripts are:
* sub1 sub2 value
* 0 property name property object
* 1 Dict Name " "
* 2 Attr No " " This is the primary definition for that attr
* 3 property name index object
* 4 Dict Name %MVBCommon->nil %MVBCommon->nil
* 5 storage.attrNo proPropertyName in storage
* 6 storage.proPropertyName value object in storage
* 7 Values Object in storage
* 8 attrNo,proPropertyName property object - other definitions for this attribute
* 9 upcased name true case name
* 10 1 1 if class locked against MV verb updates
"%SYSTEM.MV"->buildMVClassXref( ClassDefinition, ClassCrossReference )
*
* Check to see if this class has been locked to prevent unintentional
* modification
*
If $Get( ClassCrossReference( 10, 1 ) ) = 1 Then
"MVBooster.Library"->SetCondition( 104, CompleteClassName : " has been locked against automatic updates.", "MVBooster.Library->Protoclass" )
Return
End
*
* First Pass: Compare the dict items we have with the current class
*
CacheDictionaryLocation = %MVBCommon->nil
Loop
CacheDictionaryLocation = $Order( %dictionary( CacheDictionaryLocation ) )
While CacheDictionaryLocation <> %MVBCommon->nil Do
If $Get( %dictionary( CacheDictionaryLocation, "processed" ) ) <> %MVBCommon->nil Then Continue
*
* See if we already have a property defined for this DICT item
*
MVDictDefinition = $Get( %dictionary( CacheDictionaryLocation, "name" ) )
PropertyReference = $Get( ClassCrossReference( 1, MVDictDefinition ) )
If PropertyReference = %MVBCommon->nil Then
Continue
End
* We already have a property for this DICT item
* Look for any major changes
If $Get( %dictionary(CacheDictionaryLocation, "attrno" ) ) <> PropertyReference->Parameters->GetAt( "MVATTRIBUTE" ) Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "attr8" ) ) <> PropertyReference->Parameters->GetAt( "MVTOLOGICAL" ) Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "itypeSource" ) ) <> PropertyReference->Parameters->GetAt( "MVITYPE" ) Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "sqlname" ) ) <> PropertyReference->SqlFieldName Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "dataType" ) ) <> PropertyReference->Type Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "mv" ) ) = "M" And PropertyReference->Collection <> "list" Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "mv" ) ) <> "M" And PropertyReference->Collection = "list" Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "assoc" ) ) <> PropertyReference->Parameters->GetAt( "MVASSOCIATION" ) Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "svassoc" ) ) <> PropertyReference->Parameters->GetAt( "MVSVASSOCIATION" ) Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "justification" ) ) = "R" And $Get( %dictionary( CacheDictionaryLocation, "dataType" ) ) = "%String" Then
If PropertyReference->Parameters->GetAt( "COLLATION" ) <> "MVR" Then Continue
End Else
If PropertyReference->Parameters->GetAt( "COLLATION" ) = "MVR" Then Continue
End
*
* Handle any minor changes here
*
If $Get( %dictionary(CacheDictionaryLocation, "conv" ) ) <> PropertyReference->Parameters->GetAt( "MVTODISPLAY" ) Then
PropertyReference->Parameters->SetAt( $Get( %dictionary( CacheDictionaryLocation,"conv" ) ), "MVTODISPLAY" )
End
If $Get( %dictionary(CacheDictionaryLocation, "type" ) ) <> PropertyReference->Parameters->GetAt( "MVTYPE" ) Then
PropertyReference->Parameters->SetAt( $Get( %dictionary( CacheDictionaryLocation, "type" ) ), "MVTYPE" )
End
If $Get( %dictionary( CacheDictionaryLocation, "heading" ) ) <> PropertyReference->Parameters->GetAt( "MVHEADING" ) Then
PropertyReference->Parameters->SetAt( $Get( %dictionary( CacheDictionaryLocation, "heading" ) ), "MVHEADING" )
End
If $Get( %dictionary( CacheDictionaryLocation, "width" ) ) <> PropertyReference->Parameters->GetAt( "MVWIDTH" ) Then
PropertyReference->Parameters->SetAt( $Get( %dictionary( CacheDictionaryLocation,"width" ) ), "MVWIDTH" )
End
If $Get( %dictionary( CacheDictionaryLocation, "format" ) ) <> PropertyReference->Parameters->GetAt("MVFORMAT") Then
PropertyReference->Parameters->SetAt( $Get( %dictionary( CacheDictionaryLocation, "format" ) ) ,"MVFORMAT" )
End
*
* Consider this one processed
*
%dictionary( CacheDictionaryLocation, "processed" ) = 1
*
* Mark that Protoclass would have generated this if it hadn't already existed
*
MVAuto = PropertyReference->Parameters->GetAt( "MVAUTO" )
If Count( MVAuto, "P") = 0 Then PropertyReference->Parameters->SetAt( MVAuto : "P", "MVAUTO" )
Repeat
*
* Second Pass - delete those properties that we can replace
*
CacheDictionaryLocation = %MVBCommon->nil
Loop
CacheDictionaryLocation = $Order( %dictionary( CacheDictionaryLocation ) )
While CacheDictionaryLocation <> %MVBCommon->nil DO
If $Get( %dictionary( CacheDictionaryLocation, "processed" ) ) <> %MVBCommon->nil Then Continue
MVDictDefinition = $Get( %dictionary( CacheDictionaryLocation, "name" ) )
PropertyReference = $Get( ClassCrossReference( 1, MVDictDefinition ) )
If PropertyReference = %MVBCommon->nil Then Continue
*
* See if we are permitted to modify this property
*
MVAuto = PropertyReference->Parameters->GetAt( "MVAUTO" )
PropertyName = PropertyReference->Name
Begin Case
Case MVAuto = "P"
* this property was generated by protoclass
%MVBTrace->WriteEntry( "Deleting property " : PropertyName : " for replacement" )
"%SYSTEM.MV"->deleteMVProperty( PropertyName, ClassDefinition, ClassCrossReference )
* MVBooster makes class properties with custom get/set methods. If those exist, remove them along
* with the property to which they're attached.
Gosub RemoveGetSetMethods
Continue
Case COUNT (MVAuto, "I ") > 0
%MVBTrace->WriteEntry( "Property " : PropertyName : " cannot be modified until all indexes based on it are deleted" )
Case COUNT( MVAuto, "R" ) > 0
%MVBTrace->WriteEntry( "Property " : PropertyName : " cannot be modified because other properies are based on it" )
Case 0
%MVBTrace->WriteEntry( "Property " : PropertyName : " cannot be modified because it is not tagged as Protoclass generated" )
End Case
*
* indicate that we have processed this dict item
*
%dictionary( CacheDictionaryLocation, "processed" ) = 1
Repeat
* Third pass - process the simple attributes
* then later we will process the calculated attributes
* This allows the createProperty routine to base the complex properties on
* the simple properties.
%MVBTrace->WriteEntry( "Processing simple attribute definitions" )
CacheDictionaryLocation = %MVBCommon->nil
Loop
CacheDictionaryLocation = $Order( %dictionary( CacheDictionaryLocation ) )
While CacheDictionaryLocation <> %MVBCommon->nil Do
If $Get( %dictionary( CacheDictionaryLocation, "processed" ) ) <> %MVBCommon->nil Then Continue
*
* See if this is a 'simple' attribute definition
*
If ( $Get( %dictionary( CacheDictionaryLocation, "attr8" ) ) <> %MVBCommon->nil ) Or ( $Get( %dictionary(CacheDictionaryLocation, "itypeSource" ) ) <> %MVBCommon->nil ) Then Continue
AttributeNumberFromdictionary = $Get( %dictionary( CacheDictionaryLocation, "dataType" ) )
If ( AttributeNumberFromdictionary = %MVBCommon->nil ) Or ( AttributeNumberFromdictionary = 0 ) Or ( AttributeNumberFromdictionary > MaxRealAttribute ) Then Continue
MVDictDefinition = $Get( %dictionary( CacheDictionaryLocation, "name" ) )
PropertyReference = $Get( ClassCrossReference( 1, MVDictDefinition ) )
If PropertyReference <> %MVBCommon->nil Then Continue
*
* Let's construct a valid property name for this DICT entry
*
PropertyName = "MVBooster.Library"->CamelCase( MVDictDefinition ) ; * use custom CamelCase, not ISC's
*
* Override the collation if we need to.
* Properties with a type of %string will default to 'space' collation
* but if we intend to index this field, it is safer to use a length limitted collation
* like SqlString(150) to avoid errors with invalid data. You may find that defaulting
* to SqlString(150) then adjusting those properties that might possibly exceed
* 150 characters works best for you.
*
If $Get( %dictionary( CacheDictionaryLocation, "dataType" ) ) = "%String" And $Get(%dictionary(CacheDictionaryLocation,"justification"))<>"R" Then
* %dictionary(CacheDictionaryLocation,"collation")="SqlString(150)"
End
*
* Create the property
* This function takes care of the creation of the property
* You can make any modifications you need after it is created
*
%MVBTrace->WriteEntry( "Creating property called " : PropertyName : " from " : MVDictDefinition )
"%SYSTEM.MV"->createMVProperty( PropertyName, CacheDictionaryLocation, ClassDefinition, ClassCrossReference )
* MVBooster sets up a default "ALL" query so the class can be leveraged by SQL immediately.
Locate PropertyName In DefaultQueryFields By "AL" Setting Pos Else
Ins PropertyName Before DefaultQueryFields< Pos >
End
* MVBooster sets file class properties up to take advantage of the MVFileAbstraction superclass.
AttributeNumber = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictionaryStructureSubscript, MVDictDefinition, "attrno" )
Type = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictionaryStructureSubscript, MVDictDefinition, "dataType" )
DictType = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictionaryStructureSubscript, MVDictDefinition, "type" )
Gosub RemoveGetSetMethods
Gosub AddGetSetMethods
*
* Indicate that this property was generated by ProtoClass. (MVBooster obeys the same convention.)
*
PropertyReference = $Get( ClassCrossReference( 0, PropertyName ) )
PropertyReference->Parameters->SetAt( "P", "MVAUTO" )
*
* indicate to the second pass that we have processed this dict item
*
%dictionary( CacheDictionaryLocation, "processed" ) = 1
Repeat
*
* Fourth pass for computed properties
*
%MVBTrace->WriteEntry( "Processing computed attribute definitions" )
CacheDictionaryLocation = %MVBCommon->nil
Loop
CacheDictionaryLocation = $Order( %dictionary( CacheDictionaryLocation ) )
While CacheDictionaryLocation <> %MVBCommon->nil DO
If $Get( %dictionary( CacheDictionaryLocation, "processed" ) ) <> %MVBCommon->nil Then Continue
*
* See if this is a 'simple' attribute definition
*
AttributeNumberFromdictionary = $Get( %dictionary( CacheDictionaryLocation, "attrno" ) )
MVDictDefinition = $Get(%dictionary( CacheDictionaryLocation, "name" ) )
If AttributeNumberFromdictionary > MaxRealAttribute Then
* We don't support attributes that high but if there is a correlative that
* accesses other attributes then this could well be a dummy attribute number.
sc = $Get( %dictionary( CacheDictionaryLocation, "attr8bits" ) )
If sc <> 0 Then
* This may well be a dummy attribute number
%dictionary( CacheDictionaryLocation, "attrno" ) = 0
End Else
%MVBTrace->WriteEntry( "Skipping " : MVDictDefinition : " since attribute " : AttributeNumberFromdictionary : " is out of range." )
Continue
End
End
*
* See if we already have a property defined for this DICT item
*
PropertyReference = $Get( ClassCrossReference( 1, MVDictDefinition ) )
If PropertyReference <> %MVBCommon->nil Then
Continue ;* We already have a property for this DICT item
End
*
* Cconstruct a valid property name for this DICT entry
*
PropertyName = "MVBooster.Library"->CamelCase( MVDictDefinition ) ; * use MVBooster's version of camel-case
If $Data( ClassCrossReference( 9, Upcase( PropertyName ) ) ) Or ( UseAsciiHex = @true ) Then
* There is already a property of this name for a different DICT item
* default to the old style ascii hex name
PropertyName = "%SYSTEM.MV"->validCacheName( MVDictDefinition )
If $Data( ClassCrossReference( 9, Upcase( PropertyName ) ) ) Then
%MVBTrace->WriteEntry( "Skipping " : MVDictDefinition : " since name " : PropertyName : " is already in use." )
Continue
End
End
%MVBTrace->WriteEntry( "Creating property called " : PropertyName : " from " : MVDictDefinition )
*Locate PropertyName In DefaultQueryFields By "AL" Setting Pos Else
* Ins PropertyName Before DefaultQueryFields< Pos >
*End
"%SYSTEM.MV"->createMVProperty( PropertyName, CacheDictionaryLocation, ClassDefinition, ClassCrossReference )
AttributeNumber = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictionaryStructureSubscript, MVDictDefinition, "attrno" )
Type = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictionaryStructureSubscript, MVDictDefinition, "dataType" )
DictType = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictionaryStructureSubscript, MVDictDefinition, "type" )
Gosub RemoveGetSetMethods
Gosub AddGetSetMethods
*
* Indicate that this property was generated by ProtoClass
*
PropertyReference = $Get( ClassCrossReference( 0, PropertyName ) )
PropertyReference->Parameters->SetAt( PropertyReference->Parameters->GetAt( "MVAUTO" ) : "P", "MVAUTO" )
If $Get( %MVBFileInfo( Filename, "class", PropertyName, "parameters", "MVTYPE" ) ) = "I" Then
* Override I-type calculations; MVBooster handles this
PropertyReference->Calculated = @true
PropertyReference->SqlComputed = @false
*PropertyReference->SqlComputeCode = "$this." : PropertyName : "Get()"
ClassCrossReference( 0, PropertyName ) = PropertyReference
End
Repeat
*
* Build an XDATA block containing any DICT Items
* that do not represent valid Class Properties but need to be in the DICT
* when a user has decided to use the Class as the master document.
*
If ( GenerateXData = @true ) And ( XDATAList <> %MVBCommon->nil ) Then
xdef = "%Dictionary.XDataDefinition"->%New(className:":MVAdditionalDictItems")
xstream=xdef->Data
xdataCount=1
xstream->WriteLine( '<DictItems>')
Loop
@ID = XDATAList<xdataCount>
xdataCount+=1
While @ID <>%MVBCommon->nil DO
FileDataLevel->DictRead( @ID )
If FileDataLevel->DictRecord = %MVBCommon->nil Then
%MVBTrace->WriteEntry( "DICT entry '" : @ID : "' was not found in " : FileDataLevel->FileName )
Continue
End
xstream->WriteLine( '<DictItem Name="':@ID:'">')
For AttrNo = 1 TO DCOUNT( FileDataLevel->DictRecord, @AM )
%attrData=record<AttrNo>
$XECUTE 'Set %attrData = $ZCVT(%attrData,"O","XML")'
xstream->WriteLine( "<Attr>":%attrData:"</Attr>")
NEXT AttrNo
xstream->WriteLine('</DictItem>')
Repeat
xstream->WriteLine('</DictItems>')
ClassDefinition->XDatas->Insert(xdef)
End
*
* call the method to add methods to implement any Itypes
*
*"%SYSTEM.MV"->generateItypeMethods(ClassDefinition)
*
* If all of the fields are virtual we have a problem in that no storage will be defined
* So add "dummyAttribute" if there aren't any real attributes
*
dummyDef = $Get( ClassCrossReference( 0, "dummyAttribute" ) )
If dummyDef = %MVBCommon->nil Then
If $Order( ClassCrossReference( 2, %MVBCommon->nil ) ) = %MVBCommon->nil Then
PropertyName = ClassDefinition->Name : ":dummyAttribute"
rdef = "%Dictionary.PropertyDefinition"->%New( PropertyName )
rdef->Parameters->SetAt( "0", "MVPROJECTED" )
rdef->Parameters->SetAt( "1", "MVATTRIBUTE")
rdef->Type = "%String"
ClassDefinition->Properties->Insert( rdef )
Locate PropertyName In DefaultQueryFields By "AL" Setting Pos Else
Ins PropertyName Before DefaultQueryFields< Pos >
End
Gosub RemoveGetSetMethods
Gosub AddGetSetMethods
End
End Else
If $Order( ClassCrossReference( 2, %MVBCommon->nil ) ) <> %MVBCommon->nil Then
* We now have real attributes defined so
* now delete the Dummy attribute that was already there
ClassDefinition->Properties->Remove( dummyDef )
End
End
*
* Make sure settings are right for MVBooster
*
ClassDefinition->Parameters->SetAt( 1, "MVREPOPULATE" ) ; * update the DICT from now on
ClassDefinition->Parameters->SetAt( 0, "MVCLEARDICT" ); * leave current DICT items in place
ClassDefinition->Parameters->SetAt( 0, "MVAUTOLOCK" ); * let MVBooster manage locks
ClassDefinition->Super = "%Persistent, %MV.Adaptor, MVBooster.MVFileAbstraction" ; * leverage MVBooster
ClassDefinition->Language = "mvbasic"
MethodNumber = %MVBCommon->nil
Loop
MethodNumber = ClassDefinition->Methods->Next( MethodNumber )
Until MethodNumber = %MVBCommon->nil Do
M = ClassDefinition->Methods->GetAt( MethodNumber )
If %MVBDebugging = @true Then %MVBTrace->WriteEntry( "Found method" : MethodNumber : " " : M->Name )
If M->Name = "%OnNew" Then
ClassDefinition->Methods->RemoveAt( MethodNumber )
End
Repeat
* Build the %OnNew method for this property that will use MVBooster.MVFileAbstraction methods inherited by the new class
NewMethod = "%Dictionary.MethodDefinition"->%New(CompleteClassName : ":%OnNew" )
NewMethod->ClassMethod = @false ; * this is an instance method
NewMethod->Language = "mvbasic"
NewMethod->ReturnType = "%Status"
NewMethod->FormalSpec = "WorkSilently:%Boolean = 0,ReadOnly:%Boolean = 0"
StringBuilder = "%GlobalCharacterStream"->%New() ; * build the body of the method in here
StringBuilder->WriteLine( \Return @ME->New( @ME->%GetParameter("MVFILENAME" ), WorkSilently, ReadOnly )\ )
NewMethod->Implementation = StringBuilder
ClassDefinition->Methods->Insert( NewMethod )
Gosub AddDefaultQuery
$Kill StringBuilder ; * destroy the method definition code builder so the variable can be reused
$Kill NewMethod ; * destroy the method definition so it will be clean on the next loop through here
*
* Now we can save the class
*
If %MVBDebugging Then
%MVBTrace->WriteEntry( "Saving the generated class..." )
End
sc = ClassDefinition->%Save()
If sc[1,1] = 0 Then
"MVBooster.Library"->SetCondition( 101, "Class save ended with errors.", "MVBooster.Protoclass" )
%MVBTrace->WriteError()
"%SYSTEM.MV"->decomposeStatus(sc)
Return
End Else
* Save was good, so now to compile it.
%MVBTrace->WriteEntry( "Compiling the generated class..." )
sc = "%SYSTEM.OBJ"->Compile(ClassDefinition->Name, "cfvko3")
If sc[1,1] = 0 Then
"MVBooster.Library"->SetCondition( 102, "Class compilation ended with errors.", "MVBooster.Protoclass" )
%MVBTrace->WriteError()
*"%SYSTEM.MV"->decomposeStatus(sc)
Return
End
End
%MVBTrace->WriteEntry( "Class generation and compilation was successful!" )
"MVBooster.Library"->ClearConditions()
Return
RemoveGetSetMethods:
* Okay, there was a property with a matching name. There is likely a Get() and Set() method as well.
NextMethod = %MVBCommon->nil
Loop
NextMethod = ClassDefinition->Methods->Next( NextMethod )
Until NextMethod = %MVBCommon->nil Do
ExistingMethod = ClassDefinition->Methods->GetAt( NextMethod )
If ( ExistingMethod->Name = PropertyName : "Set" ) Or ( ExistingMethod->Name = PropertyName : "Get" ) Then
ClassDefinition->Methods->RemoveAt( NextMethod )
End
Repeat
Return
AddGetSetMethods:
* The property is set up. MVBooster has its own mechanism for handling file update and
* retrieval. You can go back and customize each Set() method to enforce data integrity
* and each Get() method for data shaping.
* Build the Get() method for this property that will use MVBooster.MVFileAbstraction methods inherited by the new class
GetMethod = "%Dictionary.MethodDefinition"->%New(CompleteClassName : ":" : PropertyName : "Get" )
GetMethod->ClassMethod = @false ; * this is an instance method
GetMethod->Language = "mvbasic"
GetMethod->ReturnType = Type ; * same as the property type
StringBuilder = "%GlobalCharacterStream"->%New() ; * build the body of the method in here
StringBuilder->WriteLine( "theRecord = @ME->Record" )
If AttributeNumber Matches "1N0N" Then
StringBuilder->WriteLine( "return theRecord<" : AttributeNumber : ">" )
End Else ; * it's an I-type formula
Formula = EReplace( AttributeNumber, "@ID", "@ME->Key" )
Formula = EReplace( AttributeNumber, "@RECORD", "@ME->Record" )
StringBuilder->WriteLine( "Result = " : Formula )
StringBuilder->WriteLine( "return Result" )
End
GetMethod->Implementation = StringBuilder
ClassDefinition->Methods->Insert( GetMethod )
$Kill StringBuilder ; * destroy the method definition code builder so the variable can be reused
$Kill GetMethod ; * destroy the method definition so it will be clean on the next loop through here
* Build the Set() method for this property. It will also use methods and properties inherited from the MVBooster.MVFileAbstraction class
SetMethod = "%Dictionary.MethodDefinition"->%New(CompleteClassName : ":" : PropertyName : "Set" )
SetMethod->ClassMethod = @false ; * this is also an instance method
SetMethod->Language = "mvbasic"
SetMethod->ReturnType = "%Status"
SetMethod->FormalSpec = "Value:" : Type
StringBuilder = "%GlobalCharacterStream"->%New() ; * build the body of the method in here
If DictType <> "I" Then
* You'll need to go back into the class and add your own data integrity enforcement code if it's needed
StringBuilder->WriteLine( "@ME->SetAttribute( " : AttributeNumber : ", Value )" )
StringBuilder->WriteLine( \Return "%SYSTEM.Status"->OK()\ )
End Else
StringBuilder->WriteLine( \Return "%SYSTEM.Status"->Error( 0, "Cannot set a virtual type." )\ )
SetMethod->Private = 1
End
SetMethod->Implementation = StringBuilder
ClassDefinition->Methods->Insert( SetMethod )
$Kill StringBuilder
$Kill SetMethod
"MVBooster.Library"->ClearConditions()
Return
AddDefaultQuery:
* Add a default "ALL" query. Remove any existing before replacing.
NextQuery = %MVBCommon->nil
Loop
NextQuery = ClassDefinition->Queries->Next( NextQuery )
Until NextQuery = %MVBCommon->nil Do
ExistingQuery = ClassDefinition->Queries->GetAt( NextQuery )
If %MVBDebugging = @true Then %MVBTrace->WriteEntry( "Found query " : ExistingQuery->Name : "; removing." )
If Upcase( ExistingQuery->Name ) = "ALL" Then
ClassDefinition->Queries->RemoveAt( NextQuery )
*Exit ; * there'll only be one
End
Repeat
NewQuery = "%Dictionary.QueryDefinition"->%New()
NewQuery->Name = "All"
NewQuery->SqlQuery = "SELECT " : Convert( @fm, ',', DefaultQueryFields ) : " FROM " : Filename : " ORDER BY %ID "
NewQuery->Type = "%SQLQuery"
NewQuery->Parameters->SetAt( 1, "CONTAINID" )
ClassDefinition->Queries->Insert( NewQuery )
Return
} The routine that calls the ClassMethod MVBProtoclass
0001 Program MVBProtoclass
0002 #Pragma RoutineName = MVBProtoclass
0003
0004 * Create or update an MVBooster file class from the DICT of a file in the VOC.
0005 * Switches:
0006 * -File filespec Designates the file in the VOC whose DICT will be used
0007 * -DELete Delete any existing class for this file
0008 * -P packagespec designates the package name into which this file class
0009 * should be categorized. If this switch is missing, then
0010 * the package "MVFile" is used. If the designated package
0011 * name does not yet exist, it will be automatically created.
0012 * This simplifies mapping and exposing files by application
0013 * type or suite.
0014 * -MAXrealattribute The highest A/AMC of a "real" (not calculated) A or S type.
0015 * Defaults to 8999 (Pick used 9000 and above.)
0016 * -Xdata Create an XData section for MVRepopulate
0017 *
0018 * The MVBooster debugging switches may also be used.
0019
0020 *
0021 * Make sure the catalog pointer was modified to make this a TCL2 verb
0022 *
0023 *FINDSTR "2D" IN $Get(%parseControl) SETTING LINT Else ABORT 445, "PROTOCLASS":@VM:"D"
0024
0025 MaxDefault = 8999 ; * Default maximum "real" attribute. Any DICT item with a greater A/AMC will be considered a ca
lculation.
0026
0027 %MVBCommon = "MVBooster.Common"->%New()
0028 %MVBCommon->Setup()
0029 %MVBCommon->SetSwitchesFromCommandLine()
0030
0031 * Was the file switch "-F" specified?
0032 FindStr "-F" In %MVBTokenizedSentence Setting Pos Else
0033 %MVBTrace->WriteEntry( "Use the -F filespec argument to specify which file wants a class built." )
0034 Stop
0035 End
0036
0037 Filename = %MVBTokenizedSentence< Pos + 1 >
0038
0039 Dim %MVBFileInfo() ; * access the Cache' array for MV Booster file info
0040 "MVBooster.Library"->FileInfo( Filename )
0041
0042 If $Get( %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoFilePropertiesSubscript, %MVBCommon->MVBFileHandle ) ) = %MVBCommon
->nil Then 0043 %MVBTrace->WriteEntry( "No file named " : DQuote( Filename ) : " can be opened from the VOC." )
0044 Stop
0045 End
0046
0047 FileDataLevel = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoFilePropertiesSubscript )
0048 FileDataLevel->OpenDict()
0049 FileDictLevel = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictPropertiesSubscript )
0050
0051 If %MVBDebugging Then
0052 $Xecute " zw %MVBFileInfo(" : DQuote( Filename ) : ")"
0053 End
0054
0055 FindStr "-DEL" In %MVBTokenizedSentence Setting Pos Then
0056 DeleteExistingClass = @true
0057 End Else
0058 DeleteExistingClass = @false
0059 End
0060
0061 FindStr "-P" In %MVBTokenizedSentence Setting Pos Then
0062 PackageName = %MVBTokenizedSentence< Pos + 1 >
0063 End Else
0064 PackageName = %MVBCommon->nil
0065 End
0066
0067 FindStr "-MAX" In %MVBTokenizedSentence Setting Pos Then
0068 MaxRealAttribute = %MVBTokenizedSentence< Pos + 1 >
0069 If Not( MaxRealAttribute Matches "1N0N" ) Then MaxRealAttribute = MaxDefault
0070 End Else
0071 MaxRealAttribute = MaxDefault
0072 End
0073
0074 FindStr "-X" In %MVBTokenizedSentence Setting Pos Then
0075 GenerateXDATA = @true
0076 End Else
0077 GenerateXDATA = @false
0078 End
0079
0080 CompleteClassName = PackageName : "." : Filename
0081 DefaultQueryFields = %MVBCommon->nil
0082
0083 "MVBooster.Library"->Protoclass( Filename, PackageName, DeleteExistingClass, GenerateXData, MaxRealAttribute )
0084
0085 Return
0086
0087 ************************************
The short answer is "you certainly can". The longer answer is a bit more complicated due to the fact that I did a custom Protoclass based on the latest PROTOCLASS MVB code. I don't know at which version this came out in. I've been using 2012.1 field test which unfortunately expired this morning. You can accomplish the same goal in either version by finding the section in your version that sets parameters for individual properties. A good string to search for in your code would be "MVBATTRIBUTE" since that gets set in either version. You can add some code to look in %dictionary to find the MV attribute you want and look at the DICT properties underneath that to grab the length and add a MAXLENGTH parameter to your property.
The quickest thing I could advise is to run PROTOCLASS on a scratch file that has dictionary items (you can always delete the file and class right after), then at the command line type
USER> [ zw %dictionary
Then you can see the structure of %dictionary. This array gets built by a parseDict call in the code and persists after you run PROTOCLASS. It's not quite as complicated as it seems.
I'm enclosing my custom class and the routine that runs it. The stock PROTOCLASS says "modify the code", so I did exactly that :)
Best regards,
Bill
The library ClassMethod:
ClassMethod Protoclass(Filename As %String = "", PackageName As %String = "MVFile", DeleteExistingClass As %Boolean = 0, GenerateXData As %Boolean = 1, MaxRealAttribute As %Integer = 8999)
{
If $Get( %MVBCommon ) = "" Then %MVBCommon = "MVBooster.Common"->%New()
CompleteClassName = PackageName : "." : Filename
DefaultQueryFields = %MVBCommon->nil
************************************
* PROTOCLASS.mvb
*
* Creates the verb PROTOCLASS which the shell will also find
* if it is called as PROTOCLASS.
*
* This MVBASIC program shows how to parse the dictionary of an MV
* file and use some or all of the DICT elements to create a Cache' class
* definition. The class is then compiled and is available in the namespace/class
* whence the program was run. It also serves as a useful example of how to utilize
* standard Cache' classes, as this is what it uses to build the class definition.
*
* A class is first defined and saved, which produces a class that can then be edited
* using Cache' studio, then it is compiled, which is then the basis for all other
* projections such as SQL tables.
*
* Because no one set of files is defined in the same way as any other, you are free
* to make copies of this program and modify it to suit your own application requirements.
*
* +--------------------------------------------------------+
* | Copyright 2007-2009 by InterSystems Corporation, |
* | Cambridge, Massachusetts, U.S.A. |
* | All rights reserved. |
* | |
* | Confidential, unpublished property of InterSystems. |
* | |
* | This media contains an authorized copy or copies |
* | of material copyrighted by InterSystems and is the |
* | confidential, unpublished property of InterSystems. |
* | This copyright notice and any other copyright notices |
* | included in machine readable copies must be reproduced |
* | on all authorized copies. |
* +--------------------------------------------------------+
*
*
* Declare some global (cross program) variables that are
* multivalued in the Cache' sense, not just the standard MV style.
* To do this we DIM the variables, but do not supply any dimensions
* which tells the compiler that it is a standard COS style variable
* that needs no dimension sizing and just works.
*
* jwwf - Obviously this is a highly-modified version that works with MVBooster.
* I left the original InterSystems copyright intact.
*
DIM %dictionary()
Dim %MVBFileInfo() ; * utilize the MVBooster file information structure
* Now some variables that are only local to this program
DIM ClassCrossReference()
UseAsciiHex = 0
*
* Parse the command line. We have access to MV TCL II processing
* through the %SYSTEM.MV class, and so we do not need to program
* all of that in BASIC. Note, that you can produce the list of
* DICTionary elements to process in any way you choose, then just call
* the parseDict() method as below to add it to the %dictionary() multilevel
* array.
"MVBooster.Library"->FileInfo( Filename )
If Status() <> %MVBCommon->successful Then
%MVBTrace->WriteError()
Return
End
FileDataLevel = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoFilePropertiesSubscript )
FileDataLevel->OpenDict()
FileDictLevel = FileDataLevel->DictHandle
* We must not run protoclass against system globals
If FileDataLevel->FileHandle->%Global[1,1]= "%" Then ABORT 446,fileName
* We must not run protoclass from a different account
If FileDataLevel->FileHandle->%TargetAccount <> FileDataLevel->FileHandle->%Account Then
%MVBTrace->WriteEntry( "Protoclass for this file must be run in the ":FileDataLevel->%TargetAccount:" account." )
Stop
End
If FileDataLevel->FileHandle->%StorageType <> 0 Then
%MVBTrace->WriteEntry( "Protoclass can only be used against files stored in globals in inode format." )
Stop
End
*
* Make sure our dictionary tracking structure is clean
*
$KILL %dictionary
%DictNumber = 0
*
* Initialize the list of items to add to XDATA
*
XDATAList = %MVBCommon->nil
*
* Now we can loop on each item ID from the DICTionary and parse
* it into the %dictionary variable. This will make it much easier
* to traverse it multiple times to see what special processing we
* may need to define the class.
*
@ID = %MVBCommon->nil
Loop
@ID = $Order( %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictionaryStructureSubscript, @ID ) )
Until @ID = %MVBCommon->nil Do ; *"%SYSTEM.MV"->TCL2Next() = 1 DO
* One more DICT element was found, read this in from the
* DICT
FileDataLevel->DictRead( @ID )
If FileDataLevel->DictRecord = %MVBCommon->nil Then
%MVBTrace->WriteEntry( "Could not find " : @ID : " in DICT " : Filename )
Continue
End
* Is this a type of DICT entry that this method can handle? Sometimes
* people purposefully or accidentally store things in the DICT that
* should not really be there. These must be filtered out in favor
* of DICT types that can be processed.
Record = FileDataLevel->DictRecord
type = UPCase( Record< 1 >[ 1, 1 ] )
If INDEX("ADSIV", type, 1) <> 0 Then
*
* Test for any specific names not to generate properties for
*
If @ID <> "@ID" Then
* Now parse the entry. There is another %SYSTEM.MV class method
* to call that will do this.
*
"%SYSTEM.MV"->parseDict(FileDictLevel, Record, @ID)
*
* Examine the string in attribute 8
*
pattr8 = $Get( %dictionary( %DictNumber, "attr8" ) )
If pattr8 <> %MVBCommon->nil Then
statusString = "%SYSTEM.MV"->ConvAnalyze(pattr8)
errorTypeCode = FIELD(statusString,",",1)
If errorTypeCode < 0 Then
%MVBTrace->WriteEntry( "DICT entry '":@ID:"' ignored due to errors in dict item." )
%dictionary(%DictNumber,"processed") = 1
Continue
End
* save the bit pattern that indicates the codes found
%dictionary(%DictNumber, "attr8bits") = FIELD(statusString,",",2)
* Save the list of referenced attributes
%dictionary(%DictNumber, "attr8refs") = FIELD(statusString,",",3,999)
End Else
* this would be a reasonable place to setup sqlname
* %dictionary(%DictNumber,"sqlname")=....
End
End
Continue
End
* This block is run when an item can not be processed into an property. If GenerateXData
* is set to @true then add it to the XDATA block, else throw it away.
If GenerateXData = @true Then
XDATAList<-1> = @ID
End Else
%MVBTrace->WriteEntry( "DICT entry '" : @ID : "' ignored." )
End
Repeat
* All manageable DICT items have been parsed. Begin the first phase
* of processing them into class properties.
*
* A Cache' class can only define one class property as being stored
* in the dynamic array. This means that if the dictionary contains
* multiple references to the same attribute, we must create
* a raw entry for the attribute and 'calculate' the value of each
* of the duplicate properties from this value.
*
* In practice, it is not usually a good idea to have duplicate references
* in the class because once the property is calculated, we cannot
* easily determine if the calculation is reversible. Therefore, we
* make such properties read only.
*
* The nature of a SQL table of Cache' Class means that duplicate definitions
* of the same attribute are generally redundant (as formatting and
* so on is performed outside the table/class.) However it is sometimes valid.
* Where there are no duplicates we can refer to the attribute
* directly. The property will then only be calculated if it is subject
* to an Itype or Attribute 8 (referred to as MVTOLOGICAL) transformation.
* (See comments later on these types of transformations...)
*
* Now loop through the parsed dictionary elements and find
* out which are duplicates. We will ignore references to attribute
* 0 as being the Item ID or a calculated field. Furthermore, we will
* assume that fields marked as attribute MaxRealAttribute or higher are also calculated.
* (This is fairly common practice, though highly inefficient
* for various reasons.)
*
* You may need to change the code here to adapt it to the practices
* at your own site.
** Note: (JWWF) That's exactly what I did with the entire routine.
*
* See if we have a class for this file already
*
ClassDefinition = "%SYSTEM.MV"->getPrimaryMVClass( FileDataLevel->FileHandle, 0, %MVBCommon->nil )
*
* If desired we can delete the existing class and start from scratch. The DeleteExistingClass
* argument in the formal spec controls this. (It defaults to @false.)
*
If DeleteExistingClass = @true Then
If ClassDefinition <> %MVBCommon->nil Then ClassToDelete = ClassDefinition->Name Else ClassToDelete = CompleteClassName
"%Dictionary.ClassDefinition"->%DeleteId( ClassToDelete ) ; * delete the class object
"%ExtentMgr.Util"->DeleteExtentDefinition( ClassToDelete ) ; * also delete the definition else the rest of this method may go awry.
ClassDefinition = %MVBCommon->nil
End
If ClassDefinition= %MVBCommon->nil Then
* Create the primary MV class for the file. The name comes from a concatenation of
* the package name (supplied in the formal spec), a period, and the class name (also
* in the formal spec).
ClassDefinition = "%SYSTEM.MV"->getPrimaryMVClass( FileDataLevel->FileHandle, 1, CompleteClassName )
End
* Extract the unqualified classname: the last '.' delimited substring
className = FIELD( ClassDefinition->Name, ".", DCOUNT(ClassDefinition->Name, "." ) )
properties = ClassDefinition->Properties
* Now Build a cross refrence array of any existing properties that will make updating
* the class a lot easier. This will be empty for a new class and is updated every
* time we add or modify a property.
*
* The layout is: ClassCrossReference(sub1,sub2) = value
* where the subscripts are:
* sub1 sub2 value
* 0 property name property object
* 1 Dict Name " "
* 2 Attr No " " This is the primary definition for that attr
* 3 property name index object
* 4 Dict Name %MVBCommon->nil %MVBCommon->nil
* 5 storage.attrNo proPropertyName in storage
* 6 storage.proPropertyName value object in storage
* 7 Values Object in storage
* 8 attrNo,proPropertyName property object - other definitions for this attribute
* 9 upcased name true case name
* 10 1 1 if class locked against MV verb updates
"%SYSTEM.MV"->buildMVClassXref( ClassDefinition, ClassCrossReference )
*
* Check to see if this class has been locked to prevent unintentional
* modification
*
If $Get( ClassCrossReference( 10, 1 ) ) = 1 Then
"MVBooster.Library"->SetCondition( 104, CompleteClassName : " has been locked against automatic updates.", "MVBooster.Library->Protoclass" )
Return
End
*
* First Pass: Compare the dict items we have with the current class
*
CacheDictionaryLocation = %MVBCommon->nil
Loop
CacheDictionaryLocation = $Order( %dictionary( CacheDictionaryLocation ) )
While CacheDictionaryLocation <> %MVBCommon->nil Do
If $Get( %dictionary( CacheDictionaryLocation, "processed" ) ) <> %MVBCommon->nil Then Continue
*
* See if we already have a property defined for this DICT item
*
MVDictDefinition = $Get( %dictionary( CacheDictionaryLocation, "name" ) )
PropertyReference = $Get( ClassCrossReference( 1, MVDictDefinition ) )
If PropertyReference = %MVBCommon->nil Then
Continue
End
* We already have a property for this DICT item
* Look for any major changes
If $Get( %dictionary(CacheDictionaryLocation, "attrno" ) ) <> PropertyReference->Parameters->GetAt( "MVATTRIBUTE" ) Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "attr8" ) ) <> PropertyReference->Parameters->GetAt( "MVTOLOGICAL" ) Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "itypeSource" ) ) <> PropertyReference->Parameters->GetAt( "MVITYPE" ) Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "sqlname" ) ) <> PropertyReference->SqlFieldName Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "dataType" ) ) <> PropertyReference->Type Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "mv" ) ) = "M" And PropertyReference->Collection <> "list" Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "mv" ) ) <> "M" And PropertyReference->Collection = "list" Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "assoc" ) ) <> PropertyReference->Parameters->GetAt( "MVASSOCIATION" ) Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "svassoc" ) ) <> PropertyReference->Parameters->GetAt( "MVSVASSOCIATION" ) Then Continue
If $Get( %dictionary(CacheDictionaryLocation, "justification" ) ) = "R" And $Get( %dictionary( CacheDictionaryLocation, "dataType" ) ) = "%String" Then
If PropertyReference->Parameters->GetAt( "COLLATION" ) <> "MVR" Then Continue
End Else
If PropertyReference->Parameters->GetAt( "COLLATION" ) = "MVR" Then Continue
End
*
* Handle any minor changes here
*
If $Get( %dictionary(CacheDictionaryLocation, "conv" ) ) <> PropertyReference->Parameters->GetAt( "MVTODISPLAY" ) Then
PropertyReference->Parameters->SetAt( $Get( %dictionary( CacheDictionaryLocation,"conv" ) ), "MVTODISPLAY" )
End
If $Get( %dictionary(CacheDictionaryLocation, "type" ) ) <> PropertyReference->Parameters->GetAt( "MVTYPE" ) Then
PropertyReference->Parameters->SetAt( $Get( %dictionary( CacheDictionaryLocation, "type" ) ), "MVTYPE" )
End
If $Get( %dictionary( CacheDictionaryLocation, "heading" ) ) <> PropertyReference->Parameters->GetAt( "MVHEADING" ) Then
PropertyReference->Parameters->SetAt( $Get( %dictionary( CacheDictionaryLocation, "heading" ) ), "MVHEADING" )
End
If $Get( %dictionary( CacheDictionaryLocation, "width" ) ) <> PropertyReference->Parameters->GetAt( "MVWIDTH" ) Then
PropertyReference->Parameters->SetAt( $Get( %dictionary( CacheDictionaryLocation,"width" ) ), "MVWIDTH" )
End
If $Get( %dictionary( CacheDictionaryLocation, "format" ) ) <> PropertyReference->Parameters->GetAt("MVFORMAT") Then
PropertyReference->Parameters->SetAt( $Get( %dictionary( CacheDictionaryLocation, "format" ) ) ,"MVFORMAT" )
End
*
* Consider this one processed
*
%dictionary( CacheDictionaryLocation, "processed" ) = 1
*
* Mark that Protoclass would have generated this if it hadn't already existed
*
MVAuto = PropertyReference->Parameters->GetAt( "MVAUTO" )
If Count( MVAuto, "P") = 0 Then PropertyReference->Parameters->SetAt( MVAuto : "P", "MVAUTO" )
Repeat
*
* Second Pass - delete those properties that we can replace
*
CacheDictionaryLocation = %MVBCommon->nil
Loop
CacheDictionaryLocation = $Order( %dictionary( CacheDictionaryLocation ) )
While CacheDictionaryLocation <> %MVBCommon->nil DO
If $Get( %dictionary( CacheDictionaryLocation, "processed" ) ) <> %MVBCommon->nil Then Continue
MVDictDefinition = $Get( %dictionary( CacheDictionaryLocation, "name" ) )
PropertyReference = $Get( ClassCrossReference( 1, MVDictDefinition ) )
If PropertyReference = %MVBCommon->nil Then Continue
*
* See if we are permitted to modify this property
*
MVAuto = PropertyReference->Parameters->GetAt( "MVAUTO" )
PropertyName = PropertyReference->Name
Begin Case
Case MVAuto = "P"
* this property was generated by protoclass
%MVBTrace->WriteEntry( "Deleting property " : PropertyName : " for replacement" )
"%SYSTEM.MV"->deleteMVProperty( PropertyName, ClassDefinition, ClassCrossReference )
* MVBooster makes class properties with custom get/set methods. If those exist, remove them along
* with the property to which they're attached.
Gosub RemoveGetSetMethods
Continue
Case COUNT (MVAuto, "I ") > 0
%MVBTrace->WriteEntry( "Property " : PropertyName : " cannot be modified until all indexes based on it are deleted" )
Case COUNT( MVAuto, "R" ) > 0
%MVBTrace->WriteEntry( "Property " : PropertyName : " cannot be modified because other properies are based on it" )
Case 0
%MVBTrace->WriteEntry( "Property " : PropertyName : " cannot be modified because it is not tagged as Protoclass generated" )
End Case
*
* indicate that we have processed this dict item
*
%dictionary( CacheDictionaryLocation, "processed" ) = 1
Repeat
* Third pass - process the simple attributes
* then later we will process the calculated attributes
* This allows the createProperty routine to base the complex properties on
* the simple properties.
%MVBTrace->WriteEntry( "Processing simple attribute definitions" )
CacheDictionaryLocation = %MVBCommon->nil
Loop
CacheDictionaryLocation = $Order( %dictionary( CacheDictionaryLocation ) )
While CacheDictionaryLocation <> %MVBCommon->nil Do
If $Get( %dictionary( CacheDictionaryLocation, "processed" ) ) <> %MVBCommon->nil Then Continue
*
* See if this is a 'simple' attribute definition
*
If ( $Get( %dictionary( CacheDictionaryLocation, "attr8" ) ) <> %MVBCommon->nil ) Or ( $Get( %dictionary(CacheDictionaryLocation, "itypeSource" ) ) <> %MVBCommon->nil ) Then Continue
AttributeNumberFromdictionary = $Get( %dictionary( CacheDictionaryLocation, "dataType" ) )
If ( AttributeNumberFromdictionary = %MVBCommon->nil ) Or ( AttributeNumberFromdictionary = 0 ) Or ( AttributeNumberFromdictionary > MaxRealAttribute ) Then Continue
MVDictDefinition = $Get( %dictionary( CacheDictionaryLocation, "name" ) )
PropertyReference = $Get( ClassCrossReference( 1, MVDictDefinition ) )
If PropertyReference <> %MVBCommon->nil Then Continue
*
* Let's construct a valid property name for this DICT entry
*
PropertyName = "MVBooster.Library"->CamelCase( MVDictDefinition ) ; * use custom CamelCase, not ISC's
*
* Override the collation if we need to.
* Properties with a type of %string will default to 'space' collation
* but if we intend to index this field, it is safer to use a length limitted collation
* like SqlString(150) to avoid errors with invalid data. You may find that defaulting
* to SqlString(150) then adjusting those properties that might possibly exceed
* 150 characters works best for you.
*
If $Get( %dictionary( CacheDictionaryLocation, "dataType" ) ) = "%String" And $Get(%dictionary(CacheDictionaryLocation,"justification"))<>"R" Then
* %dictionary(CacheDictionaryLocation,"collation")="SqlString(150)"
End
*
* Create the property
* This function takes care of the creation of the property
* You can make any modifications you need after it is created
*
%MVBTrace->WriteEntry( "Creating property called " : PropertyName : " from " : MVDictDefinition )
"%SYSTEM.MV"->createMVProperty( PropertyName, CacheDictionaryLocation, ClassDefinition, ClassCrossReference )
* MVBooster sets up a default "ALL" query so the class can be leveraged by SQL immediately.
Locate PropertyName In DefaultQueryFields By "AL" Setting Pos Else
Ins PropertyName Before DefaultQueryFields< Pos >
End
* MVBooster sets file class properties up to take advantage of the MVFileAbstraction superclass.
AttributeNumber = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictionaryStructureSubscript, MVDictDefinition, "attrno" )
Type = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictionaryStructureSubscript, MVDictDefinition, "dataType" )
DictType = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictionaryStructureSubscript, MVDictDefinition, "type" )
Gosub RemoveGetSetMethods
Gosub AddGetSetMethods
*
* Indicate that this property was generated by ProtoClass. (MVBooster obeys the same convention.)
*
PropertyReference = $Get( ClassCrossReference( 0, PropertyName ) )
PropertyReference->Parameters->SetAt( "P", "MVAUTO" )
*
* indicate to the second pass that we have processed this dict item
*
%dictionary( CacheDictionaryLocation, "processed" ) = 1
Repeat
*
* Fourth pass for computed properties
*
%MVBTrace->WriteEntry( "Processing computed attribute definitions" )
CacheDictionaryLocation = %MVBCommon->nil
Loop
CacheDictionaryLocation = $Order( %dictionary( CacheDictionaryLocation ) )
While CacheDictionaryLocation <> %MVBCommon->nil DO
If $Get( %dictionary( CacheDictionaryLocation, "processed" ) ) <> %MVBCommon->nil Then Continue
*
* See if this is a 'simple' attribute definition
*
AttributeNumberFromdictionary = $Get( %dictionary( CacheDictionaryLocation, "attrno" ) )
MVDictDefinition = $Get(%dictionary( CacheDictionaryLocation, "name" ) )
If AttributeNumberFromdictionary > MaxRealAttribute Then
* We don't support attributes that high but if there is a correlative that
* accesses other attributes then this could well be a dummy attribute number.
sc = $Get( %dictionary( CacheDictionaryLocation, "attr8bits" ) )
If sc <> 0 Then
* This may well be a dummy attribute number
%dictionary( CacheDictionaryLocation, "attrno" ) = 0
End Else
%MVBTrace->WriteEntry( "Skipping " : MVDictDefinition : " since attribute " : AttributeNumberFromdictionary : " is out of range." )
Continue
End
End
*
* See if we already have a property defined for this DICT item
*
PropertyReference = $Get( ClassCrossReference( 1, MVDictDefinition ) )
If PropertyReference <> %MVBCommon->nil Then
Continue ;* We already have a property for this DICT item
End
*
* Cconstruct a valid property name for this DICT entry
*
PropertyName = "MVBooster.Library"->CamelCase( MVDictDefinition ) ; * use MVBooster's version of camel-case
If $Data( ClassCrossReference( 9, Upcase( PropertyName ) ) ) Or ( UseAsciiHex = @true ) Then
* There is already a property of this name for a different DICT item
* default to the old style ascii hex name
PropertyName = "%SYSTEM.MV"->validCacheName( MVDictDefinition )
If $Data( ClassCrossReference( 9, Upcase( PropertyName ) ) ) Then
%MVBTrace->WriteEntry( "Skipping " : MVDictDefinition : " since name " : PropertyName : " is already in use." )
Continue
End
End
%MVBTrace->WriteEntry( "Creating property called " : PropertyName : " from " : MVDictDefinition )
*Locate PropertyName In DefaultQueryFields By "AL" Setting Pos Else
* Ins PropertyName Before DefaultQueryFields< Pos >
*End
"%SYSTEM.MV"->createMVProperty( PropertyName, CacheDictionaryLocation, ClassDefinition, ClassCrossReference )
AttributeNumber = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictionaryStructureSubscript, MVDictDefinition, "attrno" )
Type = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictionaryStructureSubscript, MVDictDefinition, "dataType" )
DictType = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictionaryStructureSubscript, MVDictDefinition, "type" )
Gosub RemoveGetSetMethods
Gosub AddGetSetMethods
*
* Indicate that this property was generated by ProtoClass
*
PropertyReference = $Get( ClassCrossReference( 0, PropertyName ) )
PropertyReference->Parameters->SetAt( PropertyReference->Parameters->GetAt( "MVAUTO" ) : "P", "MVAUTO" )
If $Get( %MVBFileInfo( Filename, "class", PropertyName, "parameters", "MVTYPE" ) ) = "I" Then
* Override I-type calculations; MVBooster handles this
PropertyReference->Calculated = @true
PropertyReference->SqlComputed = @false
*PropertyReference->SqlComputeCode = "$this." : PropertyName : "Get()"
ClassCrossReference( 0, PropertyName ) = PropertyReference
End
Repeat
*
* Build an XDATA block containing any DICT Items
* that do not represent valid Class Properties but need to be in the DICT
* when a user has decided to use the Class as the master document.
*
If ( GenerateXData = @true ) And ( XDATAList <> %MVBCommon->nil ) Then
xdef = "%Dictionary.XDataDefinition"->%New(className:":MVAdditionalDictItems")
xstream=xdef->Data
xdataCount=1
xstream->WriteLine( '<DictItems>')
Loop
@ID = XDATAList<xdataCount>
xdataCount+=1
While @ID <>%MVBCommon->nil DO
FileDataLevel->DictRead( @ID )
If FileDataLevel->DictRecord = %MVBCommon->nil Then
%MVBTrace->WriteEntry( "DICT entry '" : @ID : "' was not found in " : FileDataLevel->FileName )
Continue
End
xstream->WriteLine( '<DictItem Name="':@ID:'">')
For AttrNo = 1 TO DCOUNT( FileDataLevel->DictRecord, @AM )
%attrData=record<AttrNo>
$XECUTE 'Set %attrData = $ZCVT(%attrData,"O","XML")'
xstream->WriteLine( "<Attr>":%attrData:"</Attr>")
NEXT AttrNo
xstream->WriteLine('</DictItem>')
Repeat
xstream->WriteLine('</DictItems>')
ClassDefinition->XDatas->Insert(xdef)
End
*
* call the method to add methods to implement any Itypes
*
*"%SYSTEM.MV"->generateItypeMethods(ClassDefinition)
*
* If all of the fields are virtual we have a problem in that no storage will be defined
* So add "dummyAttribute" if there aren't any real attributes
*
dummyDef = $Get( ClassCrossReference( 0, "dummyAttribute" ) )
If dummyDef = %MVBCommon->nil Then
If $Order( ClassCrossReference( 2, %MVBCommon->nil ) ) = %MVBCommon->nil Then
PropertyName = ClassDefinition->Name : ":dummyAttribute"
rdef = "%Dictionary.PropertyDefinition"->%New( PropertyName )
rdef->Parameters->SetAt( "0", "MVPROJECTED" )
rdef->Parameters->SetAt( "1", "MVATTRIBUTE")
rdef->Type = "%String"
ClassDefinition->Properties->Insert( rdef )
Locate PropertyName In DefaultQueryFields By "AL" Setting Pos Else
Ins PropertyName Before DefaultQueryFields< Pos >
End
Gosub RemoveGetSetMethods
Gosub AddGetSetMethods
End
End Else
If $Order( ClassCrossReference( 2, %MVBCommon->nil ) ) <> %MVBCommon->nil Then
* We now have real attributes defined so
* now delete the Dummy attribute that was already there
ClassDefinition->Properties->Remove( dummyDef )
End
End
*
* Make sure settings are right for MVBooster
*
ClassDefinition->Parameters->SetAt( 1, "MVREPOPULATE" ) ; * update the DICT from now on
ClassDefinition->Parameters->SetAt( 0, "MVCLEARDICT" ); * leave current DICT items in place
ClassDefinition->Parameters->SetAt( 0, "MVAUTOLOCK" ); * let MVBooster manage locks
ClassDefinition->Super = "%Persistent, %MV.Adaptor, MVBooster.MVFileAbstraction" ; * leverage MVBooster
ClassDefinition->Language = "mvbasic"
MethodNumber = %MVBCommon->nil
Loop
MethodNumber = ClassDefinition->Methods->Next( MethodNumber )
Until MethodNumber = %MVBCommon->nil Do
M = ClassDefinition->Methods->GetAt( MethodNumber )
If %MVBDebugging = @true Then %MVBTrace->WriteEntry( "Found method" : MethodNumber : " " : M->Name )
If M->Name = "%OnNew" Then
ClassDefinition->Methods->RemoveAt( MethodNumber )
End
Repeat
* Build the %OnNew method for this property that will use MVBooster.MVFileAbstraction methods inherited by the new class
NewMethod = "%Dictionary.MethodDefinition"->%New(CompleteClassName : ":%OnNew" )
NewMethod->ClassMethod = @false ; * this is an instance method
NewMethod->Language = "mvbasic"
NewMethod->ReturnType = "%Status"
NewMethod->FormalSpec = "WorkSilently:%Boolean = 0,ReadOnly:%Boolean = 0"
StringBuilder = "%GlobalCharacterStream"->%New() ; * build the body of the method in here
StringBuilder->WriteLine( \Return @ME->New( @ME->%GetParameter("MVFILENAME" ), WorkSilently, ReadOnly )\ )
NewMethod->Implementation = StringBuilder
ClassDefinition->Methods->Insert( NewMethod )
Gosub AddDefaultQuery
$Kill StringBuilder ; * destroy the method definition code builder so the variable can be reused
$Kill NewMethod ; * destroy the method definition so it will be clean on the next loop through here
*
* Now we can save the class
*
If %MVBDebugging Then
%MVBTrace->WriteEntry( "Saving the generated class..." )
End
sc = ClassDefinition->%Save()
If sc[1,1] = 0 Then
"MVBooster.Library"->SetCondition( 101, "Class save ended with errors.", "MVBooster.Protoclass" )
%MVBTrace->WriteError()
"%SYSTEM.MV"->decomposeStatus(sc)
Return
End Else
* Save was good, so now to compile it.
%MVBTrace->WriteEntry( "Compiling the generated class..." )
sc = "%SYSTEM.OBJ"->Compile(ClassDefinition->Name, "cfvko3")
If sc[1,1] = 0 Then
"MVBooster.Library"->SetCondition( 102, "Class compilation ended with errors.", "MVBooster.Protoclass" )
%MVBTrace->WriteError()
*"%SYSTEM.MV"->decomposeStatus(sc)
Return
End
End
%MVBTrace->WriteEntry( "Class generation and compilation was successful!" )
"MVBooster.Library"->ClearConditions()
Return
RemoveGetSetMethods:
* Okay, there was a property with a matching name. There is likely a Get() and Set() method as well.
NextMethod = %MVBCommon->nil
Loop
NextMethod = ClassDefinition->Methods->Next( NextMethod )
Until NextMethod = %MVBCommon->nil Do
ExistingMethod = ClassDefinition->Methods->GetAt( NextMethod )
If ( ExistingMethod->Name = PropertyName : "Set" ) Or ( ExistingMethod->Name = PropertyName : "Get" ) Then
ClassDefinition->Methods->RemoveAt( NextMethod )
End
Repeat
Return
AddGetSetMethods:
* The property is set up. MVBooster has its own mechanism for handling file update and
* retrieval. You can go back and customize each Set() method to enforce data integrity
* and each Get() method for data shaping.
* Build the Get() method for this property that will use MVBooster.MVFileAbstraction methods inherited by the new class
GetMethod = "%Dictionary.MethodDefinition"->%New(CompleteClassName : ":" : PropertyName : "Get" )
GetMethod->ClassMethod = @false ; * this is an instance method
GetMethod->Language = "mvbasic"
GetMethod->ReturnType = Type ; * same as the property type
StringBuilder = "%GlobalCharacterStream"->%New() ; * build the body of the method in here
StringBuilder->WriteLine( "theRecord = @ME->Record" )
If AttributeNumber Matches "1N0N" Then
StringBuilder->WriteLine( "return theRecord<" : AttributeNumber : ">" )
End Else ; * it's an I-type formula
Formula = EReplace( AttributeNumber, "@ID", "@ME->Key" )
Formula = EReplace( AttributeNumber, "@RECORD", "@ME->Record" )
StringBuilder->WriteLine( "Result = " : Formula )
StringBuilder->WriteLine( "return Result" )
End
GetMethod->Implementation = StringBuilder
ClassDefinition->Methods->Insert( GetMethod )
$Kill StringBuilder ; * destroy the method definition code builder so the variable can be reused
$Kill GetMethod ; * destroy the method definition so it will be clean on the next loop through here
* Build the Set() method for this property. It will also use methods and properties inherited from the MVBooster.MVFileAbstraction class
SetMethod = "%Dictionary.MethodDefinition"->%New(CompleteClassName : ":" : PropertyName : "Set" )
SetMethod->ClassMethod = @false ; * this is also an instance method
SetMethod->Language = "mvbasic"
SetMethod->ReturnType = "%Status"
SetMethod->FormalSpec = "Value:" : Type
StringBuilder = "%GlobalCharacterStream"->%New() ; * build the body of the method in here
If DictType <> "I" Then
* You'll need to go back into the class and add your own data integrity enforcement code if it's needed
StringBuilder->WriteLine( "@ME->SetAttribute( " : AttributeNumber : ", Value )" )
StringBuilder->WriteLine( \Return "%SYSTEM.Status"->OK()\ )
End Else
StringBuilder->WriteLine( \Return "%SYSTEM.Status"->Error( 0, "Cannot set a virtual type." )\ )
SetMethod->Private = 1
End
SetMethod->Implementation = StringBuilder
ClassDefinition->Methods->Insert( SetMethod )
$Kill StringBuilder
$Kill SetMethod
"MVBooster.Library"->ClearConditions()
Return
AddDefaultQuery:
* Add a default "ALL" query. Remove any existing before replacing.
NextQuery = %MVBCommon->nil
Loop
NextQuery = ClassDefinition->Queries->Next( NextQuery )
Until NextQuery = %MVBCommon->nil Do
ExistingQuery = ClassDefinition->Queries->GetAt( NextQuery )
If %MVBDebugging = @true Then %MVBTrace->WriteEntry( "Found query " : ExistingQuery->Name : "; removing." )
If Upcase( ExistingQuery->Name ) = "ALL" Then
ClassDefinition->Queries->RemoveAt( NextQuery )
*Exit ; * there'll only be one
End
Repeat
NewQuery = "%Dictionary.QueryDefinition"->%New()
NewQuery->Name = "All"
NewQuery->SqlQuery = "SELECT " : Convert( @fm, ',', DefaultQueryFields ) : " FROM " : Filename : " ORDER BY %ID "
NewQuery->Type = "%SQLQuery"
NewQuery->Parameters->SetAt( 1, "CONTAINID" )
ClassDefinition->Queries->Insert( NewQuery )
Return
} The routine that calls the ClassMethod MVBProtoclass
0001 Program MVBProtoclass
0002 #Pragma RoutineName = MVBProtoclass
0003
0004 * Create or update an MVBooster file class from the DICT of a file in the VOC.
0005 * Switches:
0006 * -File filespec Designates the file in the VOC whose DICT will be used
0007 * -DELete Delete any existing class for this file
0008 * -P packagespec designates the package name into which this file class
0009 * should be categorized. If this switch is missing, then
0010 * the package "MVFile" is used. If the designated package
0011 * name does not yet exist, it will be automatically created.
0012 * This simplifies mapping and exposing files by application
0013 * type or suite.
0014 * -MAXrealattribute The highest A/AMC of a "real" (not calculated) A or S type.
0015 * Defaults to 8999 (Pick used 9000 and above.)
0016 * -Xdata Create an XData section for MVRepopulate
0017 *
0018 * The MVBooster debugging switches may also be used.
0019
0020 *
0021 * Make sure the catalog pointer was modified to make this a TCL2 verb
0022 *
0023 *FINDSTR "2D" IN $Get(%parseControl) SETTING LINT Else ABORT 445, "PROTOCLASS":@VM:"D"
0024
0025 MaxDefault = 8999 ; * Default maximum "real" attribute. Any DICT item with a greater A/AMC will be considered a ca
lculation.
0026
0027 %MVBCommon = "MVBooster.Common"->%New()
0028 %MVBCommon->Setup()
0029 %MVBCommon->SetSwitchesFromCommandLine()
0030
0031 * Was the file switch "-F" specified?
0032 FindStr "-F" In %MVBTokenizedSentence Setting Pos Else
0033 %MVBTrace->WriteEntry( "Use the -F filespec argument to specify which file wants a class built." )
0034 Stop
0035 End
0036
0037 Filename = %MVBTokenizedSentence< Pos + 1 >
0038
0039 Dim %MVBFileInfo() ; * access the Cache' array for MV Booster file info
0040 "MVBooster.Library"->FileInfo( Filename )
0041
0042 If $Get( %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoFilePropertiesSubscript, %MVBCommon->MVBFileHandle ) ) = %MVBCommon
->nil Then 0043 %MVBTrace->WriteEntry( "No file named " : DQuote( Filename ) : " can be opened from the VOC." )
0044 Stop
0045 End
0046
0047 FileDataLevel = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoFilePropertiesSubscript )
0048 FileDataLevel->OpenDict()
0049 FileDictLevel = %MVBFileInfo( Filename, %MVBCommon->MVBFileInfoDictPropertiesSubscript )
0050
0051 If %MVBDebugging Then
0052 $Xecute " zw %MVBFileInfo(" : DQuote( Filename ) : ")"
0053 End
0054
0055 FindStr "-DEL" In %MVBTokenizedSentence Setting Pos Then
0056 DeleteExistingClass = @true
0057 End Else
0058 DeleteExistingClass = @false
0059 End
0060
0061 FindStr "-P" In %MVBTokenizedSentence Setting Pos Then
0062 PackageName = %MVBTokenizedSentence< Pos + 1 >
0063 End Else
0064 PackageName = %MVBCommon->nil
0065 End
0066
0067 FindStr "-MAX" In %MVBTokenizedSentence Setting Pos Then
0068 MaxRealAttribute = %MVBTokenizedSentence< Pos + 1 >
0069 If Not( MaxRealAttribute Matches "1N0N" ) Then MaxRealAttribute = MaxDefault
0070 End Else
0071 MaxRealAttribute = MaxDefault
0072 End
0073
0074 FindStr "-X" In %MVBTokenizedSentence Setting Pos Then
0075 GenerateXDATA = @true
0076 End Else
0077 GenerateXDATA = @false
0078 End
0079
0080 CompleteClassName = PackageName : "." : Filename
0081 DefaultQueryFields = %MVBCommon->nil
0082
0083 "MVBooster.Library"->Protoclass( Filename, PackageName, DeleteExistingClass, GenerateXData, MaxRealAttribute )
0084
0085 Return
0086
0087 ************************************
Reply all
Reply to author
Forward
0 new messages