[svn:parrot] r46759 - in trunk: examples/io runtime/parrot/library

[fperrad at svn.parrot.org]

Author: fperrad
Date: Tue May 18 14:08:09 2010
New Revision: 46759
URL: https://trac.parrot.org/parrot/changeset/46759

Log:
[LWP] fix POST to smolder

Modified:
   trunk/examples/io/post.pir
   trunk/runtime/parrot/library/LWP.pir

Modified: trunk/examples/io/post.pir
==============================================================================
--- trunk/examples/io/post.pir	Tue May 18 13:48:46 2010	(r46758)
+++ trunk/examples/io/post.pir	Tue May 18 14:08:09 2010	(r46759)
@@ -27,20 +27,19 @@
     push contents, "EXPERIMENTAL LWP.pir"
     push contents, 'report_file'
     $P0 = new 'FixedStringArray'
-    set $P0, 6
-    $P0[0] = 'parrot_test_run.tar.gz' # filename
-    $P0[1] = 'parrot_test_run.tar.gz' # usename
-    $P0[2] = 'Content-Type'
-    $P0[3] = 'application/x-tar'
-    $P0[4] = 'Content-Encoding'
-    $P0[5] = 'gzip'
+    set $P0, 1
+    $P0[0] = 'parrot_test_run.tar.gz'
     push contents, $P0
     load_bytecode 'LWP.pir'
     .const string url = 'http://smolder.plusthree.com/app/projects/process_add_report/8'
     .local pmc ua, response
     ua = new ['LWP';'UserAgent']
     ua.'show_progress'(1)
-    response = ua.'post'(url, contents :flat, 'form-data' :named('Content-Type'), 'TE, close' :named('Connection'), 'deflate,gzip;q=0.3' :named('TE'))
+    response = ua.'post'(url, contents :flat, 'form-data' :named('Content-Type'), 'close' :named('Connection'))
+    $I0 = response.'code'()
+    unless $I0 == 302 goto L1
+    say "report uploaded"
+  L1:
 .end
 
 # Local Variables:

Modified: trunk/runtime/parrot/library/LWP.pir
==============================================================================
--- trunk/runtime/parrot/library/LWP.pir	Tue May 18 13:48:46 2010	(r46758)
+++ trunk/runtime/parrot/library/LWP.pir	Tue May 18 14:08:09 2010	(r46759)
@@ -297,6 +297,12 @@
 .sub 'redirect_ok' :method
     .param pmc new_request
     .param pmc response
+    $P0 = response.'request'()
+    $S0 = $P0.'method'()
+    if $S0 == 'GET' goto L1
+    if $S0 == 'HEAD' goto L1
+    .return (0)
+  L1:
     # work in progress
     .return (1)
 .end