* This is a sample program that runs as a web page. It opens a socket * to the web service at http://www.amazon.com, and allows a user to * search their catalog. The returned data is sent as xml and parsed * using the Janus SOAP functions. To make this work at your site you * would need Janus Web, Janus SOAP, Janus Sockets and an Amazon developer's * token. Besides running on the web, this sample shows how a Janus Socket * is opened and managed, and how http data is received and parsed. * ----------------------------------------------------------------------- * * Here are some Janus rules that build some infrastructure, a port, * the necessary security info, and a web rule, all of which define * a socket application that can be called from a web page. * Typically, these rules would run as part of the online startup. * Define your name server. JANUS NAMESERVER 198.242.244.9 53 * A security group that we'll "allow" to use the socket. JANUS DEFINEUSGROUP SIRIUS ALAN ALEX BARRY DME GARY JEFF TOM WEBUSER * Clear-out and re-define the socket port. JANUS FORCE SOAP JANUS DELETE SOAP JANUS DEFINE SOAP * CLSOCK 5 TIMEOUT 4 REMOTE * * * Security (read the manual about this: you need to "allow" people to use the socket). JANUS CLSOCK SOAP ALLOW USGROUP SIRIUS * Start the port. JANUS START SOAP * A rule to allow access to the web page that calls the socket program. JANUS WEB WEB ON /SOAP/* OPEN ALANPROC CMD 'I *' * If you really can't tell what's going on in your socket program, you * can always turn on a very high level of tracing and get a hex dump of * the entire socket conversion in the journal, by turning on this rule. * JANUS TRACE SOAP 8 * ----------------------------------------------------------------------- * BEGIN %BASE_PAGE IS STRING LEN 3 %CAT IS STRING LEN 50 %DEVELOPERS_TOKEN IS STRING LEN 20 %HOST IS STRING LEN 255 %METHOD IS STRING LEN 4 %MSG IS STRING LEN 255 ARRAY (4) %PAGE IS STRING LEN 3 %KEY IS STRING LEN 255 %T IS STRING LEN 255 %WEIGHT IS STRING LEN 5 %S IS LONGSTRING %CATS IS STRING LEN 255 %CATSL IS STRING LEN 255 %CL IS FIXED DP 0 %CNT IS FIXED DP 0 %RL IS FIXED DP 0 %CONN1 IS FLOAT %COUNT IS FLOAT %D IS FLOAT %DT IS FLOAT %PORT IS FLOAT %PRX IS FLOAT %RC IS FLOAT %TEST IS FLOAT %W IS FLOAT %X IS FLOAT %Y IS FLOAT %Z IS FLOAT %DT = $WEB_DATE + (30 * 24 * 60 * 60) %RC = $WEB_ON %RC = $WEB_TYPE('TEXT/HTML') %RC = $WEB_SUB('@@') %RC = $WEB_EXPIRE($WEB_DATE - 1) %RC = $WEB_RESPONSE('PRAGMA', 'NO-CACHE') * You need to get a developer's token from Amazon. Go to * http://www.amazon.com and look for "Web Services". %DEVELOPERS_TOKEN = 'xxxxxxxxxxxxxx' %HOST = 'xml.amazon.com' %PORT = 80 * valid product line values (per Amazon): %CATS = '/baby/books/classical/dvd/electronics/garden/kitchen' - WITH '/magazines/music/pc-hardware/photo/software/toys/universal' - WITH '/vhs/videogames' %CATSL = '/Baby/Books/Classical Music/DVD/Electronics/Outdoor Living' - WITH '/Kitchen & Housewares/Magazines/Popular Music/Computers' - WITH '/Camera & Photo/Software/Toys & Games/Tools & Hardware' - WITH '/Video/Computer & Video Games' * If form was "posted" capture the input and reset cookie. %METHOD = $UPCASE($WEB_HDR_PARM('METHOD')) IF %METHOD EQ 'POST' THEN %TEST = $WEB_PARM('test') %KEY = $WEB_PARM('key') %PAGE = $WEB_PARM('page') %CAT = $WEB_PARM('cat') %WEIGHT = $WEB_PARM('weight') %RC = $WEB_SET_COOKIE('TEST', %TEST, %DT ) %RC = $WEB_SET_COOKIE('KEY', %KEY, %DT ) %RC = $WEB_SET_COOKIE('PAGE', %PAGE, %DT ) %RC = $WEB_SET_COOKIE('CAT', %CAT, %DT ) %RC = $WEB_SET_COOKIE('WEIGHT', %WEIGHT, %DT ) * Else (form method is "get") see if we can populate form from cookie. ELSE %TEST = $WEB_COOKIE_PARM('TEST') %KEY = $WEB_COOKIE_PARM('KEY') %PAGE = $WEB_COOKIE_PARM('PAGE') %CAT = $WEB_COOKIE_PARM('CAT') %WEIGHT = $WEB_COOKIE_PARM('WEIGHT') END IF CALL SENDFORM * We process as "POST" both on a POST and when * user asked for next page from Amazon. %CNT = 1 IF $WEB_PARM('page') NE '' THEN %PAGE = $WEB_PARM('page') %BASE_PAGE = %PAGE %CNT = ((%PAGE-1)*10) + 1 ELSEIF %METHOD NE 'POST' THEN JUMP TO CLOSE END IF IF NOT $VNUM(%PAGE) OR (%PAGE EQ 0) THEN %PAGE = 1 END IF * Connect %RC = $SOCK_ONRESET('SOCKET_ERROR') CONN: %CONN1 = $SOCK_CONN('SOAP', $UPCASE(%HOST), %PORT) IF %CONN1 LT 0 THEN PRINT '$SOCK_CONN failed to make connection. Reason= ' WITH %CONN1 STOP END IF * Set a line-end character and a "parse" token. %RC = $SOCK_SET(%CONN1, 'LINEND', '0D0A') %RC = $SOCK_SET(%CONN1, 'PRSTOK', '0D0A') * Blanks are not allowed in URLs, so substitute "%20". %KEY = $SUBREP(%KEY,' ','%20',,255) * Send the request: %RC = $SOCK_CAPTURE(%CONN1, 'ON') CALL BUILD_HEADER %RC = $SOCK_CAPTURE(%CONN1, 'OFF') %CL = -1 * Loop over the header lines, parsing the http headers: REPEAT %RC = $SOCK_RECVPRS(%CONN1, %T) IF %RC LE 0 THEN %MSG(1) = 'Can''t Access Service' JUMP TO ERRX END IF * Blank line indicates "end-of-header". IF %T EQ '' THEN LOOP END ELSEIF $SUBSTR(%T, 1, 16) EQ - 'Content-Length: ' THEN %CL = $SUBSTR(%T, 16) END IF END REPEAT * Pull the remaining info (the XML) into a longstring. %RL = $SOCK_RECV(%CONN1, %S) * Length of received string should be same as content length. IF %RL LT %CL THEN %MSG(1) = 'XML Content Error:' %MSG(2) = 'Packet Length (' WITH %RL WITH ') doesn''t match ' - WITH 'content length in header (' WITH %CL WITH ').' JUMP TO ERRX END IF SOCK_END: * Initialize an XML doc. %D = $XML_DOC %RC = $XML_SET(%D,'NAMESPACE','IGNORE') * Now deserialize the received string into the doc. * NB: We skip this in test mode because sometimes the deserialization * fails when the XML is faulty. If we hit the $XML_STR2DOC function * we won't be able to see the faulty XML (though the error message * from the failed function call may be the best diagnostic we're * going to get anyway). IF NOT %TEST THEN %S = $XML_STR2DOC(%D, %S, 'DTD_IGNORE') END IF * Close the socket. %RC = $SOCK_CLOSE(%CONN1) * If we're testing we just print the raw XML and exit. * Why print the %S longstring in 1K chunks? Because if the * longstring is longer than LOBUFF, the print will be truncated. IF %TEST THEN PRINT '' FOR %X FROM 1 TO $LSTR_LEN(%S) BY 1024 PRINT $LSTR_SUBSTR(%S,%X,1024) END FOR PRINT $VIEW('LOBUFF') * %RC = $XML_PRINT(%D,'/') PRINT '' JUMP TO CLOSE END IF * Call the appropriate display routine. IF %WEIGHT EQ 'lite' THEN CALL LITEWEIGHT ELSE CALL HEAVYWEIGHT END IF CALL ERROR_DISPLAY * Close the page. CLOSE: TEXT END TEXT STOP * ... End of mainline. ERRX: %RC = $WEB_FLUSH %RC = $WEB_TYPE('text/html') %RC = $WEB_SET_COOKIE('TEST', %TEST, %DT ) %RC = $WEB_SET_COOKIE('KEY', %KEY, %DT ) %RC = $WEB_SET_COOKIE('PAGE', %PAGE, %DT ) %RC = $WEB_SET_COOKIE('CAT', %CAT, %DT ) %RC = $WEB_SET_COOKIE('WEIGHT', %WEIGHT, %DT ) TEXT System error

