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