[svn:parrot] r46127 - in trunk: . config/gen/makefiles runtime/parrot/library/Archive t/library

fperrad at svn.parrot.org fperrad at svn.parrot.org
Thu Apr 29 08:14:56 UTC 2010


Author: fperrad
Date: Thu Apr 29 08:14:55 2010
New Revision: 46127
URL: https://trac.parrot.org/parrot/changeset/46127

Log:
[library] add Archive/TAR

Added:
   trunk/runtime/parrot/library/Archive/   (props changed)
   trunk/runtime/parrot/library/Archive/TAR.pir   (contents, props changed)
   trunk/t/library/archive_tar.t   (contents, props changed)
Modified:
   trunk/MANIFEST
   trunk/MANIFEST.SKIP
   trunk/MANIFEST.generated
   trunk/config/gen/makefiles/root.in

Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST	Thu Apr 29 00:43:09 2010	(r46126)
+++ trunk/MANIFEST	Thu Apr 29 08:14:55 2010	(r46127)
@@ -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/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/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]

Modified: trunk/MANIFEST.SKIP
==============================================================================
--- trunk/MANIFEST.SKIP	Thu Apr 29 00:43:09 2010	(r46126)
+++ trunk/MANIFEST.SKIP	Thu Apr 29 08:14:55 2010	(r46127)
@@ -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/

Modified: trunk/MANIFEST.generated
==============================================================================
--- trunk/MANIFEST.generated	Thu Apr 29 00:43:09 2010	(r46126)
+++ trunk/MANIFEST.generated	Thu Apr 29 08:14:55 2010	(r46127)
@@ -124,6 +124,7 @@
 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]

Modified: trunk/config/gen/makefiles/root.in
==============================================================================
--- trunk/config/gen/makefiles/root.in	Thu Apr 29 00:43:09 2010	(r46126)
+++ trunk/config/gen/makefiles/root.in	Thu Apr 29 08:14:55 2010	(r46127)
@@ -252,6 +252,7 @@
     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 \

Added: trunk/runtime/parrot/library/Archive/TAR.pir
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/runtime/parrot/library/Archive/TAR.pir	Thu Apr 29 08:14:55 2010	(r46127)
@@ -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:

Added: trunk/t/library/archive_tar.t
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/t/library/archive_tar.t	Thu Apr 29 08:14:55 2010	(r46127)
@@ -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:


More information about the parrot-commits mailing list