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

fperrad at svn.parrot.org fperrad at svn.parrot.org
Thu May 6 12:05:46 UTC 2010


Author: fperrad
Date: Thu May  6 12:05:46 2010
New Revision: 46339
URL: https://trac.parrot.org/parrot/changeset/46339

Log:
[library] add Archive/Zip

Added:
   trunk/runtime/parrot/library/Archive/Zip.pir   (contents, props changed)
   trunk/t/library/archive_zip.t   (contents, props changed)
Modified:
   trunk/MANIFEST
   trunk/MANIFEST.generated
   trunk/config/gen/makefiles/root.in
   trunk/src/dynpmc/gziphandle.pmc

Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST	Thu May  6 12:05:38 2010	(r46338)
+++ trunk/MANIFEST	Thu May  6 12:05:46 2010	(r46339)
@@ -1,12 +1,12 @@
 # ex: set ro:
 # $Id$
 #
-# generated by tools/dev//mk_manifest_and_skip.pl Thu May  6 11:39:49 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Thu May  6 11:24:06 2010 UT
 #
 # See below for documentation on the format of this file.
 #
 # See docs/submissions.pod and the documentation in
-# tools/dev//mk_manifest_and_skip.pl on how to recreate this file after SVN
+# tools/dev/mk_manifest_and_skip.pl on how to recreate this file after SVN
 # has been told about new or deleted files.
 .gitignore                                                  []
 CREDITS                                                     [main]doc
@@ -1125,6 +1125,7 @@
 runtime/parrot/include/test_more.pir                        [library]
 runtime/parrot/languages/parrot/parrot.pir                  [library]
 runtime/parrot/library/Archive/Tar.pir                      [library]
+runtime/parrot/library/Archive/Zip.pir                      [library]
 runtime/parrot/library/CGI/QueryHash.pir                    [library]
 runtime/parrot/library/Config/JSON.pir                      [library]
 runtime/parrot/library/Configure/genfile.pir                [library]
@@ -1644,6 +1645,7 @@
 t/harness.pir                                               [test]
 t/include/fp_equality.t                                     [test]
 t/library/archive_tar.t                                     [test]
+t/library/archive_zip.t                                     [test]
 t/library/cgi_query_hash.t                                  [test]
 t/library/configure.t                                       [test]
 t/library/coroutine.t                                       [test]

Modified: trunk/MANIFEST.generated
==============================================================================
--- trunk/MANIFEST.generated	Thu May  6 12:05:38 2010	(r46338)
+++ trunk/MANIFEST.generated	Thu May  6 12:05:46 2010	(r46339)
@@ -235,7 +235,8 @@
 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/Archive/Tar.pbc           [main]
+runtime/parrot/library/Archive/Zip.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 May  6 12:05:38 2010	(r46338)
+++ trunk/config/gen/makefiles/root.in	Thu May  6 12:05:46 2010	(r46339)
@@ -257,6 +257,7 @@
 
 GEN_LIBRARY = \
     $(LIBRARY_DIR)/Archive/Tar.pbc \
+    $(LIBRARY_DIR)/Archive/Zip.pbc \
     $(LIBRARY_DIR)/CGI/QueryHash.pbc \
     $(LIBRARY_DIR)/Crow.pbc \
     $(LIBRARY_DIR)/config.pbc \