System error

System terminated due to error.
Procedure causing error: AMAZON1.HTML Error message:
{%MSG(1)} {%MSG(2)} {%MSG(3)} END TEXT %RC = $WEB_DONE STOP * Error routine (jump location) for socket reset errors. SOCKET_ERROR: %MSG(1) = $SOCK_ERRINFO('CODE') %MSG(2) = $SOCK_ERRINFO('SOCKNUM') %MSG(3) = $SOCK_ERRINFO('FUN') TEXT System error

System error

System terminated due to error.
Procedure causing error: AMAZON1.HTML. The connection was unexpectedly lost. The last sockets error operation was:

Function: {%MSG(1)}

Return code: {%MSG(2)}

Socket: {%MSG(3)}

END TEXT %RC = $WEB_DONE STOP * End of Mainline / Beginning of Subroutines * * -------------------------------------------------- * * Subroutine to send the Amazon search request form. * SENDFORM: SUBROUTINE TEXT Janus Sockets Sample -- Amazon Search Page
Search the Amazon database:
Search for: In (category):
Detail: Display raw XML:
END TEXT END SUBROUTINE SENDFORM * Subroutine to build the URL link to the Amazon Web Service. * Note that the final blank line in the TEXT block is critical * because it signals "end of header" in the http protocol. BUILD_HEADER: SUBROUTINE TEXT GET http://{%HOST}/onca/xml?v=1.0&t=webservices-20&- dev-t={%DEVELOPERS_TOKEN}&- KeywordSearch={%KEY}&- mode={%CAT}&- type={%WEIGHT}&- page={%PAGE}&f=xml HTTP/1.0 Accept-Language: en Accept-Charset: iso-8859-1,*,utf-8 Host: {%HOST} END TEXT END SUBROUTINE BUILD_HEADER * Lite-weight display routine. LITEWEIGHT: SUBROUTINE * Other values passed by Amazon in the "lite" view, which are not * used in the following html block: * * $XML_VAL(%Y, 'Asin', %X) * $XML_VAL(%Y, 'Manufacturer', %X) * $XML_VAL(%Y, 'ImageUrlMedium', %X) * $XML_VAL(%Y, 'ImageUrlLarge', %X) * $XML_VAL(%Y, 'ListPrice', %X) CALL PAGE_POINTERS %Y = $XML_NL FOR %X FROM 1 TO $XML_NODES(%Y, %D, '/ProductInfo/Details') TEXT
{%CNT} {$XML_VAL(%Y, 'ProductName', %X)} ({$XML_VAL(%Y, 'ReleaseDate', %X)}) -- {$XML_VAL(%Y, 'Catalog', %X)} Amazon's Price: {$XML_VAL(%Y, 'OurPrice', %X)}
END TEXT %CNT = %CNT + 1 END FOR CALL PAGE_POINTERS END SUBROUTINE LITEWEIGHT * Display routine that shows full Amazon detail. HEAVYWEIGHT: SUBROUTINE CALL PAGE_POINTERS %Y = $XML_NL FOR %X FROM 1 TO $XML_NODES(%Y, %D, '/ProductInfo/Details') TEXT END TEXT %W = $XML_NL FOR %Z FROM 1 TO $XML_NODES(%W, %D, '/ProductInfo/Details/Reviews/CustomerReview') TEXT END TEXT END FOR TEXT
{%CNT} {$XML_VAL(%Y, 'ProductName', %X)}
({$XML_VAL(%Y, 'ReleaseDate', %X)}) -- {$XML_VAL(%Y, 'Catalog', %X)}
Amazon's Price: {$XML_VAL(%Y, 'OurPrice', %X)}
List Price: {$XML_VAL(%Y, 'ListPrice', %X)}
Used Price: {$XML_VAL(%Y, 'UsedPrice', %X)}
Catalog: {$XML_VAL(%Y, 'Catalog', %X)}
Media: {$XML_VAL(%Y, 'Media', %X)} Sales Rank: {$XML_VAL(%Y, 'SalesRank', %X)} By: {$XML_VAL(%Y, 'Manufacturer', %X)} Availability: {$XML_VAL(%Y, 'Availability', %X)}

