open-insight/FRAMEWORKS/STPROC/HTTP_JSON_SERVICES.txt
2024-03-25 15:15:48 -07:00

910 lines
47 KiB
Plaintext

Function HTTP_JSON_Services(@Service, @Params)
/***********************************************************************************************************************
This program is proprietary and is not to be used by or disclosed to others, nor is it to be copied without written
permission from SRP Computer Solutions, Inc.
Name : HTTP_JSON_Services
Description : Handler program for all module related services.
Notes : The generic parameters should contain all the necessary information to process the services. Often
this will be information like the data Record and Key ID.
Parameters :
Service [in] -- Name of the service being requested
Param1-10 [in/out] -- Additional request parameter holders
Response [out] -- Response to be sent back to the Controller (MCP) or requesting procedure
Metadata :
History : (Date, Initials, Notes)
02/06/15 dmb Original programmer. - [SRPFW-87]
04/17/15 dmb Added SetHALItem, SetHALCollection, and SetHALCollectionEmbedded services and removed
SetHALLinks, SetHALEmbedded, and GetHALRootObj services. These new services do a better
job of simplifying the creation of specific item and item collection HAL+JSON responses.
The GetHAL service remains but it has been modified to support the new services.
- [SRPFW-87]
04/17/15 dmb Converted /HTTPJSONServices/ labelled common into /HAL/ and /Schema/ labelled commons so
that the FreeCommon statement can be used. - [SRPFW-87]
04/19/15 dmb Update SetHALItem to support multivalue columns. - [SRPFW-87]
05/15/15 dmb Update SetHALCollectionEmbedded to allow responses with no embedded data. - [SRPFW-87]
06/09/15 dmb Restore SetHALLinks service as this does provide a valid response in some cases.
- [SRPFW-87]
06/09/15 dmb Add ItemArrayLabel argument to the GetHAL service so the calling service (usually
HTTP_Resources_Services) can specify the label text to use for the primary HAL array.
If not specified then "item" will be used as the default. - [SRPFW-87]
07/01/17 dmb Refactor using Enhanced BASIC+ syntax. - [SRPFW-184]
***********************************************************************************************************************/
#pragma precomp SRP_PreCompiler
$insert APP_INSERTS
$insert SERVICE_SETUP
$insert HTTP_INSERTS
Declare function SRP_Sort_Array
Common /HAL/ HALType@, HALRootObj@, HALRootLinksObj@, HALEmbeddedObj@, HALItemArray@, HALLinksObj@
Common /Schema/ SchemaRootObj@, SchemaPropertiesObj@, SchemaRequiredArray@
GoToService else
Error_Services('Add', Service : ' is not a valid service request within the HTTP Authentication services module.')
end
Return Response OR ''
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Service Parameter Options
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Options BOOLEAN = True$, False$
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Services
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//----------------------------------------------------------------------------------------------------------------------
// SetHALItem
//
// ItemURL - The URL to the item itself. - [Required]
// ColumnNames - An @FM delimited array of column names (i.e., dictionaries) that will label the column values.
// - [Required]
// ColumnValues - An @FM delimited array of column values (i.e., data) that represents the item resource. These are
// associated with the ColumnNames argument. - [Required]
// DataTypes - An @FM delimited array of JSON data types for each column value. If empty then SRP_JSON will decide
// using its default type matching rules. - [Optional]
// MVGroupNames - An @FM delimited array of MV group names. These are associated with the ColumnNames argument.
// - [Optional]
//
// Creates a HAL+JSON object for a specific item. Requires the GetHAL service to return the serialized object.
//----------------------------------------------------------------------------------------------------------------------
Service SetHALItem(ItemURL, ColumnNames, ColumnValues, DataTypes, MVGroupNames)
HALType@ = Service
If (ItemURL NE '') AND (ColumnNames NE '') AND (ColumnValues NE '') then
If MVGroupNames NE '' then
// MV group names have been passed in. Sort the arguments by the MV group names so these can be properly
// combined into the same JSON object.
Arguments = SRP_Sort_Array(ColumnNames : @RM : ColumnValues : @RM : DataTypes : @RM : MVGroupNames, 'AL4', False$, @RM, @FM)
ColumnNames = Arguments[1, @RM]
ColumnValues = Arguments[Col2() + 1, @RM]
DataTypes = Arguments[Col2() + 1, @RM]
MVGroupNames = Arguments[Col2() + 1, @RM]
end
PrevMVGroupName = ''
If HALRootObj@ NE '' else
// Create the root object.
If SRP_JSON(HALRootObj@, 'NEW', 'OBJECT') else
HTTP_Services('SetResponseError', '', '', 500)
Error_Services('Add', 'Error creating the HAL root object in the ' : Service : ' service.')
end
end
If Error_Services('NoError') then
// Create the "_links" object. It will be SET to the root object in the GetHAL service.
If SRP_JSON(HALRootLinksObj@, 'NEW', 'OBJECT') then
// Create the "self" object. It will be SET to the "_links" object when finished.
If SRP_JSON(hSelfObj, 'NEW', 'OBJECT') then
// Create the "href" name/value for the "self" object.
SRP_JSON(hSelfObj, 'SETVALUE', 'href', ItemURL)
// SET the "self" object to the "_links" object and name it.
If SRP_JSON(HALRootLinksObj@, 'SET', 'self', hSelfObj) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hSelfObj, 'RELEASE')
end else
HTTP_Services('SetResponseError', '', '', 500)
end
// Create the "collection" object. It will be SET to the "_links" object when finished.
If SRP_JSON(hCollectionObj, 'NEW', 'OBJECT') then
// Create the "href" name/value for the "collection" object.
CollectionURL = ItemURL
ItemID = CollectionURL[-1, 'B/']
CollectionURL[-1, Neg(Len(ItemID) + 1)] = ''
SRP_JSON(hCollectionObj, 'SETVALUE', 'href', CollectionURL)
// SET the "collection" object to the "_links" object and name it.
If SRP_JSON(HALRootLinksObj@, 'SET', 'collection', hCollectionObj) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hCollectionObj, 'RELEASE')
end else
HTTP_Services('SetResponseError', '', '', 500)
end
// Add the column name/value pairs. These are SETVALUEd to the root object.
ColumnNames = ColumnNames[1, @RM] ; // Make sure there are no "extra" items being added.
ColumnValues = ColumnValues[1, @RM] ; // Make sure there are no "extra" items being added.
DataTypes = DataTypes[1, @RM] ; // Make sure there are no "extra" items being added.
MVGroupNames = MVGroupNames[1, @RM] ; // Make sure there are no "extra" items being added.
NumColumns = DCount(ColumnNames, @FM)
For ColumnCnt = 1 to NumColumns
Name = ColumnNames<ColumnCnt>
Value = ColumnValues<ColumnCnt>
Type = DataTypes<ColumnCnt>
MVGroupName = MVGroupNames<ColumnCnt>
If Len(MVGroupName) then
// This column is a part of a MV group. Check to see if this is a new MV group or one that was
// already being used.
If MVGroupName NE PrevMVGroupName then
// A new MV group is being worked on.
If PrevMVGroupName NE '' then
// Create the JSON object for the new MV group.
If SRP_JSON(hMVArray, 'New', 'ARRAY') then
For MVValueCnt = 1 to MVTotalValues
If SRP_JSON(hMVObject, 'New', 'Object') then
For MVColumnCnt = 1 to MVTotalColumns
SRP_JSON(hMVObject, 'SetValue', MVLabels<MVColumnCnt>, MVArray<MVColumnCnt, MVValueCnt>)
Next MVColumnCnt
end
SRP_JSON(hMVArray, 'Add', hMVObject)
SRP_JSON(hMVObject, 'Release')
Next MVValueCnt
If SRP_JSON(HALRootObj@, 'Set', PrevMVGroupName, hMVArray) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hMVArray, 'Release')
end
end
MVLabels = ''
MVArray = ''
MVTotalColumns = 0
MVTotalValues = 0
end
MVLabels := Name : @FM
MVArray := Value : @FM
MVTotalColumns += 1
NumValues = DCount(Value, @VM)
If NumValues GT MVTotalValues then MVTotalValues = NumValues
* If SRP_JSON(hColumnArray, 'NEW', 'ARRAY') then
* NumValues = Count(Value, @VM) + (Value NE '')
* For ValueCnt = 1 to NumValues
* SRP_JSON(hColumnArray, 'ADDVALUE', Value<0, ValueCnt>)
* Next ValueCnt
* If SRP_JSON(hMVGroupObj@, 'SET', Name, hColumnArray) else HTTP_Services('SetResponseError', '', '', 500)
* SRP_JSON(hColumnArray, 'RELEASE')
* end
end else
If Index(Value, @VM, 1) then
If SRP_JSON(hColumnArray, 'NEW', 'ARRAY') then
NumValues = Count(Value, @VM) + (Value NE '')
For ValueCnt = 1 to NumValues
SRP_JSON(hColumnArray, 'ADDVALUE', Value<0, ValueCnt>)
Next ValueCnt
If SRP_JSON(HALRootObj@, 'SET', Name, hColumnArray) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hColumnArray, 'RELEASE')
end
end else
If SRP_JSON(HALRootObj@, 'SETVALUE', Name, Value, Type) else HTTP_Services('SetResponseError', '', '', 500)
end
end
Transfer MVGroupName to PrevMVGroupName
Next ColumnCnt
If PrevMVGroupName NE '' then
// Create the JSON object for the new MV group.
If SRP_JSON(hMVArray, 'New', 'ARRAY') then
For MVValueCnt = 1 to MVTotalValues
If SRP_JSON(hMVObject, 'New', 'Object') then
For MVColumnCnt = 1 to MVTotalColumns
SRP_JSON(hMVObject, 'SetValue', MVLabels<MVColumnCnt>, MVArray<MVColumnCnt, MVValueCnt>)
Next MVColumnCnt
end
SRP_JSON(hMVArray, 'Add', hMVObject)
SRP_JSON(hMVObject, 'Release')
Next MVValueCnt
If SRP_JSON(HALRootObj@, 'Set', PrevMVGroupName, hMVArray) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hMVArray, 'Release')
end
end
SRP_JSON(hMVGroupObj@, 'RELEASE')
end else
HTTP_Services('SetResponseError', '', '', 500)
end
end
end else
// At least one required argument is missing.
HTTP_Services('SetResponseError', '', '', 500)
end
end service
//----------------------------------------------------------------------------------------------------------------------
// SetHALCollection
//
// CollectionURL - The URL to the collection. - [Required]
// ItemsURLs - An @FM delimited array of URLs to each item. - [Required]
// ItemsTitles - An @FM delimited array of item titles. These are associated with the ItemsURLs argument -
// [Required]
//
// Creates a HAL+JSON object for a collection. Requires the GetHAL service to return the serialized object.
//----------------------------------------------------------------------------------------------------------------------
Service SetHALCollection(CollectionURL, ItemsURLs, ItemsTitles)
HALType@ = Service
If (CollectionURL NE '') AND (ItemsURLs NE '') AND (ItemsTitles NE '') then
If HALRootObj@ NE '' else
// Create the root object.
If SRP_JSON(HALRootObj@, 'NEW', 'OBJECT') else
HTTP_Services('SetResponseError', '', '', 500)
Error_Services('Add', 'Error creating the HAL root object in the ' : Service : ' service.')
end
end
If Error_Services('NoError') then
If Len(HALRootLinksObj@) else
// Create the "_links" object. It will be SET to the root object in the GetHAL service.
If SRP_JSON(HALRootLinksObj@, 'NEW', 'OBJECT') then
// Create the "self" object. It will be SET to the "_links" object when finished.
If SRP_JSON(hSelfObj, 'NEW', 'OBJECT') then
// Create the "href" name/value for the "self" object.
SRP_JSON(hSelfObj, 'SETVALUE', 'href', CollectionURL)
// SET the "self" object to the "_links" object and name it.
If SRP_JSON(HALRootLinksObj@, 'SET', 'self', hSelfObj) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hSelfObj, 'RELEASE')
end else
HTTP_Services('SetResponseError', '', '', 500)
end
end else
HTTP_Services('SetResponseError', '', '', 500)
end
end
If Len(HALItemArray@) else
// Create the "item" array. This will hold the embedded items. It will be SET to the "_links" object
// in the GetHAL when service. It is left available now so multiple calls into the SetHALCollection
// service can be made in the event items needs to be added at different opportunities.
If SRP_JSON(HALItemArray@, 'NEW', 'ARRAY') else
HTTP_Services('SetResponseError', '', '', 500)
Error_Services('Add', 'Error creating the HAL item array in the ' : Service : ' service.')
end
end
If Error_Services('NoError') then
// ADD items to the "item" array.
NumItems = Count(ItemsURLs, @FM) + (ItemsURLs NE '')
For ItemCnt = 1 to NumItems
If SRP_JSON(hItemObj, 'NEW', 'OBJECT') then
ItemURL = Field(ItemsURLs, @FM, ItemCnt, 1)
ItemTitle = Field(ItemsTitles, @FM, ItemCnt, 1)
// Create the "href" name/value for the "item" object.
SRP_JSON(hItemObj, 'SETVALUE', 'href', ItemURL)
// Create the "title" name/value for the "item" object.
SRP_JSON(hItemObj, 'SETVALUE', 'title', ItemTitle)
// Add this item object to the "item" array.
SRP_JSON(HALItemArray@, 'ADD', hItemObj)
// Release the Item object handle.
SRP_JSON(hItemObj, 'RELEASE')
end
Next ItemCnt
end else
HTTP_Services('SetResponseError', '', '', 500)
end
end
end else
// At least one required argument is missing.
HTTP_Services('SetResponseError', '', '', 500)
end
end service
//----------------------------------------------------------------------------------------------------------------------
// SetHALCollectionEmbedded
//
// CollectionURL - The URL to the collection. - [Required]
// ItemsURLs - An @RM delimited array of URLs to each item. - [Required]
// ColumnNames - An @RM/@FM delimited array of column names (i.e., dictionaries) that will label the column values.
// These are associated with the ItemsURLs argument. - [Required]
// ColumnValues - An @RM/@FM delimited array of column values (i.e., data) that represents the item resource. These
// are associated with the ItemsURLs argument. - [Required]
// DataTypes - An @RM/@FM delimited array of JSON data types for each column value. If empty then SRP_JSON will
// decide using its default type matching rules. - [Optional]
// MVGroupNames - An @RM/@FM delimited array of MV group names. These are associated with the ItemsURLs argument.
// - [Optional]
//
// Creates a HAL+JSON object for a collection of embedded items. Requires the GetHAL service to return the serialized
// object.
//----------------------------------------------------------------------------------------------------------------------
Service SetHALCollectionEmbedded(CollectionURL, ItemsURLs, ColumnNames, ColumnValues, DataTypes, MVGroupNames)
HALType@ = Service
If CollectionURL NE '' then
If HALRootObj@ NE '' else
// Create the root object.
If SRP_JSON(HALRootObj@, 'NEW', 'OBJECT') else
HTTP_Services('SetResponseError', '', '', 500)
Error_Services('Add', 'Error creating the HAL root object in the ' : Service : ' service.')
end
end
If Error_Services('NoError') then
If HALRootLinksObj@ NE '' else
// Create the "_links" object. It will be SET to the root object in the GetHAL service.
If SRP_JSON(HALRootLinksObj@, 'NEW', 'OBJECT') then
// Create the "self" object. It will be SET to the "_links" object when finished.
If SRP_JSON(hSelfObj, 'NEW', 'OBJECT') then
// Create the "href" name/value for the "self" object.
SRP_JSON(hSelfObj, 'SETVALUE', 'href', CollectionURL)
// SET the "self" object to the "_links" object and name it.
If SRP_JSON(HALRootLinksObj@, 'SET', 'self', hSelfObj) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hSelfObj, 'RELEASE')
end else
HTTP_Services('SetResponseError', '', '', 500)
end
end else
HTTP_Services('SetResponseError', '', '', 500)
end
end
If HALEmbeddedObj@ NE '' else
// Create the "_embedded" object. This will contain the array of items. It will be SET to the root
// object in the GetHAL service. It is left available now so multiple calls into the
// SetHALCollectionEmbedded service can be made in the event items needs to be added at different
// opportunities.
If SRP_JSON(HALEmbeddedObj@, 'NEW', 'OBJECT') else
HTTP_Services('SetResponseError', '', '', 500)
Error_Services('Add', 'Error creating the HAL embedded object in the ' : Service : ' service.')
end
end
If HALItemArray@ NE '' else
// Create the "item" array. This will hold the embedded items. It will be SET to the "_embedded" object
// in the GetHAL when service. It is left available now so multiple calls into the
// SetHALCollectionEmbedded service can be made in the event items needs to be added at different
// opportunities.
If SRP_JSON(HALItemArray@, 'NEW', 'ARRAY') else
HTTP_Services('SetResponseError', '', '', 500)
Error_Services('Add', 'Error creating the HAL item array in the ' : Service : ' service.')
end
end
If Error_Services('NoError') then
// SET items to the "item" array.
NumItems = Count(ItemsURLs, @RM) + (ItemsURLs NE '')
For ItemCnt = 1 to NumItems
If SRP_JSON(hItemObj, 'NEW', 'OBJECT') then
ItemURL = Field(ItemsURLs, @RM, ItemCnt, 1)
ItemColumnNames = Field(ColumnNames, @RM, ItemCnt, 1)
ItemColumnValues = Field(ColumnValues, @RM, ItemCnt, 1)
ItemDataTypes = Field(DataTypes, @RM, ItemCnt, 1)
ItemMVGroupNames = Field(MVGroupNames, @RM, ItemCnt, 1)
If Len(ItemMVGroupNames) then
// MV group names have been passed in. Sort the arguments by the MV group names so these can be properly
// combined into the same JSON object.
Arguments = SRP_Sort_Array(ItemColumnNames : @RM : ItemColumnValues : @RM : ItemDataTypes : @RM : ItemMVGroupNames, 'AL4', False$, @RM, @FM)
ItemColumnNames = Arguments[1, @RM]
ItemColumnValues = Arguments[Col2() + 1, @RM]
ItemDataTypes = Arguments[Col2() + 1, @RM]
ItemMVGroupNames = Arguments[Col2() + 1, @RM]
end
PrevMVGroupName = ''
If SRP_JSON(hLinksObj, 'NEW', 'OBJECT') then
// Create the "self" object. It will be SET to the "_links" object when finished.
If SRP_JSON(hSelfObj, 'NEW', 'OBJECT') then
// Create the "href" name/value for the "self" object.
SRP_JSON(hSelfObj, 'SETVALUE', 'href', ItemURL)
// SET the "self" object to the "_links" object and name it.
If SRP_JSON(hLinksObj, 'SET', 'self', hSelfObj) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hSelfObj, 'RELEASE')
end else
HTTP_Services('SetResponseError', '', '', 500)
end
// SET the "_links" object to the root object and name it.
If SRP_JSON(hItemObj, 'SET', '_links', hLinksObj) else HTTP_Services('SetResponseError', '', '', 500)
// Release the "links" object handle.
SRP_JSON(hLinksObj, 'RELEASE')
end else
HTTP_Services('SetResponseError', '', '', 500)
end
NumColumns = Count(ItemColumnNames, @FM) + (ItemColumnNames NE '')
For ColumnCnt = 1 to NumColumns
Name = ItemColumnNames<ColumnCnt>
Value = ItemColumnValues<ColumnCnt>
Type = ItemDataTypes<ColumnCnt>
MVGroupName = ItemMVGroupNames<ColumnCnt>
If Len(MVGroupName) then
// This column is a part of a MV group. Check to see if this is a new MV group or one that was
// already being used.
If MVGroupName NE PrevMVGroupName then
// A new MV group is being worked on.
If Len(PrevMVGroupName) then
// There was a previous MV group started, then SET this to the MV group object.
If SRP_JSON(hItemObj, 'SET', PrevMVGroupName, hMVGroupObj@) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hMVGroupObj@, 'RELEASE')
end
// Create the JSON object for the new MV group.
If SRP_JSON(hMVGroupObj@, 'NEW', 'OBJECT') else HTTP_Services('SetResponseError', '', '', 500)
end
If SRP_JSON(hColumnArray, 'NEW', 'ARRAY') then
NumValues = Count(Value, @VM) + (Value NE '')
For ValueCnt = 1 to NumValues
SRP_JSON(hColumnArray, 'ADDVALUE', Value<0, ValueCnt>)
Next ValueCnt
If SRP_JSON(hMVGroupObj@, 'SET', Name, hColumnArray) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hColumnArray, 'RELEASE')
end
end else
If Index(Value, @VM, 1) then
If SRP_JSON(hColumnArray, 'NEW', 'ARRAY') then
NumValues = Count(Value, @VM) + (Value NE '')
For ValueCnt = 1 to NumValues
SRP_JSON(hColumnArray, 'ADDVALUE', Value<0, ValueCnt>)
Next ValueCnt
If SRP_JSON(hItemObj, 'SET', Name, hColumnArray) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hColumnArray, 'RELEASE')
end
end else
If SRP_JSON(hItemObj, 'SETVALUE', Name, Value, Type) else HTTP_Services('SetResponseError', '', '', 500)
end
end
Transfer MVGroupName to PrevMVGroupName
Next ColumnCnt
If Len(PrevMVGroupName) then
// There was a previous MV group started, then SET this to the MV group object.
If SRP_JSON(hItemObj, 'SET', PrevMVGroupName, hMVGroupObj@) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hMVGroupObj@, 'RELEASE')
end
// Add this item object to the "item" array.
SRP_JSON(HALItemArray@, 'ADD', hItemObj)
// Release the Item object handle.
SRP_JSON(hItemObj, 'RELEASE')
end
Next ItemCnt
end else
HTTP_Services('SetResponseError', '', '', 500)
end
end else
HTTP_Services('SetResponseError', '', '', 500)
end
end else
// At least one required argument is missing.
HTTP_Services('SetResponseError', '', '', 500)
end
end service
//----------------------------------------------------------------------------------------------------------------------
// SetHALLinks
//
// SelfURI - The URI to the self object. - [Required]
// HREFNames - An @FM delimited array of HREF names to add to the "links" object. - [Optional]
// HREFURIs - An @FM delimited array of HREF URIs to add to the "links" objects. These are associated with the
// HREFNames argument. - [Optional]
// ChildNames - An @FM delimited array of names for objects to add to the "links" object. - [Optional]
// hChildren - An @FM delimited array of objects handles to add to the "links" object. These are associated with
// the ChildNames argument.
// Names - An @FM delimited array of names to add to the "links" object. - [Optional]
// Values - An @FM delimited array of values to add to the "links" object. These are associated with the Names
// argument. -[Optional]
//
// Creates a HAL style "links" object.
//----------------------------------------------------------------------------------------------------------------------
Service SetHALLinks(SelfURI, HREFNames, HREFURIs, ChildNames, hChildren, Names, Values)
HALType@ = Service
If SelfURI NE '' then
If HALRootObj@ NE '' else
// Create the root object.
If SRP_JSON(HALRootObj@, 'NEW', 'OBJECT') else
HTTP_Services('SetResponseError', '', '', 500)
Error_Services('Add', 'Error creating the HAL root object in the ' : Service : ' service.')
end
end
If Error_Services('NoError') then
If HALRootLinksObj@ NE '' else
// Create the "_links" object. It will be SET to the root object in the GetHAL service.
If SRP_JSON(HALRootLinksObj@, 'NEW', 'OBJECT') then
// Create the "self" object. It will be SET to the "_links" object when finished.
If SRP_JSON(hSelfObj, 'NEW', 'OBJECT') then
// Create the "href" name/value for the "self" object.
SRP_JSON(hSelfObj, 'SETVALUE', 'href', SelfURI)
// SET the "self" object to the "_links" object and name it.
If SRP_JSON(HALRootLinksObj@, 'SET', 'self', hSelfObj) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hSelfObj, 'RELEASE')
end else
HTTP_Services('SetResponseError', '', '', 500)
end
end else
HTTP_Services('SetResponseError', '', '', 500)
end
end
// Create any "href" objects that are requested. These will be SET to the "_links" object when finished.
If HREFNames NE '' then
NumHREFs = Count(HREFNames, @FM) + (HREFNames NE '')
For HREFCnt = 1 to NumHREFs
HREFName = HREFNames<HREFCnt>
HREFURI = HREFURIs<HREFCnt>
// Create the "href" object. It will be SET to the "_links" object when finished.
If SRP_JSON(hHREFObj, 'NEW', 'OBJECT') then
// Create the "href" name/value for the "href" object.
SRP_JSON(hHREFObj, 'SETVALUE', 'href', HREFURI)
// SET the "href" object to the "_links" object and name it.
If SRP_JSON(HALRootLinksObj@, 'SET', HREFName, hHREFObj) then else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hHREFObj, 'RELEASE')
end else
HTTP_Services('SetResponseError', '', '', 500)
end
Next HREFCnt
end
// Add any chile name/object pairs that have been passed into this service. This are SET to the "links"
// object.
If ChildNames NE '' then
NumChildren = Count(ChildNames, @FM) + (ChildNames NE '')
For ChildCnt = 1 to NumChildren
ChildName = ChildNames<ChildCnt>
hChild = hChildren<ChildCnt>
If SRP_JSON(HALRootLinksObj@, 'SET', ChildName, hChild) else HTTP_Services('SetResponseError', '', '', 500)
While Error_Services('NoError')
Next ChildCnt
end
// Add any name/value pairs that have been passed into this service. These are SETVALUEd to the "links"
// object.
If Names NE '' then
NumNames = Count(Names, @FM) + (Names NE '')
For NameCnt = 1 to NumNames
Name = Names<NameCnt>
Value = Values<NameCnt>
If SRP_JSON(HALRootLinksObj@, 'SETVALUE', Name, Value) else HTTP_Services('SetResponseError', '', '', 500)
While Error_Services('NoError')
Next NameCnt
end
end else
HTTP_Services('SetResponseError', '', '', 500)
end
end else
HTTP_Services('SetResponseError', '', '', 500)
end
end service
//----------------------------------------------------------------------------------------------------------------------
// SetHALEmbedded
//
// Returns the handle to a root JSON object.
//----------------------------------------------------------------------------------------------------------------------
Service SetHALEmbedded()
end service
//----------------------------------------------------------------------------------------------------------------------
// GetHALRootObj
//
// Returns the handle to a root JSON object. If it does not already exist it will be created.
//----------------------------------------------------------------------------------------------------------------------
Service GetHALRootObj()
If HALRootObj@ NE '' else
// Create the root object.
If SRP_JSON(HALRootObj@, 'NEW', 'OBJECT') else HTTP_Services('SetResponseError', '', '', 500)
end
Response = HALRootObj@
end service
//----------------------------------------------------------------------------------------------------------------------
// GetHAL
//
// Returns the serialized JSON object for the current HAL response. If no HAL object has been defined then this will
// return an empty string and a 500 status code will be set. All HAL objects and arrays will be released in this
// service.
//----------------------------------------------------------------------------------------------------------------------
Service GetHAL(ItemArrayLabel)
HAL = ''
If (HALType@ NE '') AND (HALRootObj@ NE '') AND (HALRootLinksObj@ NE '') then
// Check the HAL Type (i.e., Collection or CollectionEmbedded) and perform any final association of
// objects and arrays. Release any objects and arrays.
Begin Case
Case HALType@ _EQC 'SetHALCollectionEmbedded'
If Len(HALEmbeddedObj@) AND Len(HALItemArray@) then
If Len(ItemArrayLabel) else ItemArrayLabel = 'item'
If SRP_JSON(HALEmbeddedObj@, 'SET', ItemArrayLabel, HALItemArray@) else HTTP_Services('SetResponseError', '', '', 500)
If SRP_JSON(HALRootObj@, 'SET', '_embedded', HALEmbeddedObj@) else HTTP_Services('SetResponseError', '', '', 500)
end
SRP_JSON(HALEmbeddedObj@, 'RELEASE')
SRP_JSON(HALItemArray@, 'RELEASE')
Case HALType@ _EQC 'SetHALCollection'
If Len(HALItemArray@) then
If Len(ItemArrayLabel) else ItemArrayLabel = 'item'
If SRP_JSON(HALRootLinksObj@, 'SET', ItemArrayLabel, HALItemArray@) else HTTP_Services('SetResponseError', '', '', 500)
end
SRP_JSON(HALItemArray@, 'RELEASE')
End Case
// Set the "_links" object to the root. This occurs for all HAL types.
If SRP_JSON(HALRootObj@, 'SET', '_links', HALRootLinksObj@) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(HALRootLinksObj@, 'RELEASE')
// Serialize the HAL object. Use STYLED for human readability or FAST for optimum performance and smaller payload.
* HAL = SRP_JSON(HALRootObj@, 'STRINGIFY', 'STYLED')
HAL = SRP_JSON(HALRootObj@, 'STRINGIFY', 'FAST')
SRP_JSON(HALRootObj@, 'RELEASE')
end
// Clear all HAL common variables.
FreeCommon 'HAL'
Response = HAL
end service
//----------------------------------------------------------------------------------------------------------------------
// GetSchemaRootObj
//
// Returns the handle to a root Schema object. If it does not already exist it will be created with the standard
// "$schema" value already added.
//----------------------------------------------------------------------------------------------------------------------
Service GetSchemaRootObj()
If SchemaRootObj@ NE '' else
// Create the root object.
If SRP_JSON(SchemaRootObj@, 'NEW', 'OBJECT') then
If SRP_JSON(SchemaRootObj@, 'SETVALUE', '$schema', 'http://json-schema.org/draft-04/schema#') else HTTP_Services('SetResponseError', '', '', 500)
end else
HTTP_Services('SetResponseError', '', '', 500)
end
end
Response = SchemaRootObj@
end service
//----------------------------------------------------------------------------------------------------------------------
// SetSchemaMeta
//
// Title - The title for the schema. - [Optional]
// Description - A description for the schema. - [Optional]
// Type - The JSON type for the schema. The default value is "object". - [Optional]
//
// Sets the meta data associated to the schema object.
//----------------------------------------------------------------------------------------------------------------------
Service SetSchemaMeta(Title, Description, Type)
// Check for the root object. If none exists then create one and use it.
If Len(SchemaRootObj@) else SchemaRootObj@ = HTTP_JSON_Services('GetSchemaRootObj')
If Error_Services('NoError') then
If Type NE '' else Type = 'object'
If Title NE '' then
If SRP_JSON(SchemaRootObj@, 'SETVALUE', 'title', Title) else HTTP_Services('SetResponseError', '', '', 500)
end
If Description NE '' then
If SRP_JSON(SchemaRootObj@, 'SETVALUE', 'description', Description, 'STRING') else HTTP_Services('SetResponseError', '', '', 500)
end
If Type NE '' then
If SRP_JSON(SchemaRootObj@, 'SETVALUE', 'type', Type, 'STRING') else HTTP_Services('SetResponseError', '', '', 500)
end
end
end service
//----------------------------------------------------------------------------------------------------------------------
// SetSchemaProperty
//
// Name - The name of the member of this property. - [Required]
// Title - The title for this property. - [Optional]
// Type - The data type for this property. - [Optional]
// Format - The display format for this property. - [Optional]
// EnumList - A list of options that are to be used for this property. - [Optional]
// Required - Flag to indicate if this property is required. Default is false. - [Optional]
//
// Sets a property to the schema. There can be more than one property so this service will add another property to the
// list if it already exists.
//----------------------------------------------------------------------------------------------------------------------
Service SetSchemaProperty(Name, Title, Type, Format, EnumList, Required)
// Check for properties object handle. If none, create an object and use it.
If SchemaPropertiesObj@ NE '' else
SRP_JSON(SchemaPropertiesObj@, 'NEW', 'OBJECT')
end
If SchemaPropertiesObj@ NE '' then
If Name NE '' then
If SRP_JSON(hNameObj, 'NEW', 'OBJECT') then
// Add the Title member to the Name object.
If Title NE '' then
If SRP_JSON(hNameObj, 'SETVALUE', 'title', Title) else HTTP_Services('SetResponseError', '', '', 500)
end
// Add the Type member to the Name object.
If Type NE '' then
If SRP_JSON(hNameObj, 'SETVALUE', 'type', Type) else HTTP_Services('SetResponseError', '', '', 500)
end
// Add the Format member to the Name object.
If Format NE '' then
If SRP_JSON(hNameObj, 'SETVALUE', 'format', Format) else HTTP_Services('SetResponseError', '', '', 500)
end
// Add the EnumList array to the Name object.
If EnumList NE '' then
If SRP_JSON(hEnumAry, 'NEW', 'ARRAY') then
NumItems = Count(EnumList, @FM) + (EnumList NE '')
For ItemCnt = 1 to NumItems
If SRP_JSON(hEnumAry, 'ADDVALUE', EnumList<ItemCnt>) else HTTP_Services('SetResponseError', '', '', 500)
Next ItemCnt
If SRP_JSON(hNameObj, 'SET', 'enum', hEnumAry) else HTTP_Services('SetResponseError', '', '', 500)
SRP_JSON(hEnumAry, 'RELEASE')
end else
// Unable to create the Enum array.
HTTP_Services('SetResponseError', '', '', 500)
end
end
SRP_JSON(SchemaPropertiesObj@, 'SET', Name, hNameObj)
SRP_JSON(hNameObj, 'RELEASE')
If Required then
// Add members to the Required object.
If Len(SchemaRequiredArray@) else
SRP_JSON(SchemaRequiredArray@, 'NEW', 'ARRAY')
end
If Len(SchemaRequiredArray@) then
SRP_JSON(SchemaRequiredArray@, 'ADDVALUE', Name, 'STRING')
end
end
end else
// Unable to create the Name object.
HTTP_Services('SetResponseError', '', '', 500)
end
end else
// Name argument is missing.
HTTP_Services('SetResponseError', '', '', 500)
end
end else
// Unable to create the Schema Properties object.
HTTP_Services('SetResponseError', '', '', 500)
end
end service
//----------------------------------------------------------------------------------------------------------------------
// GetSchema
//
// Returns the serialized JSON object for the current schema. If no schema object has been defined then this will return
// an empty string and a 500 status code will be set. All schema objects and arrays will be released in this service.
//----------------------------------------------------------------------------------------------------------------------
Service GetSchema()
Schema = ''
If SchemaRootObj@ NE '' then
SRP_JSON(SchemaRootObj@, 'SET', 'properties', SchemaPropertiesObj@)
SRP_JSON(SchemaRootObj@, 'SET', 'required', SchemaRequiredArray@)
Schema = SRP_JSON(SchemaRootObj@, 'STRINGIFY', 'FAST')
SRP_JSON(SchemaRequiredArray@, 'RELEASE') ; SchemaRequiredArray@ = ''
SRP_JSON(SchemaPropertiesObj@, 'RELEASE') ; SchemaPropertiesObj@ = ''
SRP_JSON(SchemaRootObj@, 'RELEASE') ; SchemaRootObj@ = ''
end else
HTTP_Services('SetResponseError', '', '', 500)
end
Response = Schema
end service
//----------------------------------------------------------------------------------------------------------------------
// GetURLFromID
//
// ID that needs to be converted to a URL format. - [Required]
//
// Returns a URL segment for the ID passed into the service. This creates a "slug" style URL so that it will be search
// friendly, human readable, and an RESTful.
//----------------------------------------------------------------------------------------------------------------------
Service GetURLFromID(ID)
URL = ID
// Convert all non-friendly URL characters into dashes.
Convert @Upper_Case to @Lower_Case in URL
Convert '!@#$%^&*()+=|<>?,./\"' : "'" to '' in URL
Convert '_' to '' in URL
URL = Trim(URL)
Convert ' ' to '-' in URL
Response = URL
end service
//----------------------------------------------------------------------------------------------------------------------
// GetIDFromURL
//
// URL that needs to be converted to an ID. Note, this is not a complete URL path. This should ordinarily be the end
// point of a URL. - [Required]
// A delimited array of IDs that can be used to validate the converted ID. Any MV delimiter can be used. If there is no
// match found then the ID will match the URL. - [Optional]
//
// Returns the ID based on the URL passed into the service. This service attempts to reverse engineer the URL.
//----------------------------------------------------------------------------------------------------------------------
Service GetIDFromURL(URL, Array, Table)
ID = URL
FoundID = False$
If Array NE '' then
Convert @STM to @FM in Array
Convert @TM to @FM in Array
Convert @SVM to @FM in Array
Convert @VM to @FM in Array
Convert @RM to @FM in Array
NumElements = Count(Array, @FM) + (Array NE '')
For ElementCnt = 1 to NumElements
MatchID = HTTP_JSON_Services('GetURLFromID', Array<ElementCnt>)
If ID _EQC MatchID then
ID = Array<ElementCnt>
FoundID = True$
end
Until FoundID
Next ElementCnt
end
If Not(FoundID) then Error_Services('Add', 'Unable to match the ID based on the provided URL')
Response = ID
end service