Added: trunk/runtime/parrot/library/Archive/Zip.pir
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/runtime/parrot/library/Archive/Zip.pir	Thu May  6 12:05:46 2010	(r46339)
@@ -0,0 +1,840 @@
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+Archive/Zip
+
+=head2 DESCRIPTION
+
+Partial port of Archive::Zip (version 1.30)
+
+See L<http://search.cpan.org/~adamk/Archive-Zip/>
+
+=cut
+
+.include 'stat.pasm'
+.include 'tm.pasm'
+
+=head3 Class Archive;Zip;Base
+
+=cut
+
+.namespace ['Archive';'Zip';'Base']
+
+.sub '' :init :load :anon
+    $P0 = loadlib 'gziphandle'
+    $P0 = newclass ['Archive';'Zip';'Base']
+    .globalconst int AZ_OK = 0
+    .globalconst int AZ_STREAM_END = 1
+    .globalconst int AZ_ERROR = 2
+    .globalconst int AZ_FORMAT_ERROR = 3
+    .globalconst int AZ_IO_ERROR = 4
+    .globalconst int FA_UNIX = 3
+    .globalconst int GPBF_HAS_DATA_DESCRIPTOR_MASK = 8
+    .globalconst int COMPRESSION_STORED = 0
+    .globalconst int COMPRESSION_DEFLATED = 8
+    .globalconst int SIGNATURE_LENGTH = 4
+    .globalconst int LOCAL_FILE_HEADER_LENGTH = 26
+    .globalconst int DATA_DESCRIPTOR_LENGTH = 12
+    .globalconst int CENTRAL_DIRECTORY_FILE_HEADER_LENGTH = 42
+.end
+
+.sub '_printError'
+    .param pmc args :slurpy
+    $S0 = join '', args
+    printerr $S0
+    printerr "\n"
+.end
+
+.sub '_ioError' :method
+    .param pmc args :slurpy
+    $S0 = err
+    _printError('IO error:', args :flat, ':', $S0)
+    .return (AZ_IO_ERROR)
+.end
+
+.sub '_error' :method
+    .param pmc args :slurpy
+    _printError('error:', args :flat)
+    .return (AZ_ERROR)
+.end
+
+.sub 'pack_C' :method
+    .param int val
+    $S0 = chr val
+    .return ($S0)
+.end
+
+.sub 'pack_v' :method
+    .param int val
+    $I0 = val & 0x000000ff
+    $S0 = chr $I0
+    $I0 = val >> 8
+    $I0 &= 0x000000ff
+    $S1 = chr $I0
+    $S0 .= $S1
+    .return ($S0)
+.end
+
+.sub 'pack_V' :method
+    .param int val
+    $I0 = val & 0x000000ff
+    $S0 = chr $I0
+    $I0 = val >> 8
+    $I0 &= 0x000000ff
+    $S1 = chr $I0
+    $S0 .= $S1
+    $I0 = val >> 16
+    $I0 &= 0x000000ff
+    $S2 = chr $I0
+    $S0 .= $S2
+    $I0 = val >> 24
+    $I0 &= 0x000000ff
+    $S3 = chr $I0
+    $S0 .= $S3
+    .return ($S0)
+.end
+
+=head3 Class Archive;Zip;Member
+
+=over 4
+
+=cut
+
+.namespace ['Archive';'Zip';'Member']
+
+.sub '' :init :load :anon
+    $P0 = subclass ['Archive';'Zip';'Base'], ['Archive';'Zip';'Member']
+    $P0.'add_attribute'('fileName')
+    $P0.'add_attribute'('externalFileName')
+    $P0.'add_attribute'('compressionMethod')
+    $P0.'add_attribute'('compressedSize')
+    $P0.'add_attribute'('uncompressedSize')
+    $P0.'add_attribute'('lastModFileDateTime')
+    $P0.'add_attribute'('writeCentralDirectoryOffset')
+    $P0.'add_attribute'('writeLocalHeaderRelativeOffset')
+    $P0.'add_attribute'('readDataRemaining')
+    $P0.'add_attribute'('localExtraField')
+    $P0.'add_attribute'('cdExtraField')
+    $P0.'add_attribute'('fileComment')
+    $P0.'add_attribute'('crc32')
+    $P0.'add_attribute'('fileAttributeFormat')
+    $P0.'add_attribute'('bitFlag')
+    $P0.'add_attribute'('internalFileAttributes')
+    $P0.'add_attribute'('externalFileAttributes')
+.end
+
+.sub 'init' :vtable :method
+    $P0 = box FA_UNIX
+    setattribute self, 'fileAttributeFormat', $P0
+    $P0 = box 0
+    setattribute self, 'bitFlag', $P0
+    $P0 = box 0
+    setattribute self, 'crc32', $P0
+    $P0 = box 0
+    setattribute self, 'internalFileAttributes', $P0
+    $P0 = box 0
+    setattribute self, 'externalFileAttributes', $P0
+    $P0 = box ''
+    setattribute self, 'cdExtraField', $P0
+    $P0 = box ''
+    setattribute self, 'localExtraField', $P0
+    $P0 = box ''
+    setattribute self, 'fileComment', $P0
+.end
+
+=item newFromFile
+
+=cut
+
+.sub 'newFromFile'
+    .param string fileName
+    .param string zipName       :optional
+    $P0 = get_hll_global ['Archive';'Zip';'NewFileMember'], '_newFromFileNamed'
+    .tailcall $P0(fileName, zipName)
+.end
+
+
+.sub 'setLastModFileDateTimeFromUnix' :method
+    .param int time_t
+    $I0 = self.'_unixToDosTime'(time_t)
+    $P0 = box $I0
+    setattribute self, 'lastModFileDateTime', $P0
+.end
+
+.sub '_unixToDosTime' :method
+    .param int time_t
+    .const int safe_epoch = 315576060
+    unless time_t < safe_epoch goto L1
+    self.'_ioError'("Unsupported date before 1980 encountered, moving to 1980")
+    time_t = safe_epoch
+  L1:
+    $P0 = decodelocaltime time_t
+    .local int dt
+    dt = 0
+    $I0 = $P0[.TM_SEC]
+    $I0 >>= 1
+    dt += $I0
+    $I0 = $P0[.TM_MIN]
+    $I0 <<= 5
+    dt += $I0
+    $I0 = $P0[.TM_HOUR]
+    $I0 <<= 11
+    dt += $I0
+    $I0 = $P0[.TM_MDAY]
+    $I0 <<= 16
+    dt += $I0
+    $I0 = $P0[.TM_MON]
+    $I0 <<= 21
+    dt += $I0
+    $I0 = $P0[.TM_YEAR]
+    $I0 -= 1980
+    $I0 <<= 25
+    dt += $I0
+    .return (dt)
+.end
+
+.sub '_mapPermissionsFromUnix' :method
+    .param int dummy
+    .return (0)
+.end
+
+.sub 'unixFileAttributes' :method
+    .param int perms
+    $I0 = self.'_mapPermissionsFromUnix'(perms)
+    $P0 = box $I0
+    setattribute self, 'externalFileAttributes', $P0
+.end
+
+.sub '_writeOffset' :method
+    $P0 = getattribute self, 'compressedSize'
+    .return ($P0)
+.end
+
+.sub '_localHeaderSize' :method
+    # Return the total size of my local header
+    $I0 = SIGNATURE_LENGTH + LOCAL_FILE_HEADER_LENGTH
+    $P0 = getattribute self, 'fileName'
+    $S0 = $P0
+    $I1 = length $S0
+    $I0 += $I1
+    $P0 = getattribute self, 'localExtraField'
+    $S0 = $P0
+    $I1 = length $S0
+    $I0 += $I1
+    .return ($I0)
+.end
+
+.sub '_centralDirectoryHeaderSize' :method
+    # Return the total size of my CD header
+    $I0 = SIGNATURE_LENGTH + CENTRAL_DIRECTORY_FILE_HEADER_LENGTH
+    $P0 = getattribute self, 'fileName'
+    $S0 = $P0
+    $I1 = length $S0
+    $I0 += $I1
+    $P0 = getattribute self, 'cdExtraField'
+    $S0 = $P0
+    $I1 = length $S0
+    $I0 += $I1
+    $P0 = getattribute self, 'fileComment'
+    $S0 = $P0
+    $I1 = length $S0
+    $I0 += $I1
+    .return ($I0)
+.end
+
+.sub 'hasDataDescriptor' :method
+    .return (0)
+.end
+
+.sub '_writeLocalFileHeader' :method
+    .param pmc fh
+    .const string LOCAL_FILE_HEADER_SIGNATURE = "PK\x03\x04"
+    $I0 = fh.'puts'(LOCAL_FILE_HEADER_SIGNATURE)
+    if $I0 goto L1
+    .tailcall self.'_ioError'('writing local header signature')
+  L1:
+    .local string header, fileName, localExtraField
+    .const string VERSION = 20
+    header = self.'pack_v'(VERSION)
+    $P0 = getattribute self, 'bitFlag'
+    $S0 = self.'pack_v'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'compressionMethod'
+    $S0 = self.'pack_v'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'lastModFileDateTime'
+    $S0 = self.'pack_V'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'crc32'
+    $S0 = self.'pack_V'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'compressedSize'
+    $S0 = self.'pack_V'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'uncompressedSize'
+    $S0 = self.'pack_V'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'fileName'
+    fileName = $P0
+    $I0 = length fileName
+    $S0 = self.'pack_v'($I0)
+    header .= $S0
+    $P0 = getattribute self, 'localExtraField'
+    localExtraField = $P0
+    $I0 = length localExtraField
+    $S0 = self.'pack_v'($I0)
+    header .= $S0
+    $I0 = fh.'puts'(header)
+    if $I0 goto L2
+    .tailcall self.'_ioError'('writing local header')
+  L2:
+    if fileName == '' goto L3
+    $I0 = fh.'puts'(fileName)
+    if $I0 goto L3
+    .tailcall self.'_ioError'('writing local header filename')
+  L3:
+    if localExtraField == '' goto L4
+    $I0 = fh.'puts'(localExtraField)
+    if $I0 goto L4
+    .tailcall self.'_ioError'('writing local extra field')
+  L4:
+    .return (AZ_OK)
+.end
+
+.sub '_writeCentralDirectoryFileHeader' :method
+    .param pmc fh
+    .const string CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE = "PK\x01\x02"
+    $I0 = fh.'puts'(CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE)
+    if $I0 goto L1
+    .tailcall self.'_ioError'('writing central directory header signature')
+  L1:
+    .local string header, fileName, cdExtraField, fileComment
+    .local int fileNameLength, extraFieldLength, fileCommentLength
+    .const string VERSION = 20
+    header = self.'pack_C'(VERSION) # versionMadeBy
+    $P0 = getattribute self, 'fileAttributeFormat'
+    $S0 = self.'pack_C'($P0)
+    header .= $S0
+    $S0 = self.'pack_v'(VERSION) # versionNeededToExtract
+    header .= $S0
+    $P0 = getattribute self, 'bitFlag'
+    $S0 = self.'pack_v'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'compressionMethod'
+    $S0 = self.'pack_v'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'lastModFileDateTime'
+    $S0 = self.'pack_V'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'crc32'
+    $S0 = self.'pack_V'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'compressedSize'
+    $S0 = self.'pack_V'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'uncompressedSize'
+    $S0 = self.'pack_V'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'fileName'
+    fileName = $P0
+    fileNameLength = length fileName
+    $S0 = self.'pack_v'(fileNameLength)
+    header .= $S0
+    $P0 = getattribute self, 'cdExtraField'
+    cdExtraField = $P0
+    extraFieldLength = length cdExtraField
+    $S0 = self.'pack_v'(extraFieldLength)
+    header .= $S0
+    $P0 = getattribute self, 'fileComment'
+    fileComment = $P0
+    fileCommentLength = length fileComment
+    $S0 = self.'pack_v'(fileCommentLength)
+    header .= $S0
+    $S0 = self.'pack_v'(0)
+    header .= $S0
+    $P0 = getattribute self, 'internalFileAttributes'
+    $S0 = self.'pack_v'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'externalFileAttributes'
+    $S0 = self.'pack_V'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'writeLocalHeaderRelativeOffset'
+    $S0 = self.'pack_V'($P0)
+    header .= $S0
+    $I0 = fh.'puts'(header)
+    if $I0 goto L2
+    .tailcall self.'_ioError'('writing central directory header')
+  L2:
+    unless fileNameLength goto L3
+    $I0 = fh.'puts'(fileName)
+    if $I0 goto L3
+    .tailcall self.'_ioError'('writing central directory filename')
+  L3:
+    unless extraFieldLength goto L4
+    $I0 = fh.'puts'(cdExtraField)
+    if $I0 goto L4
+    .tailcall self.'_ioError'('writing central directory extra field')
+  L4:
+    unless fileCommentLength goto L5
+    $I0 = fh.'puts'(fileComment)
+    if $I0 goto L5
+    .tailcall self.'_ioError'('writing central directory file comment')
+  L5:
+    .return (AZ_OK)
+.end
+
+.sub '_refreshLocalFileHeader' :method
+    .param pmc fh
+    .local int here
+    here = tell fh
+    $P0 = getattribute self, 'writeLocalHeaderRelativeOffset'
+    $I0 = $P0
+    $I0 += SIGNATURE_LENGTH
+    seek fh, $I0, 0
+    .local string header, fileName, localExtraField
+    .const string VERSION = 20
+    header = self.'pack_v'(VERSION)
+    $P0 = getattribute self, 'bitFlag'
+    $S0 = self.'pack_v'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'compressionMethod'
+    $S0 = self.'pack_v'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'lastModFileDateTime'
+    $S0 = self.'pack_V'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'crc32'
+    $S0 = self.'pack_V'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'compressedSize'
+    $S0 = self.'pack_V'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'uncompressedSize'
+    $S0 = self.'pack_V'($P0)
+    header .= $S0
+    $P0 = getattribute self, 'fileName'
+    fileName = $P0
+    $I0 = length fileName
+    $S0 = self.'pack_v'($I0)
+    header .= $S0
+    $P0 = getattribute self, 'localExtraField'
+    localExtraField = $P0
+    $I0 = length localExtraField
+    $S0 = self.'pack_v'($I0)
+    header .= $S0
+    $I0 = fh.'puts'(header)
+    if $I0 goto L2
+    .tailcall self.'_ioError'('re-writing local header')
+  L2:
+    seek fh, here, 0
+    .return (AZ_OK)
+.end
+
+.sub 'readChunk' :method
+    .param int chunkSize        :optional
+    .param int has_chunkSize    :opt_flag
+    if has_chunkSize goto L1
+    chunkSize = 32768
+  L1:
+    $I0 = self.'readIsDone'()
+    unless $I0 goto L2
+    self.'endRead'()
+    .return ('', AZ_STREAM_END)
+  L2:
+    ($S0, $I0) = self.'_readRawChunk'(chunkSize)
+    if $I0 == AZ_OK goto L3
+    .return ('', $I0)
+  L3:
+    $P0 = getattribute self, 'readDataRemaining'
+    $I0 = length $S0
+    $P0 -= $I0
+    $P0 = new 'GzipHandle'
+    $P1 = getattribute self, 'crc32'
+    $I1 = $P1
+    $I1 = $P0.'crc32'($I1, $S0)
+    set $P1, $I1
+    .return ($S0, AZ_OK)
+.end
+
+.sub 'rewindData' :method :nsentry
+    $P0 = getattribute self, 'uncompressedSize'
+    $P0 = clone $P0
+    setattribute self, 'readDataRemaining', $P0
+    .return (AZ_OK)
+.end
+
+.sub 'endRead' :method :nsentry
+    $P0 = box 0
+    setattribute self, 'readDataRemaining', $P0
+    .return (AZ_OK)
+.end
+
+.sub 'readIsDone' :method
+    $P0 = getattribute self, 'readDataRemaining'
+    $I0 = $P0
+    $I0 = not $I0
+    .return ($I0)
+.end
+
+.sub '_writeToFileHandle' :method
+    .param pmc fh
+    .param int fhIsSeekable
+    .param int offset
+    $P0 = getattribute self, 'fileName'
+    if null $P0 goto L1
+    $S0 = $P0
+    unless $S0 == '' goto L2
+  L1:
+    self.'_error'("no member name given")
+  L2:
+    $P0 = box offset
+    setattribute self, 'writeLocalHeaderRelativeOffset', $P0
+    $I0 = self.'rewindData'()
+    unless $I0 == AZ_OK goto L3
+    $I0 = self.'_writeLocalFileHeader'(fh)
+    unless $I0 == AZ_OK goto L3
+    $I0 = self.'_writeData'(fh)
+    unless $I0 == AZ_OK goto L3
+    $I0 = self.'_refreshLocalFileHeader'(fh)
+  L3:
+    .return ($I0)
+.end
+
+.sub '_writeData' :method
+    .param pmc writeFh
+    $P0 = getattribute self, 'uncompressedSize'
+    $I0 = $P0
+    if $I0 goto L1
+    $P0 = box 0
+    setattribute self, 'compressedSize', $P0
+    .return (AZ_OK)
+  L1:
+    .local int compressedSize
+    compressedSize = 0
+  L2:
+    ($S0, $I0) = self.'readChunk'()
+    if $I0 == AZ_STREAM_END goto L3
+    if $I0 == AZ_OK goto L4
+    .return ($I0)
+  L4:
+    writeFh.'puts'($S0)
+    $I0 = length $S0
+    compressedSize += $I0
+    goto L2
+  L3:
+    $P0 = box compressedSize
+    setattribute self, 'compressedSize', $P0
+    .return (AZ_OK)
+.end
+
+.sub '_usesFileNamed' :method
+    .param string fileName
+    .return (0)
+.end
+
+=back
+
+=head3 Class Archive;Zip;FileMember
+
+=cut
+
+.namespace ['Archive';'Zip';'FileMember']
+
+.sub '' :init :load :anon
+    $P0 = subclass ['Archive';'Zip';'Member'], ['Archive';'Zip';'FileMember']
+    $P0.'add_attribute'('fh')
+.end
+
+.sub '_usesFileNamed' :method
+    .param string fileName
+    $P0 = getattribute self, 'externalFileName'
+    unless null $P0 goto L1
+    .return (0)
+  L1:
+    $S0 = $P0
+    $I0 = $S0 == fileName
+    .return ($I0)
+.end
+
+.sub 'fh' :method
+    $P0 = getattribute self, 'fh'
+    if null $P0 goto L1
+    $I0 = $P0.'is_closed'()
+    unless $I0 goto L2
+  L1:
+    $P0 = getattribute self, 'externalFileName'
+    $S0 = $P0
+    $P0 = new 'FileHandle'
+    $P0.'open'($S0, 'rb')
+    setattribute self, 'fh', $P0
+  L2:
+    .return ($P0)
+.end
+
+.sub 'endRead' :method
+    $P0 = getattribute self, 'fh'
+    $P0.'close'()
+    $P0 = get_hll_global ['Archive';'Zip';'Member'], 'endRead'
+    $P0(self)
+.end
+
+=head3 Class Archive;Zip;NewFileMember
+
+=cut
+
+.namespace ['Archive';'Zip';'NewFileMember']
+
+.sub '' :init :load :anon
+    $P0 = subclass ['Archive';'Zip';'FileMember'], ['Archive';'Zip';'NewFileMember']
+.end
+
+.sub '_readRawChunk' :method
+    .param int chunkSize
+    if chunkSize goto L1
+    .return ('', AZ_OK)
+  L1:
+    $P0 = self.'fh'()
+    $S0 = read $P0, chunkSize
+    unless $S0 == '' goto L2
+    $I0 = self.'_ioError'("reading data")
+    .return ($S0, $I0)
+  L2:
+    .return ($S0, AZ_OK)
+.end
+
+.sub '_newFromFileNamed'
+    .param string fileName
+    .param string newName       :optional
+    .param int has_newName      :opt_flag
+    if has_newName goto L1
+    newName = fileName
+  L1:
+    $I0 = stat fileName, .STAT_EXISTS
+    unless $I0 goto L2
+    $I0 = stat fileName, .STAT_ISREG
+    if $I0 goto L3
+  L2:
+    null $P0
+    .return ($P0)
+  L3:
+    $P0 = new ['Archive';'Zip';'NewFileMember']
+    $P1 = box newName
+    setattribute $P0, 'fileName', $P1
+    $P1 = box fileName
+    setattribute $P0, 'externalFileName', $P1
+    $I0 = stat fileName, .STAT_FILESIZE
+    $P1 = box $I0
+    setattribute $P0, 'uncompressedSize', $P1
+    $I1 = COMPRESSION_STORED
+    $P1 = box $I1
+    setattribute $P0, 'compressionMethod', $P1
+    $P0.'unixFileAttributes'(0o666)
+    $I0 = stat fileName, .STAT_MODIFYTIME
+    $P0.'setLastModFileDateTimeFromUnix'($I0)
+    .return ($P0)
+.end
+
+.sub 'rewindData' :method
+    $P0 = get_hll_global ['Archive';'Zip';'Member'], 'rewindData'
+    $I0 = $P0(self)
+    if $I0 == AZ_OK goto L1
+    .return ($I0)
+  L1:
+    $P0 = self.'fh'()
+    seek $P0, 0, 0
+    .return (AZ_OK)
+.end
+
+=head3 Class Archive;Zip
+
+=over 4
+
+=cut
+
+.namespace ['Archive';'Zip']
+
+.sub '' :init :load :anon
+    $P0 = subclass ['Archive';'Zip';'Base'], ['Archive';'Zip']
+    $P0.'add_attribute'('members')
+    $P0.'add_attribute'('zipfileComment')
+.end
+
+.sub 'init' :vtable :method
+    $P0 = new 'ResizablePMCArray'
+    setattribute self, 'members', $P0
+    $P0 = box ''
+    setattribute self, 'zipfileComment', $P0
+.end
+
+=item addMember
+
+=cut
+
+.sub 'addMember' :method
+    .param pmc member
+    $P0 = getattribute self, 'members'
+    push $P0, member
+.end
+
+=item addFile
+
+=cut
+
+.sub 'addFile' :method
+    .param string fileName
+    .param string newName       :optional
+    $P0 = get_hll_global ['Archive';'Zip';'Member'], 'newFromFile'
+    $P1 = $P0(fileName, newName)
+    self.'addMember'($P1)
+    .return ($P1)
+.end
+
+=item writeToFileNamed
+
+=cut
+
+.sub 'writeToFileNamed' :method
+    .param string fileName
+    $P0 = getattribute self, 'members'
+    $P1 = iter $P0
+  L1:
+    unless $P1 goto L2
+    .local pmc member
+    member = shift $P1
+    $I0 = member.'_usesFileNamed'(fileName)
+    unless $I0 goto L1
+    $S0 = member.'fileName'()
+    .tailcall self.'_error'("$fileName is needed by member ", $S0, "; consider using overwrite() or overwriteAs() instead.")
+  L2:
+    $P0 = new 'FileHandle'
+    push_eh _handler
+    $P0.'open'(fileName, 'wb')
+    pop_eh
+    $I0 = self.'writeToFileHandle'($P0, 1)
+    $P0.'close'()
+    .return ($I0)
+  _handler:
+    .tailcall self.'_ioError'("Can't open ", fileName, " for write")
+.end
+
+=item writeToFileHandle
+
+=cut
+
+.sub 'writeToFileHandle' :method
+    .param pmc fh
+    .param int fhIsSeekable
+    unless null fh goto L1
+    $I0 = isa fh, 'FileHandle'
+    if $I0 goto L1
+    .tailcall self.'_error'('No filehandle given')
+  L1:
+    $I0 = fh.'is_closed'()
+    unless $I0 goto L2
+    .tailcall self.'_ioError'('filehandle not open')
+  L2:
+    .local int offset
+    offset = 0
+    $P0 = getattribute self, 'members'
+    $P1 = iter $P0
+  L3:
+    unless $P1 goto L4
+    .local pmc member
+    member = shift $P1
+    $I0 = member.'_writeToFileHandle'(fh, fhIsSeekable, offset)
+    member.'endRead'()
+    if $I0 == AZ_OK goto L5
+    .return ($I0)
+  L5:
+    $I0 = member.'_localHeaderSize'()
+    offset += $I0
+    $I0 = member.'_writeOffset'()
+    offset += $I0
+    $I0 = member.'hasDataDescriptor'()
+    unless $I0 goto L3
+    offset += DATA_DESCRIPTOR_LENGTH
+    offset += SIGNATURE_LENGTH
+    goto L3
+  L4:
+    .tailcall self.'writeCentralDirectory'(fh, offset)
+.end
+
+.sub writeCentralDirectory :method
+    .param pmc fh
+    .param int CDoffset
+    .local int offset
+    offset = CDoffset
+    $P0 = getattribute self, 'members'
+    $P1 = iter $P0
+  L1:
+    unless $P1 goto L2
+    .local pmc member
+    member = shift $P1
+    $I0 = member.'_writeCentralDirectoryFileHeader'(fh)
+    if $I0 == AZ_OK goto L3
+    .return ($I0)
+  L3:
+    $I0 = member.'_centralDirectoryHeaderSize'()
+    offset += $I0
+    goto L1
+  L2:
+    .tailcall self.'_writeEndOfCentralDirectory'(fh, CDoffset, offset)
+.end
+
+.sub '_writeEndOfCentralDirectory' :method
+    .param pmc fh
+    .param int CDoffset
+    .param int EOCDoffset
+    .const string END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING = "PK\x05\x06"
+    $I0 = fh.'puts'(END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING)
+    if $I0 goto L1
+    .tailcall self.'_ioError'('writing EOCD Signature')
+  L1:
+    .local string zipfileComment
+    $P0 = getattribute self, 'zipfileComment'
+    zipfileComment = $P0
+    .local int zipfileCommentLength
+    zipfileCommentLength = length zipfileComment
+    .local int numberOfMembers
+    $P0 = getattribute self, 'members'
+    numberOfMembers = elements $P0
+    .local string header
+    $S0 = self.'pack_v'(0)
+    header = repeat $S0, 2
+    $S0 = self.'pack_v'(numberOfMembers)
+    header .= $S0
+    header .= $S0
+    $I0 = EOCDoffset - CDoffset
+    $S0 = self.'pack_V'($I0)
+    header .= $S0
+    $S0 = self.'pack_V'(CDoffset)
+    header .= $S0
+    $S0 = self.'pack_v'(zipfileCommentLength)
+    header .= $S0
+    $I0 = fh.'puts'(header)
+    if $I0 goto L2
+    .tailcall self.'_ioError'('writing EOCD header')
+  L2:
+    unless zipfileCommentLength goto L3
+    $I0 = fh.'puts'(zipfileComment)
+    if $I0 goto L3
+    .tailcall self.'_ioError'('writing zipfile comment')
+  L3:
+    .return (AZ_OK)
+.end
+
+=back
+
+=head1 AUTHOR
+
+Francois Perrad
+
+=cut
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:

