releasing/cbrtools/perl/Archive/Zip/BufferedFileHandle.pm
author jjkang
Fri, 25 Jun 2010 19:56:45 +0800
changeset 604 b33dd54aaa52
parent 602 3145852acc89
permissions -rw-r--r--
add cpptoolsplat
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
602
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     1
# Copyright (c) 2000 Ned Konz. All rights reserved.  This program is free
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     2
# software; you can redistribute it and/or modify it under the same terms
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     3
# as Perl itself.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     4
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     5
# File handle that uses a string internally and can seek
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     6
# This is given as a demo for getting a zip file written
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     7
# to a string.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     8
# I probably should just use IO::Scalar instead.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     9
# Ned Konz, March 2000
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    10
#
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    11
# $Revision: 1.3 $
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    12
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    13
use strict;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    14
package Archive::Zip::BufferedFileHandle;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    15
use FileHandle ();
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    16
use Carp;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    17
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    18
sub new
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    19
{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    20
	my $class = shift || __PACKAGE__;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    21
	$class = ref($class) || $class;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    22
	my $self = bless( { 
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    23
		content => '', 
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    24
		position => 0, 
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    25
		size => 0
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    26
	}, $class );
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    27
	return $self;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    28
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    29
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    30
# Utility method to read entire file
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    31
sub readFromFile
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    32
{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    33
	my $self = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    34
	my $fileName = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    35
	my $fh = FileHandle->new($fileName, "r");
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    36
	if (! $fh)
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    37
	{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    38
		Carp::carp("Can't open $fileName: $!\n");
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    39
		return undef;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    40
	}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    41
	local $/ = undef;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    42
	$self->{content} = <$fh>;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    43
	$self->{size} = length($self->{content});
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    44
	return $self;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    45
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    46
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    47
sub contents
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    48
{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    49
	my $self = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    50
	if (@_)
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    51
	{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    52
		$self->{content} = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    53
		$self->{size} = length($self->{content});
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    54
	}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    55
	return $self->{content};
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    56
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    57
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    58
sub binmode
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    59
{ 1 }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    60
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    61
sub close
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    62
{ 1 }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    63
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    64
sub eof
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    65
{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    66
	my $self = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    67
	return $self->{position} >= $self->{size};
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    68
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    69
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    70
sub seek
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    71
{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    72
	my $self = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    73
	my $pos = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    74
	my $whence = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    75
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    76
	# SEEK_SET
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    77
	if ($whence == 0) { $self->{position} = $pos; }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    78
	# SEEK_CUR
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    79
	elsif ($whence == 1) { $self->{position} += $pos; }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    80
	# SEEK_END
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    81
	elsif ($whence == 2) { $self->{position} = $self->{size} + $pos; }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    82
	else { return 0; }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    83
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    84
	return 1;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    85
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    86
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    87
sub tell
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    88
{ return shift->{position}; }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    89
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    90
# Copy my data to given buffer
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    91
sub read
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    92
{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    93
	my $self = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    94
	my $buf = \($_[0]); shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    95
	my $len = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    96
	my $offset = shift || 0;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    97
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    98
	$$buf = '' if not defined($$buf);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    99
	my $bytesRead = ($self->{position} + $len > $self->{size})
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   100
		? ($self->{size} - $self->{position})
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   101
		: $len;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   102
	substr($$buf, $offset, $bytesRead) 
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   103
		= substr($self->{content}, $self->{position}, $bytesRead);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   104
	$self->{position} += $bytesRead;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   105
	return $bytesRead;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   106
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   107
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   108
# Copy given buffer to me
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   109
sub write
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   110
{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   111
	my $self = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   112
	my $buf = \($_[0]); shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   113
	my $len = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   114
	my $offset = shift || 0;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   115
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   116
	$$buf = '' if not defined($$buf);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   117
	my $bufLen = length($$buf);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   118
	my $bytesWritten = ($offset + $len > $bufLen)
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   119
		? $bufLen - $offset
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   120
		: $len;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   121
	substr($self->{content}, $self->{position}, $bytesWritten)
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   122
		= substr($$buf, $offset, $bytesWritten);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   123
	$self->{size} = length($self->{content});
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   124
	return $bytesWritten;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   125
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   126
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   127
sub clearerr() { 1 }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   128
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   129
# vim: ts=4 sw=4
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   130
1;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   131
__END__
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   132
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   133
=head1 COPYRIGHT
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   134
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   135
Copyright (c) 2000 Ned Konz. All rights reserved.  This program is free
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   136
software; you can redistribute it and/or modify it under the same terms
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   137
as Perl itself.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   138
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   139
=cut