*/ Connect to Amazon's Web Service via SOAP (3270-display version) /* * 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. * Normally, these commands wouldn't be in the actual socket procedure. * Some basic infrastructure. 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 240 REMOTE * * MASTER * 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 via the following command: * JANUS TRACE SOAP 8 */ Connect to Amazon's Web Service via SOAP (3270-display version) /* Begin %cat Is String Len 50 %developersToken Is String Len 20 %host Is String Len 255 %line Is String Len 80 %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 %cl Is Fixed DP 0 %cnt Is Fixed DP 0 %rl Is Fixed DP 0 %conn1 Is Float %d Is Object XmlDoc %l Is Float %port Is Float %rc Is Float %scrnLen Is Float %startPos Is Float %test Is Float %w Is Object XmlNodelist %x Is Float %y Is Object XmlNodelist %z Is Float * A screen for user-input. Screen main Max PFkey 12 Default Title Read White Bright Reread White Bright Default Prompt Read Blue Reread Blue Default Input Read Green Reread Green Tag Red With '*' Default Cursor key Title '------------- Janus Soap Samples / Amazon Web Service Query -----------------' At 2 Bright Skip 1 Line Prompt 'Search for:' At 2 - Input key At 14 Len 63 NoCase Pad '_' Prompt 'Choose an Amazon Category from the list below:' At 2 - Input cat At 49 Len 20 NoCase Pad '_' Prompt 'Detail (F="Full", N="Normal"):' At 2 - Input weight At 34 Len 1 Default 'N' - Prompt 'Display raw XML (Y/N):' At 38 - Input test At 61 Len 1 Default 'N' Skip 1 Line Prompt '----------------------- Valid Amazon Categories -------------------------' At 5 Prompt 'baby' At 5 White Prompt '(Baby toys, clothes, etc.)' - Prompt 'music' At 43 White Prompt '(Popular Music)' Prompt 'books' At 5 White Prompt '(Books)' - Prompt 'pc-hardware' At 43 White Prompt '(Computers)' Prompt 'classical' At 5 White Prompt '(Classical Music)' - Prompt 'photo' At 43 White Prompt '(Camera & Photo)' Prompt 'dvd' At 5 White Prompt '(DVD)' - Prompt 'software' At 43 White Prompt '(Software)' Prompt 'electronics' At 5 White Prompt '(Electronics)' - Prompt 'toys' At 43 White Prompt '(Toys & Games)' Prompt 'garden' At 5 White Prompt '(Outdoor Living)' - Prompt 'universal' At 43 White Prompt '(Tools & Hardware)' Prompt 'kitchen' At 5 White Prompt '(Kitchen & Housewares)' - Prompt 'vhs' At 43 White Prompt '(Video)' Prompt 'magazines' At 5 White Prompt '(Magazines)' - Prompt 'videogames' At 43 White Prompt '(Computer & Video Games)' Skip 2 Line Prompt msg1 At 2 Len 77 Prompt msg2 At 2 Len 77 Prompt msg3 At 2 Len 77 Default - '---------------------------------------------------------------------------------' Prompt 'F1/Help F3/Exit' At 2 End Screen * A screen to display the returned XML from Amazon. Screen comout Max PFkey 12 Default Title Read White Bright Reread White Bright Default Prompt Read Blue Reread Blue Default Input Read Green Reread Green Tag Red With '*' Title '------------- Janus Soap Samples / Amazon Web Service Results ---------------' At 2 Bright Prompt 'Line:' At 2 Prompt lineNo At 8 Len 5 Bright Prompt line1 At 2 Len 77 Prompt line2 At 2 Len 77 Prompt line3 At 2 Len 77 Prompt line4 At 2 Len 77 Prompt line5 At 2 Len 77 Prompt line6 At 2 Len 77 Prompt line7 At 2 Len 77 Prompt line8 At 2 Len 77 Prompt line9 At 2 Len 77 Prompt line10 At 2 Len 77 Prompt line11 At 2 Len 77 Prompt line12 At 2 Len 77 Prompt line13 At 2 Len 77 Prompt line14 At 2 Len 77 Prompt line15 At 2 Len 77 Prompt line16 At 2 Len 77 Prompt line17 At 2 Len 77 Prompt line18 At 2 Len 77 Prompt line19 At 2 Len 77 Prompt msg At 2 Len 77 Default - '---------------------------------------------------------------------------------' Prompt ' F3/Exit' At 2 Prompt ' F7/Up F8/Down' At 2 END Screen * You need to get a developer's token from Amazon. Go to * http://www.amazon.com and look for "Web Services". %developersToken = 'xxxxxxxxxxxxxx' %host = 'xml.amazon.com' %port = 80 Prepare Screen main RD1: Call $ListDel(%l) %l = $ListNew %main:msg1 = $Pad(%main:msg1,' ',77) %main:msg2 = $Pad(%main:msg2,' ',77) %main:msg3 = $Pad(%main:msg3,'-',77) Read Screen main No Reread With Cursor Reread Screen main %main:msg1 = '' %main:msg2 = '' %main:msg3 = '' %key = %main:key %cat = %main:cat %test = 0 If %main:test EQ 'Y' Then %test = 1 End If %weight = 'lite' If %main:weight EQ 'F' Then %weight = 'heavy' End If Jump To (PX,PX,P3,PX,PX,PX,PX,PX,PX,PX,PX,PX) %main:PFkey Jump To P0 * HELP processing. P3: Stop PX: %msg(1) = 'PF Key is not active.' Jump To ERRX * No PF Key, so process the user input. P0: If Not $Vnum(%page) Or (%page EQ 0) Then %page = 1 End If * Set up the remote connection. Call $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. Call $Sock_Set(%conn1, 'LINEND', '0D0A') Call $Sock_Set(%conn1, 'PRSTOK', '0D0A') * Blanks are not allowed in URLs, so substitute "%20". %key = $Subrep(%key,' ','%20',,255) * Send the request: * Note that the final blank line in the Text block is critical * because it signals "end of header" in the http protocol. Call $Sock_Send(%conn1, 'GET http://' With %host With '/onca/soap2?v=1.0&t=webservices-20&' - With 'dev-t=' With %developersToken With '&' - With 'KeywordSearch=' With %key With '&' - With 'mode=' With %cat With '&' - With 'type=' With %weight With '&' - With 'page=' With %page With '&' - With 'f=xml ') Call $Sock_Sendln(%conn1,'HTTP/1.0 Accept-Language: en ' - With 'Accept-Charset: iso-8859-1,*,utf-8 Host: ' With %host,) Call $Sock_Send(%conn1,'','FIN') %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. RC=' With %rc Jump To ERRX Loop End 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 = New * 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 LoadXml method * 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 Call %d:LoadXml(%s, 'DTD_IGNORE') End If * Close the socket. Call $Sock_Close(%conn1) * If we're testing we just print the raw XML and exit. * We print the %s longstring in 1K chunks because if the * longstring is longer than LOBUFF, the print would truncate. If %test Then Call $List_Capture(%l) For %x From 1 To $Lstr_Len(%s) BY 1024 Print $Lstr_Substr(%s,%x,1024) End For Call $List_Capture * Call %d:Print(%d,'/') Jump To CLOSE End If * Call the appropriate display routine. If $Upcase(%main:weight) EQ 'F' Then Call heavyWeight Else Call liteWeight End If CLOSE: If $ListCnt(%l) Then Call displayOutput End If Jump To RD1 * ... End of mainline. * Try for a bit of consistency in error handling... SOCKET_ERROR: %msg(1) = $Sock_Errinfo('CODE') %msg(2) = $Sock_Errinfo('SOCKNUM') %msg(3) = $Sock_Errinfo('FUN') %main:msg1 = 'System terminated / connection unexpected lost.' %main:msg2 = 'Failing Function: ' With %msg(3) With - ' Return code: ' With %msg(1) %main:msg3 = 'Socket: ' With %msg(2) Jump To ERRY ERRX: %main:msg1 = %msg(1) %main:msg2 = %msg(2) %main:msg3 = %msg(3) * Close the socket. Call $Sock_Close(%conn1) ERRY: Modify %main:msg1 To Bright Modify %main:msg2 To Bright Modify %main:msg3 To Bright Tag %main:key %msg(1) = '' %msg(2) = '' %msg(3) = '' Jump To RD1 * End of Mainline / Beginning of Subroutines * * -------------------------------------------------- * * Lite-weight display routine. liteWeight: Subroutine * Other values passed by Amazon in the "lite" view, which are not * used in the following html block: * * %y:Item(%x):Value('Asin') * %y:Item(%x):Value('Manufacturer') * %y:Item(%x):Value('ImageUrlMedium') * %y:Item(%x):Value('ImageUrlLarge') * %y:Item(%x):Value('ListPrice') Call $List_Capture(%l) %y = %d:SelectNodes('/ProductInfo/Details') For %x From 1 To %y:Count Text {%cnt} Product name: {%y:Item(%x):Value('ProductName')} Catalog: {%y:Item(%x):Value('Catalog')} Release date: {%y:Item(%x):Value('ReleaseDate')} Image source: {%y:Item(%x):Value('ImageUrlSmall')} Item URL: {%y:Item(%x):Value('@url')} Amazon's Price: {%y:Item(%x):Value('OurPrice')} End Text %cnt = %cnt + 1 End For Call $List_Capture End Subroutine liteWeight * Display routine that shows full Amazon detail. heavyWeight: Subroutine Call $List_Capture(%l) %y = %d:SelectNodes('/ProductInfo/Details') For %x From 1 To %y:Count Text {%cnt} Product name: {%y:Item(%x):Value('ProductName')} Catalog: {%y:Item(%x):Value('Catalog')} Release date: {%y:Item(%x):Value('ReleaseDate')} Image source: {%y:Item(%x):Value('ImageUrlLarge')} Item URL: {%y:Item(%x):Value('@url')} Amazon's Price: {%y:Item(%x):Value('OurPrice')} List Price: {%y:Item(%x):Value('ListPrice')} Used Price: {%y:Item(%x):Value('UsedPrice')} Media: {%y:Item(%x):Value('Media')} Sales Rank: {%y:Item(%x):Value('SalesRank')} Manufacturer: {%y:Item(%x):Value('Manufacturer')} Availability: {%y:Item(%x):Value('Availability')} Avg. Customer Rating: {%y:Item(%x):Value('Reviews/AvgCustomerRating')} * ---- Reviews ---- * End Text %w = %d:SelectNodes('/ProductInfo/Details/Reviews/CustomerReview') For %z From 1 To %w:Count Text Customer Rating: {%w:Item(%z):Value('Rating')} Summary: {%w:Item(%z):Value('Summary')} Comments: {%w:Item(%z):Value('Comment')} End Text End For Text * --------------------------------------- * End Text %cnt = %cnt + 1 End For Call $List_Capture End Subroutine heavyWeight displayOutput: Subroutine REDO: %x = 1 %startPos = 1 %scrnLen = 20 POP: For %z From 1 To %scrnLen %line = 'comout:line' With %z If %startPos And (%startPos + %z - 1 LE $ListCnt(%l)) Then :%line = $ListInf(%l,%startPos+%z-1) Else :%line = '' End If End For %comout:lineNo = $Pad(%startPos,' ',5) If %startPos EQ 1 Then %comout:msg = ' Top of XML doc.' Jump To ERRX2 Elseif %startPos GT ($ListCnt(%l)-%scrnLen) Then %comout:msg = ' Bottom of XML doc.' Jump To ERRX2 End If Prepare Screen comout *-> Read screen and process. RD0: Read Screen comout No Reread Reread Screen comout %comout:msg = $Pad('-','-',77) Modify %comout:msg To Dim CD1: Jump To (PY,PY,P3A,PY,PY,PY,P7A,P8A,PY,PY,PY,PY) %comout:PFkey ERRX2: %comout:msg = $Pad(%comout:msg,'-',76) Modify %comout:msg To Bright White Jump To RD0 *-> PF Keys. PY: %comout:msg = ' Invalid PF key.' Jump To ERRX2 P3A: Return P7A: %startPos = $Max(%startPos - %scrnLen,1) Jump To POP P8A: %startPos = $Min(%startPos+%scrnLen,$ListCnt(%l)-%scrnLen+1) %startPos = $Max(%startPos,1) Jump To POP End Subroutine DisplayOutput End