Modified: trunk/src/dynpmc/gziphandle.pmc
==============================================================================
--- trunk/src/dynpmc/gziphandle.pmc	Thu May  6 12:05:38 2010	(r46338)
+++ trunk/src/dynpmc/gziphandle.pmc	Thu May  6 12:05:46 2010	(r46339)
@@ -295,6 +295,23 @@
         RETURN(STRING *dst);
     }
 
+    METHOD crc32(INTVAL crc, STRING *str) {
+        int rc;
+        char *buf;
+        STRING *dst = NULL;
+        UINTVAL srcLen, bufSize, dstLen;
+        char * const src = Parrot_str_to_cstring(INTERP, str);
+
+        if (!src)
+            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
+                "failed to allocate");
+
+        srcLen  = Parrot_str_byte_length(INTERP, str);
+
+        crc = crc32(crc, (const Bytef *)src, srcLen);
+        RETURN(INTVAL crc);
+    }
+
 /*
 
 =back

Added: trunk/t/library/archive_zip.t
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/t/library/archive_zip.t	Thu May  6 12:05:46 2010	(r46339)
@@ -0,0 +1,72 @@
+#!./parrot
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+t/library/archive_zip.t
+
+=head1 DESCRIPTION
+
+Test the Archive/Zip library
+
+=head1 SYNOPSIS
+
+    % prove t/library/archive_zip.t
+
+=cut
+
+.sub 'main' :main
+    .include 'test_more.pir'
+
+    load_bytecode 'Archive/Zip.pir'
+
+    plan(14)
+    test_new()
+    test_pack()
+.end
+
+.sub 'test_new'
+    $P0 = new ['Archive';'Zip']
+    $I0 = isa $P0, ['Archive';'Zip']
+    ok($I0, "new ['Archive';'Zip']")
+    $I0 = isa $P0, ['Archive';'Zip';'Base']
+    ok($I0, "is a ['Archive';'Zip';'Base']")
+    $P0 = new ['Archive';'Zip';'Member']
+    $I0 = isa $P0, ['Archive';'Zip';'Member']
+    ok($I0, "new ['Archive';'Zip';'Member']")
+    $I0 = isa $P0, ['Archive';'Zip';'Base']
+    ok($I0, "is a ['Archive';'Zip';'Base']")
+    $P0 = new ['Archive';'Zip';'FileMember']
+    $I0 = isa $P0, ['Archive';'Zip';'FileMember']
+    ok($I0, "new ['Archive';'Zip';'FileMember']")
+    $I0 = isa $P0, ['Archive';'Zip';'Member']
+    ok($I0, "is a ['Archive';'Zip';'Member']")
+    $P0 = new ['Archive';'Zip';'NewFileMember']
+    $I0 = isa $P0, ['Archive';'Zip';'NewFileMember']
+    ok($I0, "new ['Archive';'Zip';'NewFileMember']")
+    $I0 = isa $P0, ['Archive';'Zip';'FileMember']
+    ok($I0, "is a ['Archive';'Zip';'FileMember']")
+.end
+
+.sub 'test_pack'
+    $P0 = new ['Archive';'Zip']
+    $S0 = $P0.'pack_C'(0x12)
+    is( $S0, "\x12", "pack C (unsigned char)" )
+    $I0 = length $S0
+    is( $I0, 1 )
+    $S0 = $P0.'pack_v'(0x1234)
+    is( $S0, "\x34\x12", "pack v (16bits litle endian)" )
+    $I0 = length $S0
+    is( $I0, 2 )
+    $S0 = $P0.'pack_V'(0x12345678)
+    is( $S0, "\x78\x56\x34\x12", "pack V (32bits litle endian)" )
+    $I0 = length $S0
+    is( $I0, 4 )
+.end
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:


More information about the parrot-commits mailing list