t/library/lwp.t

   1 #!./parrot
   2 # Copyright (C) 2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/library/lwp.t
   8
   9 =head1 DESCRIPTION
  10
  11 Test the LWP library
  12
  13 =head1 SYNOPSIS
  14
  15     % prove t/library/lwp.t
  16
  17 =cut
  18
  19 .sub 'main' :main
  20     .include 'test_more.pir'
  21
  22     load_bytecode 'LWP/UserAgent.pir'
  23     load_bytecode 'osutils.pbc'
  24
  25     plan(48)
  26     test_new()
  27     test_unknown_protocol()
  28     test_bad_request()
  29     test_file_not_found()
  30     test_file()
  31     test_file_head()
  32     test_file_post_delete()
  33     test_file_proxy()
  34 .end
  35
  36 .sub 'test_new'
  37     $P0 = new ['LWP';'UserAgent']
  38     $I0 = isa $P0, ['LWP';'UserAgent']
  39     ok($I0, "new ['LWP';'UserAgent']")
  40
  41     $P0 = new ['LWP';'Protocol';'file']
  42     $I0 = isa $P0, ['LWP';'Protocol';'file']
  43     ok($I0, "new ['LWP';'Protocol';'file']")
  44     $I0 = isa $P0, ['LWP';'Protocol']
  45     ok($I0, "isa ['LWP';'Protocol']")
  46
  47     $P0 = new ['LWP';'Protocol';'http']
  48     $I0 = isa $P0, ['LWP';'Protocol';'http']
  49     ok($I0, "new ['LWP';'Protocol';'http']")
  50     $I0 = isa $P0, ['LWP';'Protocol']
  51     ok($I0, "isa ['LWP';'Protocol']")
  52
  53     $P0 = new ['HTTP';'Request']
  54     $I0 = isa $P0, ['HTTP';'Request']
  55     ok($I0, "new ['HTTP';'Request']")
  56     $I0 = isa $P0, ['HTTP';'Message']
  57     ok($I0, "isa ['HTTP';'Message']")
  58     $P0 = new ['HTTP';'Response']
  59     $I0 = isa $P0, ['HTTP';'Response']
  60     ok($I0, "new ['HTTP';'Response']")
  61     $I0 = isa $P0, ['HTTP';'Message']
  62     ok($I0, "isa ['HTTP';'Message']")
  63 .end
  64
  65 .sub 'test_unknown_protocol'
  66     .local pmc ua, response
  67     ua = new ['LWP';'UserAgent']
  68     response = ua.'get'('unk:foo/bar')
  69     $I0 = isa response, ['HTTP';'Response']
  70     ok($I0, "GET unk:foo/bar")
  71     $I0 = response.'code'()
  72     is($I0, 501, "code")
  73     $S0 = response.'message'()
  74     is($S0, "Not Implemented", "message")
  75     $I0 = response.'is_error'()
  76     ok($I0, "is error")
  77 .end
  78
  79 .sub 'test_bad_request'
  80     .local pmc ua, response
  81     ua = new ['LWP';'UserAgent']
  82     response = ua.'post'('file:foo/bar')
  83     $I0 = isa response, ['HTTP';'Response']
  84     ok($I0, "GET unk:foo/bar")
  85     $I0 = response.'code'()
  86     is($I0, 400, "code bad request")
  87     $S0 = response.'message'()
  88     is($S0, "Library does not allow method POST for 'file:' URLs", "message")
  89     $I0 = response.'is_error'()
  90     ok($I0, "is error")
  91 .end
  92
  93 .sub 'test_file_not_found'
  94     unlink('t/no_file')
  95     .local pmc ua, response
  96     ua = new ['LWP';'UserAgent']
  97     response = ua.'get'('file:t/no_file')
  98     $I0 = isa response, ['HTTP';'Response']
  99     ok($I0, "GET file:t/no_file")
 100     $I0 = response.'code'()
 101     is($I0, 404, "code")
 102     $S0 = response.'message'()
 103     is($S0, "File `t/no_file' does not exist", "message")
 104     $I0 = response.'is_error'()
 105     ok($I0, "is error")
 106 .end
 107
 108 .sub 'test_file'
 109     .local pmc ua, response
 110     ua = new ['LWP';'UserAgent']
 111     response = ua.'get'('file:t/library/lwp.t')
 112     $I0 = isa response, ['HTTP';'Response']
 113     ok($I0, "GET file:t/library/lwp.t")
 114     $I0 = response.'code'()
 115     is($I0, 200, "code")
 116     $I0 = response.'is_success'()
 117     ok($I0, "is success")
 118     $S0 = response.'content'()
 119     $I0 = index $S0, 'Test the LWP library'
 120     $I0 = $I0 > 0
 121     ok($I0, "content looks good")
 122     $I0 = response.'get_header'('Content-Length')
 123     $I0 = $I0 > 2000
 124     ok($I0, "Content-Length")
 125     $S0 = response.'get_header'('Last-Modified')
 126     diag($S0)
 127     $I0 = index $S0, 'GMT'
 128     $I0 = $I0 > 0
 129     ok($I0, "Last-Modified contains GMT")
 130 .end
 131
 132 .sub 'test_file_head'
 133     .local pmc ua, response
 134     ua = new ['LWP';'UserAgent']
 135     response = ua.'head'('file:t/library/lwp.t')
 136     $I0 = isa response, ['HTTP';'Response']
 137     ok($I0, "HEAD file:t/library/lwp.t")
 138     $I0 = response.'code'()
 139     is($I0, 200, "code")
 140     $I0 = response.'is_success'()
 141     ok($I0, "is success")
 142     $S0 = response.'content'()
 143     is($S0, '', "no content")
 144     $I0 = response.'get_header'('Content-Length')
 145     $I0 = $I0 > 2000
 146     ok($I0, "Content-Length")
 147     $S0 = response.'get_header'('Last-Modified')
 148     diag($S0)
 149     $I0 = index $S0, 'GMT'
 150     $I0 = $I0 > 0
 151     ok($I0, "Last-Modified contains GMT")
 152 .end
 153
 154 .sub 'test_file_post_delete'
 155     .const string data = "the file contains some text"
 156     .const string filename = 't/library/file.txt'
 157     .const string url = 'file:t/library/file.txt'
 158     unlink(filename)
 159
 160     .local pmc ua, response
 161     ua = new ['LWP';'UserAgent']
 162
 163     response = ua.'put'(url, data)
 164     $I0 = isa response, ['HTTP';'Response']
 165     ok($I0, "PUT file:t/library/file.txt")
 166     $I0 = response.'code'()
 167     is($I0, 200, "code")
 168     $I0 = response.'is_success'()
 169     ok($I0, "is success")
 170     $S0 = slurp(filename)
 171     is($S0, data, "file content comparison")
 172
 173     response = ua.'delete'(url)
 174     $I0 = isa response, ['HTTP';'Response']
 175     ok($I0, "DELETE file:t/library/file.txt")
 176     $I0 = response.'code'()
 177     is($I0, 200, "code")
 178     $I0 = response.'is_success'()
 179     ok($I0, "is success")
 180
 181     response = ua.'delete'(url)
 182     $I0 = isa response, ['HTTP';'Response']
 183     ok($I0, "DELETE file:t/library/file.txt")
 184     $I0 = response.'code'()
 185     is($I0, 404, "code")
 186     $S0 = response.'message'()
 187     is($S0, "File `t/library/file.txt' does not exist", "message")
 188     $I0 = response.'is_error'()
 189     ok($I0, "is error")
 190 .end
 191
 192 .sub 'test_file_proxy'
 193     .local pmc ua, response
 194     ua = new ['LWP';'UserAgent']
 195     ua.'proxy'('file', 'file://proxy.net')
 196     response = ua.'get'('file:t/library/lwp.t')
 197     $I0 = isa response, ['HTTP';'Response']
 198     ok($I0, "GET file:t/library/lwp.t via a proxy")
 199     $I0 = response.'code'()
 200     is($I0, 400, "code")
 201     $S0 = response.'message'()
 202     is($S0, "You can not proxy through the filesystem", "message")
 203     $I0 = response.'is_error'()
 204     ok($I0, "is error")
 205 .end
 206
 207 # Local Variables:
 208 #   mode: pir
 209 #   fill-column: 100
 210 # End:
 211 # vim: expandtab shiftwidth=4 ft=pir: