Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

add an URI library

git-svn-id: https://svn.parrot.org/parrot/trunk@46601 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
commit 5d46d2815573465e9da8676f1c991433e1498c4c 1 parent f13bead
François Perrad fperrad authored
4 MANIFEST
View
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Thu May 13 18:07:43 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Fri May 14 07:19:07 2010 UT
#
# See below for documentation on the format of this file.
#
@@ -1200,6 +1200,7 @@ runtime/parrot/library/Test/Builder/TestPlan.pir [library]
runtime/parrot/library/Test/Builder/Tester.pir [library]
runtime/parrot/library/Test/Class.pir [library]
runtime/parrot/library/Test/More.pir [library]
+runtime/parrot/library/URI.pir [library]
runtime/parrot/library/YAML/Dumper.pir [library]
runtime/parrot/library/YAML/Dumper/Base.pir [library]
runtime/parrot/library/YAML/Dumper/Default.pir [library]
@@ -1674,6 +1675,7 @@ t/library/test_builder_done_testing.t [test]
t/library/test_builder_tester.t [test]
t/library/test_class.t [test]
t/library/test_more.t [test]
+t/library/uri.t [test]
t/library/uuid.t [test]
t/library/yaml_dumper.t [test]
t/manifest/01-basic.t [test]
1  MANIFEST.generated
View
@@ -279,6 +279,7 @@ runtime/parrot/library/Test/Builder/TestPlan.pbc [main]
runtime/parrot/library/Test/Builder/Tester.pbc [main]
runtime/parrot/library/Test/Class.pbc [main]
runtime/parrot/library/Test/More.pbc [main]
+runtime/parrot/library/URI.pbc [main]
runtime/parrot/library/YAML/Dumper.pbc [main]
runtime/parrot/library/YAML/Dumper/Base.pmc [main]
runtime/parrot/library/YAML/Dumper/Default.pmc [main]
1  config/gen/makefiles/root.in
View
@@ -322,6 +322,7 @@ GEN_LIBRARY = \
$(LIBRARY_DIR)/Test/More.pbc \
$(LIBRARY_DIR)/Tcl/Glob.pbc \
$(LIBRARY_DIR)/TclLibrary.pbc \
+ $(LIBRARY_DIR)/URI.pbc \
$(LIBRARY_DIR)/uuid.pbc \
$(LIBRARY_DIR)/YAML/Dumper/Base.pbc \
$(LIBRARY_DIR)/YAML/Dumper/Default.pbc \
317 runtime/parrot/library/URI.pir
View
@@ -0,0 +1,317 @@
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+URI- Uniform Resource Identifiers
+
+=head2 DESCRIPTION
+
+Simplified port of URI (version 1.54)
+see http://search.cpan.org/~gaas/URI/
+
+=head3 Class URI
+
+=over 4
+
+=cut
+
+.include 'cclass.pasm'
+
+.namespace ['URI']
+
+.sub '' :init :load :anon
+ $P0 = subclass 'String', 'URI'
+.end
+
+=item new_from_string
+
+=cut
+
+.sub 'new_from_string'
+ .param string str
+ .local string scheme
+ $I0 = index str, ':'
+ scheme = substr str, 0, $I0
+ $P1 = new 'Key'
+ set $P1, 'URI'
+ $P2 = new 'Key'
+ set $P2, scheme
+ push $P1, $P2
+ $P0 = get_class $P1
+ unless null $P0 goto L1
+ $P0 = get_class ['URI';'_generic']
+ L1:
+ $P0 = new $P0
+ set $P0, str
+ .return ($P0)
+.end
+
+=item scheme
+
+=cut
+
+.sub 'scheme' :method
+ $S0 = self
+ $S1 = ''
+ $I0 = index $S0, ':'
+ if $I0 < 0 goto L1
+ $S1 = substr $S0, 0, $I0
+ L1:
+ .return ($S1)
+.end
+
+=item opaque
+
+=cut
+
+.sub 'opaque' :method
+ $S0 = self
+ $I2 = 0
+ $I0 = index $S0, ':'
+ if $I0 < 0 goto L1
+ $I2 = $I0 + 1
+ L1:
+ $I1 = length $S0
+ $I3 = $I1 - $I2
+ $I0 = index $S0, '#', $I2
+ if $I0 < 0 goto L2
+ $I3 = $I0 - $I2
+ L2:
+ $S1 = substr $S0, $I2, $I3
+ .return ($S1)
+.end
+
+=item fragment
+
+=cut
+
+.sub 'fragment' :method
+ $S0 = self
+ $I0 = index $S0, '#'
+ $S1 = ''
+ if $I0 < 0 goto L1
+ inc $I0
+ $S1 = substr $S0, $I0
+ L1:
+ .return ($S1)
+.end
+
+=back
+
+=head3 Class URI,_generic
+
+=over 4
+
+=cut
+
+.namespace ['URI';'_generic']
+
+.sub '' :init :load :anon
+ $P0 = subclass ['URI'], ['URI';'_generic']
+.end
+
+=item authority
+
+=cut
+
+.sub 'authority' :method
+ $S0 = self
+ $S1 = ''
+ $I1 = 0
+ $I0 = index $S0, ':'
+ if $I0 < 0 goto L1
+ $I1 = $I0 + 1
+ L1:
+ $I0 = index $S0, '//', $I1
+ unless $I0 == $I1 goto L2
+ $I1 += 2
+ $I2 = length $S0
+ $I0 = index $S0, '/', $I1
+ if $I0 < 0 goto L3
+ $I2 = $I0
+ L3:
+ $I0 = index $S0, '?', $I1
+ if $I0 < 0 goto L4
+ unless $I0 < $I2 goto L4
+ $I2 = $I0
+ L4:
+ $I0 = index $S0, '#', $I1
+ if $I0 < 0 goto L5
+ unless $I0 < $I2 goto L5
+ $I2 = $I0
+ L5:
+ $I3 = $I2 - $I1
+ $S1 = substr $S0, $I1, $I3
+ L2:
+ .return ($S1)
+.end
+
+=item path
+
+=cut
+
+.sub 'path' :method
+ $S0 = self
+ $S1 = ''
+ $I1 = 0
+ $I0 = index $S0, ':'
+ if $I0 < 0 goto L1
+ $I1 = $I0 + 1
+ L1:
+ $I0 = index $S0, '//', $I1
+ unless $I0 == $I1 goto L2
+ $I1 += 2
+ $I2 = length $S0
+ $I0 = index $S0, '/', $I1
+ if $I0 < 0 goto L3
+ $I2 = $I0
+ L3:
+ $I0 = index $S0, '?', $I1
+ if $I0 < 0 goto L4
+ unless $I0 < $I2 goto L4
+ $I2 = $I0
+ L4:
+ $I0 = index $S0, '#', $I1
+ if $I0 < 0 goto L5
+ unless $I0 < $I2 goto L5
+ $I2 = $I0
+ L5:
+ $I1 = $I2
+ L2:
+ $I2 = length $S0
+ $I0 = index $S0, '?', $I1
+ if $I0 < 0 goto L6
+ $I2 = $I0
+ L6:
+ $I0 = index $S0, '#', $I1
+ if $I0 < 0 goto L7
+ unless $I0 < $I2 goto L7
+ $I2 = $I0
+ L7:
+ $I3 = $I2 - $I1
+ $S1 = substr $S0, $I1, $I3
+ .return ($S1)
+.end
+
+=item path_query
+
+=cut
+
+.sub 'path_query' :method
+ $S0 = self
+ $S1 = ''
+ $I1 = 0
+ $I0 = index $S0, ':'
+ if $I0 < 0 goto L1
+ $I1 = $I0 + 1
+ L1:
+ $I0 = index $S0, '//', $I1
+ unless $I0 == $I1 goto L2
+ $I1 += 2
+ $I2 = length $S0
+ $I0 = index $S0, '/', $I1
+ if $I0 < 0 goto L3
+ $I2 = $I0
+ L3:
+ $I0 = index $S0, '?', $I1
+ if $I0 < 0 goto L4
+ unless $I0 < $I2 goto L4
+ $I2 = $I0
+ L4:
+ $I0 = index $S0, '#', $I1
+ if $I0 < 0 goto L5
+ unless $I0 < $I2 goto L5
+ $I2 = $I0
+ L5:
+ $I1 = $I2
+ L2:
+ $I2 = length $S0
+ $I0 = index $S0, '#', $I1
+ if $I0 < 0 goto L6
+ $I2 = $I0
+ L6:
+ $I3 = $I2 - $I1
+ $S1 = substr $S0, $I1, $I3
+ .return ($S1)
+.end
+
+=back
+
+=head3 Class URI,_server
+
+=over 4
+
+=cut
+
+.namespace ['URI';'_server']
+
+.sub '' :init :load :anon
+ $P0 = subclass ['URI';'_generic'], ['URI';'_server']
+.end
+
+=item host
+
+=cut
+
+.sub 'host' :method
+ $S0 = self.'authority'()
+ $I0 = index $S0, ':'
+ if $I0 < 0 goto L1
+ $S0 = substr $S0, 0, $I0
+ L1:
+ .return ($S0)
+.end
+
+=item port
+
+=cut
+
+.sub 'port' :method
+ $S0 = self.'authority'()
+ .local int pos, lastpos
+ lastpos = length $S0
+ pos = index $S0, ':'
+ if pos < 0 goto L1
+ inc pos
+ $I0 = is_cclass .CCLASS_NUMERIC, $S0, pos
+ unless $I0 goto L1
+ $I0 = find_not_cclass .CCLASS_NUMERIC, $S0, pos, lastpos
+ unless $I0 == lastpos goto L1
+ $S1 = substr $S0, pos
+ .return ($S1)
+ L1:
+ .tailcall self.'default_port'()
+.end
+
+.sub 'default_port' :method
+ .return ('')
+.end
+
+=back
+
+=head3 Class URI;http
+
+=cut
+
+.namespace ['URI';'http']
+
+.sub '' :init :load :anon
+ $P0 = subclass ['URI';'_server'], ['URI';'http']
+.end
+
+.sub 'default_port' :method
+ .return ('80')
+.end
+
+=head1 AUTHOR
+
+Francois Perrad
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
137 t/library/uri.t
View
@@ -0,0 +1,137 @@
+#!./parrot
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+t/library/uri.t
+
+=head1 DESCRIPTION
+
+Test the URI library
+
+=head1 SYNOPSIS
+
+ % prove t/library/uri.t
+
+=cut
+
+.sub 'main' :main
+ .include 'test_more.pir'
+
+ load_bytecode 'URI.pir'
+
+ plan(40)
+ test_new()
+ test_uri()
+ test_http()
+.end
+
+.sub 'test_new'
+ $P0 = new ['URI';'_generic']
+ $I0 = isa $P0, ['URI';'_generic']
+ ok($I0, "new ['URI';'_generic']")
+ $I0 = isa $P0, ['URI']
+ ok($I0, "isa ['URI']")
+
+ $P0 = new ['URI';'_server']
+ $I0 = isa $P0, ['URI';'_server']
+ ok($I0, "new ['URI';'_server']")
+ $I0 = isa $P0, ['URI';'_generic']
+ ok($I0, "isa ['URI';'_generic']")
+
+ $P0 = new ['URI';'http']
+ $I0 = isa $P0, ['URI';'http']
+ ok($I0, "new ['URI';'http']")
+ $I0 = isa $P0, ['URI';'_server']
+ ok($I0, "isa ['URI';'_server']")
+.end
+
+.sub 'test_uri'
+ .local pmc factory
+ factory = get_hll_global ['URI'], 'new_from_string'
+
+ $P0 = factory('scheme:scheme-specific-part#fragment')
+ ok($P0, "scheme:scheme-specific-part#fragment")
+ $I0 = isa $P0, ['URI';'_generic']
+ ok($I0, "isa ['URI';'_generic']")
+ $S0 = $P0.'scheme'()
+ is($S0, 'scheme', "scheme")
+ $S0 = $P0.'opaque'()
+ is($S0, 'scheme-specific-part', "opaque")
+ $S0 = $P0.'fragment'()
+ is($S0, 'fragment', "fragment")
+ $S0 = $P0.'authority'()
+ is($S0, '', "no authority")
+ $S0 = $P0.'path'()
+ is($S0, 'scheme-specific-part', "path")
+ $S0 = $P0.'path_query'()
+ is($S0, 'scheme-specific-part', "path_query")
+
+ $P0 = factory('scheme://authority/path?query#fragment')
+ ok($P0, "scheme://authority/path?query#fragment")
+ $I0 = isa $P0, ['URI';'_generic']
+ ok($I0, "isa ['URI';'_generic']")
+ $S0 = $P0.'scheme'()
+ is($S0, 'scheme', "scheme")
+ $S0 = $P0.'opaque'()
+ is($S0, '//authority/path?query', "opaque")
+ $S0 = $P0.'fragment'()
+ is($S0, 'fragment', "fragment")
+ $S0 = $P0.'authority'()
+ is($S0, 'authority', "authority")
+ $S0 = $P0.'path'()
+ is($S0, '/path', "path")
+ $S0 = $P0.'path_query'()
+ is($S0, '/path?query', "path_query")
+
+ $P0 = factory('path?query#fragment')
+ ok($P0, "path?query#fragment")
+ $I0 = isa $P0, ['URI';'_generic']
+ ok($I0, "isa ['URI';'_generic']")
+ $S0 = $P0.'scheme'()
+ is($S0, '', "no scheme")
+ $S0 = $P0.'opaque'()
+ is($S0, 'path?query', "opaque")
+ $S0 = $P0.'fragment'()
+ is($S0, 'fragment', "fragment")
+ $S0 = $P0.'authority'()
+ is($S0, '', "no authority")
+ $S0 = $P0.'path'()
+ is($S0, 'path', "path")
+ $S0 = $P0.'path_query'()
+ is($S0, 'path?query', "path_query")
+.end
+
+.sub 'test_http'
+ .local pmc factory
+ factory = get_hll_global ['URI'], 'new_from_string'
+
+ $P0 = factory('http://www.parrot.org')
+ ok($P0, "http://www.parrot.org")
+ $I0 = isa $P0, ['URI';'http']
+ ok($I0, "isa ['URI';'http']")
+ $S0 = $P0.'scheme'()
+ is($S0, 'http', "scheme")
+ $S0 = $P0.'host'()
+ is($S0, 'www.parrot.org', 'host')
+ $S0 = $P0.'port'()
+ is($S0, '80', 'port')
+
+ $P0 = factory('http://127.0.0.1:8080')
+ ok($P0, "http://127.0.0.1:8080")
+ $I0 = isa $P0, ['URI';'http']
+ ok($I0, "isa ['URI';'http']")
+ $S0 = $P0.'scheme'()
+ is($S0, 'http', "scheme")
+ $S0 = $P0.'host'()
+ is($S0, '127.0.0.1', 'host')
+ $S0 = $P0.'port'()
+ is($S0, '8080', 'port')
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Please sign in to comment.
Something went wrong with that request. Please try again.