releasing/cbrtools/perl/Archive/Zip/MockFileHandle.pm
author jjkang
Fri, 25 Jun 2010 18:37:20 +0800
changeset 602 3145852acc89
permissions -rw-r--r--
add releasing to new structure
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
# Output file handle that calls a custom write routine
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     6
# Ned Konz, March 2000
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     7
# This is provided to help with writing zip files
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     8
# when you have to process them a chunk at a time.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     9
#
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    10
# See the examples.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    11
#
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    12
# $Revision: 1.2 $
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    13
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    14
use strict;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    15
package Archive::Zip::MockFileHandle;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    16
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    17
sub new
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    18
{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    19
	my $class = shift || __PACKAGE__;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    20
	$class = ref($class) || $class;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    21
	my $self = bless( { 
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    22
		'position' => 0, 
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    23
		'size' => 0
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    24
	}, $class );
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    25
	return $self;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    26
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    27
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    28
sub eof
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    29
{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    30
	my $self = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    31
	return $self->{'position'} >= $self->{'size'};
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    32
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    33
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    34
# Copy given buffer to me
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    35
sub write
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    36
{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    37
	my $self = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    38
	my $buf = \($_[0]); shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    39
	my $len = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    40
	my $offset = shift || 0;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    41
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    42
	$$buf = '' if not defined($$buf);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    43
	my $bufLen = length($$buf);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    44
	my $bytesWritten = ($offset + $len > $bufLen)
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    45
		? $bufLen - $offset
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    46
		: $len;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    47
	$bytesWritten = $self->writeHook(substr($$buf, $offset, $bytesWritten));
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    48
	if ($self->{'position'} + $bytesWritten > $self->{'size'})
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    49
	{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    50
		$self->{'size'} = $self->{'position'} + $bytesWritten
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    51
	}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    52
	$self->{'position'} += $bytesWritten;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    53
	return $bytesWritten;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    54
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    55
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    56
# Called on each write.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    57
# Override in subclasses.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    58
# Return number of bytes written (0 on error).
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    59
sub writeHook
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    60
{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    61
	my $self = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    62
	my $bytes = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    63
	return length($bytes);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    64
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    65
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    66
sub binmode { 1 } 
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    67
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    68
sub close { 1 } 
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    69
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    70
sub clearerr { 1 } 
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    71
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    72
# I'm write-only!
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    73
sub read { 0 } 
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    74
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    75
sub tell { return shift->{'position'} }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    76
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    77
# vim: ts=4 sw=4
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    78
1;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    79
__END__
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    80
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    81
=head1 COPYRIGHT
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    82
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    83
Copyright (c) 2000 Ned Konz. All rights reserved.  This program is free
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    84
software; you can redistribute it and/or modify it under the same terms
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    85
as Perl itself.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    86
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    87
=cut