Skip to content
Browse files

[library] add Archive/TAR

git-svn-id: https://svn.parrot.org/parrot/trunk@46127 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
1 parent 7ab56b0 commit 347157b82756f6e4441ef4978d0ee7d9f7f6bd87 @fperrad fperrad committed Apr 29, 2010
Showing with 457 additions and 2 deletions.
  1. +3 −1 MANIFEST
  2. +4 −1 MANIFEST.SKIP
  3. +1 −0 MANIFEST.generated
  4. +1 −0 config/gen/makefiles/root.in
  5. +373 −0 runtime/parrot/library/Archive/TAR.pir
  6. +75 −0 t/library/archive_tar.t
View
4 MANIFEST
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Thu Apr 29 00:39:52 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Thu Apr 29 08:09:27 2010 UT
#
# See below for documentation on the format of this file.
#
@@ -1124,6 +1124,7 @@ runtime/parrot/include/fp_equality.pasm [library]
runtime/parrot/include/hllmacros.pir [library]
runtime/parrot/include/test_more.pir [library]
runtime/parrot/languages/parrot/parrot.pir [library]
+runtime/parrot/library/Archive/TAR.pir [library]
runtime/parrot/library/CGI/QueryHash.pir [library]
runtime/parrot/library/Config/JSON.pir [library]
runtime/parrot/library/Configure/genfile.pir [library]
@@ -1636,6 +1637,7 @@ t/examples/tutorial.t [test]
t/harness [test]
t/harness.pir [test]
t/include/fp_equality.t [test]
+t/library/archive_tar.t [test]
t/library/cgi_query_hash.t [test]
t/library/configure.t [test]
t/library/coroutine.t [test]
View
5 MANIFEST.SKIP
@@ -1,6 +1,6 @@
# ex: set ro:
# $Id$
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Apr 28 02:20:18 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Thu Apr 29 08:12:30 2010 UT
#
# This file should contain a transcript of the svn:ignore properties
# of the directories in the Parrot subversion repository. (Needed for
@@ -535,6 +535,9 @@
^runtime/parrot/library/PAST/
^runtime/parrot/library/config\.pir$
^runtime/parrot/library/config\.pir/
+# generated from svn:ignore of 'runtime/parrot/library/Archive/'
+^runtime/parrot/library/Archive/.*\.pbc$
+^runtime/parrot/library/Archive/.*\.pbc/
# generated from svn:ignore of 'runtime/parrot/library/CGI/'
^runtime/parrot/library/CGI/.*\.pbc$
^runtime/parrot/library/CGI/.*\.pbc/
View
1 MANIFEST.generated
@@ -124,6 +124,7 @@ runtime/parrot/include/timer.pasm [main]
runtime/parrot/include/tm.pasm [main]
runtime/parrot/include/vtable_methods.pasm [main]
runtime/parrot/include/warnings.pasm [main]
+runtime/parrot/library/Archive/TAR.pbc [main]
runtime/parrot/library/CGI/QueryHash.pbc [main]
runtime/parrot/library/Config/JSON.pbc [main]
runtime/parrot/library/Configure/genfile.pbc [main]
View
1 config/gen/makefiles/root.in
@@ -252,6 +252,7 @@ GEN_MODULES = \
lib/Parrot/OpLib/core.pm
GEN_LIBRARY = \
+ $(LIBRARY_DIR)/Archive/TAR.pbc \
$(LIBRARY_DIR)/CGI/QueryHash.pbc \
$(LIBRARY_DIR)/Crow.pbc \
$(LIBRARY_DIR)/config.pbc \
View
373 runtime/parrot/library/Archive/TAR.pir
@@ -0,0 +1,373 @@
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+Archive/TAR
+
+=head2 DESCRIPTION
+
+Partial port of Archive::TAR (version 1.60)
+
+See L<http://search.cpan.org/~bingos/Archive-Tar/>
+
+=cut
+
+.include 'stat.pasm'
+
+=head3 Class Archive;TAR;File
+
+=over 4
+
+=cut
+
+.namespace ['Archive';'TAR';'File']
+
+.sub '' :init :load :anon
+ load_bytecode 'osutils.pbc' # basename, dirname
+ $P0 = newclass ['Archive';'TAR';'File']
+ $P0.'add_attribute'('name')
+ $P0.'add_attribute'('mode')
+ $P0.'add_attribute'('uid')
+ $P0.'add_attribute'('gid')
+ $P0.'add_attribute'('size')
+ $P0.'add_attribute'('mtime')
+ $P0.'add_attribute'('type')
+ $P0.'add_attribute'('linkname')
+ $P0.'add_attribute'('magic')
+ $P0.'add_attribute'('version')
+ $P0.'add_attribute'('uname')
+ $P0.'add_attribute'('gname')
+ $P0.'add_attribute'('devmajor')
+ $P0.'add_attribute'('devminor')
+ $P0.'add_attribute'('prefix')
+ $P0.'add_attribute'('data')
+ .globalconst int MODE = 0o666
+ .globalconst string FILE = '0'
+ .globalconst string MAGIC = 'ustar'
+ .globalconst string TAR_VERSION = '00'
+ .globalconst int BLOCK = 512
+.end
+
+=item data
+
+=cut
+
+.sub 'data' :method
+ $P0 = getattribute self, 'data'
+ .return ($P0)
+.end
+
+=item new_from_file
+
+=cut
+
+.sub 'new_from_file'
+ .param string path
+ .local string data
+ $P0 = new 'FileHandle'
+ push_eh _handler
+ .local string data
+ data = $P0.'readall'(path)
+ pop_eh
+ .local int uid, gid, mtime
+ uid = stat path, .STAT_UID
+ gid = stat path, .STAT_GID
+ mtime = stat path, .STAT_MODIFYTIME
+ .tailcall new_from_data(path, data, uid :named('uid'), gid :named('gid'), mtime :named('mtime'))
+ _handler:
+ null $P0
+ .return ($P0)
+.end
+
+=item new_from_data
+
+=cut
+
+.sub 'new_from_data'
+ .param string path
+ .param string data
+ .param int uid :named('uid') :optional
+ .param int has_uid :opt_flag
+ .param int gid :named('gid') :optional
+ .param int has_gid :opt_flag
+ .param int mtime :named('mtime') :optional
+ .param int has_mtime :opt_flag
+ $P0 = new ['Archive';'TAR';'File']
+ .local string prefix, name
+ (prefix, name) = _prefix_and_file(path)
+ unless has_uid goto L1
+ uid = 0
+ L1:
+ unless has_uid goto L2
+ gid = 0
+ L2:
+ unless has_mtime goto L3
+ mtime = time
+ L3:
+ $P1 = box data
+ setattribute $P0, 'data', $P1
+ $P1 = box name
+ setattribute $P0, 'name', $P1
+ $P1 = box MODE
+ setattribute $P0, 'mode', $P1
+ $P1 = box uid
+ setattribute $P0, 'uid', $P1
+ $P1 = box gid
+ setattribute $P0, 'gid', $P1
+ $I0 = length data
+ $P1 = box $I0
+ setattribute $P0, 'size', $P1
+ $I0 = mtime
+ $P1 = box $I0
+ setattribute $P0, 'mtime', $P1
+ $P1 = box FILE
+ setattribute $P0, 'type', $P1
+ $P1 = box ''
+ setattribute $P0, 'linkname', $P1
+ $P1 = box MAGIC
+ setattribute $P0, 'magic', $P1
+ $P1 = box TAR_VERSION
+ setattribute $P0, 'version', $P1
+ $P1 = box 'unknown'
+ setattribute $P0, 'uname', $P1
+ $P1 = box 'unknown'
+ setattribute $P0, 'gname', $P1
+ $P1 = box 0
+ setattribute $P0, 'devminor', $P1
+ $P1 = box 0
+ setattribute $P0, 'devmajor', $P1
+ $P1 = box prefix
+ setattribute $P0, 'prefix', $P1
+ .return ($P0)
+.end
+
+.sub '_prefix_and_file' :anon
+ .param string path
+ $S0 = dirname(path)
+ $S1 = basename(path)
+ .return ($S0, $S1)
+.end
+
+=item _format_tar_entry
+
+=cut
+
+.sub '_format_tar_entry' :method
+ $P0 = new 'ResizableStringArray'
+ $P1 = new 'FixedPMCArray'
+ set $P1, 1
+ .const string f1 = '%06o'
+ .const string f2 = '%11o'
+ $P2 = getattribute self, 'name'
+ $S0 = pad_string_with_null($P2, 100)
+ push $P0, $S0
+ $P2 = getattribute self, 'mode'
+ $P1[0] = $P2
+ $S0 = sprintf f1, $P1
+ $S0 = pad_string_with_null($S0, 8)
+ push $P0, $S0
+ $P2 = getattribute self, 'uid'
+ $P1[0] = $P2
+ $S0 = sprintf f1, $P1
+ $S0 = pad_string_with_null($S0, 8)
+ push $P0, $S0
+ $P2 = getattribute self, 'gid'
+ $P1[0] = $P2
+ $S0 = sprintf f1, $P1
+ $S0 = pad_string_with_null($S0, 8)
+ push $P0, $S0
+ $P2 = getattribute self, 'size'
+ $P1[0] = $P2
+ $S0 = sprintf f2, $P1
+ $S0 = pad_string_with_null($S0, 12)
+ push $P0, $S0
+ $P2 = getattribute self, 'mtime'
+ $P1[0] = $P2
+ $S0 = sprintf f2, $P1
+ $S0 = pad_string_with_null($S0, 12)
+ push $P0, $S0
+ $S0 = pad_string_with_null(" ", 8) # checksum
+ push $P0, $S0
+ $P2 = getattribute self, 'type'
+ $S0 = pad_string_with_null($P2, 1)
+ push $P0, $S0
+ $P2 = getattribute self, 'linkname'
+ $S0 = pad_string_with_null($P2, 100)
+ push $P0, $S0
+ $P2 = getattribute self, 'magic'
+ $S0 = pad_string_with_null($P2, 6)
+ push $P0, $S0
+ $P2 = getattribute self, 'version'
+ $S0 = pad_string_with_null($P2, 2)
+ push $P0, $S0
+ $P2 = getattribute self, 'uname'
+ $S0 = pad_string_with_null($P2, 32)
+ push $P0, $S0
+ $P2 = getattribute self, 'gname'
+ $S0 = pad_string_with_null($P2, 32)
+ push $P0, $S0
+ $P2 = getattribute self, 'devmajor'
+ $P1[0] = $P2
+ $S0 = sprintf f1, $P1
+ $S0 = pad_string_with_null($S0, 8)
+ push $P0, $S0
+ $P2 = getattribute self, 'devminor'
+ $P1[0] = $P2
+ $S0 = sprintf f1, $P1
+ $S0 = pad_string_with_null($S0, 8)
+ push $P0, $S0
+ $P2 = getattribute self, 'prefix'
+ $S0 = pad_string_with_null($P2, 155)
+ push $P0, $S0
+ $S0 = join '', $P0
+ $S0 = pad_string_with_null($S0, BLOCK)
+ .return ($S0)
+.end
+
+.sub 'pad_string_with_null' :anon
+ .param string str
+ .param int size
+ $S0 = substr str, 0, size
+ $I0 = length str
+ $I0 = size - $I0
+ unless $I0 > 0 goto L1
+ $S1 = repeat "\0", $I0
+ $S0 .= $S1
+ L1:
+ .return ($S0)
+.end
+
+=back
+
+=head3 Class Archive;TAR
+
+=over 4
+
+=cut
+
+.namespace ['Archive';'TAR']
+
+.sub '' :init :load :anon
+ $P0 = newclass ['Archive';'TAR']
+ $P0.'add_attribute'('data')
+.end
+
+.sub 'init' :vtable :method
+ $P0 = new 'ResizablePMCArray'
+ setattribute self, 'data', $P0
+.end
+
+=item add_files
+
+=cut
+
+.sub 'add_files' :method
+ .param pmc filenames :slurpy
+ .local pmc rv
+ rv = new 'ResizablePMCArray'
+ $P0 = iter filenames
+ L1:
+ unless $P0 goto L2
+ .local string filename
+ filename = shift $P0
+ $I0 = stat filename, .STAT_EXISTS
+ if $I0 goto L3
+ self.'_error'("No such file: '", filename, "'")
+ goto L1
+ L3:
+ .local pmc obj
+ $P1 = get_hll_global ['Archive';'TAR';'File'], 'new_from_file'
+ obj = $P1(filename)
+ unless null obj goto L4
+ self.'_error'("Unable to add file: '", filename, "'")
+ goto L1
+ L4:
+ push rv, obj
+ goto L1
+ L2:
+ $P0 = getattribute self, 'data'
+ $P1 = iter rv
+ L5:
+ unless $P1 goto L6
+ $P2 = shift $P1
+ push $P0, $P2
+ goto L5
+ L6:
+ .return (rv)
+.end
+
+=item add_data
+
+=cut
+
+.sub 'add_data' :method
+ .param string filename
+ .param string data
+ .param pmc opt :slurpy :named
+ .local pmc obj
+ $P0 = get_hll_global ['Archive';'TAR';'File'], 'new_from_data'
+ obj = $P0(filename, data, opt :flat :named)
+ $P0 = getattribute self, 'data'
+ push $P0, obj
+ .return (obj)
+.end
+
+=item write
+
+=cut
+
+.sub 'write' :method
+ .param pmc fh
+ $P0 = getattribute self, 'data'
+ $P1 = iter $P0
+ L1:
+ unless $P1 goto L2
+ .local pmc entry
+ entry = shift $P1
+ .local string header
+ header = entry.'_format_tar_entry'()
+ fh.'puts'(header)
+ $S0 = entry.'data'()
+ fh.'puts'($S0)
+ $I0 = length $S0
+ $I0 %= BLOCK
+ unless $I0 goto L1
+ .local string TAR_PAD
+ $I0 = BLOCK - $I0
+ TAR_PAD = repeat "\0", $I0
+ fh.'puts'(TAR_PAD)
+ goto L1
+ L2:
+ .local string TAR_END
+ TAR_END = repeat "\0", BLOCK
+ $S0 = repeat TAR_END, 2
+ fh.'puts'($S0)
+.end
+
+=item _error
+
+=cut
+
+.sub '_error' :method
+ .param pmc args :slurpy
+ $S0 = join '', args
+ printerr $S0
+ printerr "\n"
+.end
+
+=back
+
+=back
+
+=head1 AUTHOR
+
+Francois Perrad
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
View
75 t/library/archive_tar.t
@@ -0,0 +1,75 @@
+#!./parrot
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+t/library/archive_tar.t
+
+=head1 DESCRIPTION
+
+Test the Archive/TAR library
+
+=head1 SYNOPSIS
+
+ % prove t/library/archive_tar.t
+
+=cut
+
+.sub 'main' :main
+ .include 'test_more.pir'
+
+ load_bytecode 'Archive/TAR.pir'
+
+ plan(11)
+ test_new()
+ test_tar()
+.end
+
+.sub 'test_new'
+ $P0 = new ['Archive';'TAR']
+ $I0 = isa $P0, ['Archive';'TAR']
+ ok($I0, "new ['Archive';'TAR']")
+ $P0 = new ['Archive';'TAR';'File']
+ $I0 = isa $P0, ['Archive';'TAR';'File']
+ ok($I0, "new ['Archive';'TAR';'File']")
+.end
+
+.sub 'test_tar'
+ .local pmc archive, entry
+ archive = new ['Archive';'TAR']
+ $I0 = isa archive, ['Archive';'TAR']
+ ok($I0, "test_atf")
+ entry = archive.'add_data'('msg.txt', "some data")
+ $I0 = isa entry, ['Archive';'TAR';'File']
+ ok($I0, "entry is an ['Archive';'TAR';'File']")
+ $S0 = entry.'data'()
+ is($S0, "some data", "data")
+ .local string header
+ header = entry.'_format_tar_entry'()
+ $I0 = length header
+ is($I0, 512, "length header")
+ $I0 = index header, 'msg.txt'
+ is($I0, 0, "header starts by filename")
+ $I0 = index header, 'ustar'
+ is($I0, 257, "magic at 257")
+
+ .local pmc fh
+ fh = new 'StringHandle'
+ fh.'open'('in_memory', 'wb')
+ archive.'write'(fh)
+ $S0 = fh.'readall'()
+ fh.'close'()
+ $I0 = length $S0
+ is($I0, 2048, "size")
+ $I0 = index $S0, 'msg.txt'
+ is($I0, 0, 'filename')
+ $I0 = index $S0, 'some data'
+ is($I0, 512, 'data')
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:

0 comments on commit 347157b

Please sign in to comment.
Something went wrong with that request. Please try again.