Avg. Customer Rating: {$XML_VAL(%Y, 'Reviews/AvgCustomerRating', %X)} Reviews:
Customer Rating: {$XML_VAL(%W, 'Rating', %Z)} Summary: {$XML_VAL(%W, 'Summary', %Z)}

Comments: {$XML_VAL(%W, 'Comment', %Z)}

END TEXT %CNT = %CNT + 1 END FOR CALL PAGE_POINTERS END SUBROUTINE HEAVYWEIGHT * This subroutine prints the "Get next 10" and "Get previous 10" links. PAGE_POINTERS: SUBROUTINE PRINT '
' IF %BASE_PAGE GT 1 THEN %X = %PAGE - 1 PRINT '<.-- prev 10 |' END IF IF $XML_COUNT(%D,'/ProductInfo/Details') EQ 10 THEN %PAGE = %PAGE + 1 PRINT 'next 10 -- >.' END IF PRINT '
' END SUBROUTINE PAGE_POINTERS * Display errors ERROR_DISPLAY: SUBROUTINE %Y = $XML_NL FOR %X FROM 1 TO $XML_NODES(%Y, %D, '/ProductInfo') TEXT
{$XML_VAL(%Y, 'ErrorMsg', %X)}
END TEXT END FOR END SUBROUTINE ERROR_DISPLAY END