summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Archive/Zip/BufferedFileHandle.pm
blob: 4e56f9f007ca39b603eab43113ca14df689b4956 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
package Archive::Zip::BufferedFileHandle;

# File handle that uses a string internally and can seek
# This is given as a demo for getting a zip file written
# to a string.
# I probably should just use IO::Scalar instead.
# Ned Konz, March 2000

use strict;
use IO::File;
use Carp;

use vars qw{$VERSION};

BEGIN {
    $VERSION = '1.30';
    $VERSION = eval $VERSION;
}

sub new {
    my $class = shift || __PACKAGE__;
    $class = ref($class) || $class;
    my $self = bless(
        {
            content  => '',
            position => 0,
            size     => 0
        },
        $class
    );
    return $self;
}

# Utility method to read entire file
sub readFromFile {
    my $self     = shift;
    my $fileName = shift;
    my $fh       = IO::File->new( $fileName, "r" );
    CORE::binmode($fh);
    if ( !$fh ) {
        Carp::carp("Can't open $fileName: $!\n");
        return undef;
    }
    local $/ = undef;
    $self->{content} = <$fh>;
    $self->{size}    = length( $self->{content} );
    return $self;
}

sub contents {
    my $self = shift;
    if (@_) {
        $self->{content} = shift;
        $self->{size}    = length( $self->{content} );
    }
    return $self->{content};
}

sub binmode { 1 }

sub close { 1 }

sub opened { 1 }

sub eof {
    my $self = shift;
    return $self->{position} >= $self->{size};
}

sub seek {
    my $self   = shift;
    my $pos    = shift;
    my $whence = shift;

    # SEEK_SET
    if ( $whence == 0 ) { $self->{position} = $pos; }

    # SEEK_CUR
    elsif ( $whence == 1 ) { $self->{position} += $pos; }

    # SEEK_END
    elsif ( $whence == 2 ) { $self->{position} = $self->{size} + $pos; }
    else                   { return 0; }

    return 1;
}

sub tell { return shift->{position}; }

# Copy my data to given buffer
sub read {
    my $self = shift;
    my $buf  = \( $_[0] );
    shift;
    my $len = shift;
    my $offset = shift || 0;

    $$buf = '' if not defined($$buf);
    my $bytesRead =
        ( $self->{position} + $len > $self->{size} )
      ? ( $self->{size} - $self->{position} )
      : $len;
    substr( $$buf, $offset, $bytesRead ) =
      substr( $self->{content}, $self->{position}, $bytesRead );
    $self->{position} += $bytesRead;
    return $bytesRead;
}

# Copy given buffer to me
sub write {
    my $self = shift;
    my $buf  = \( $_[0] );
    shift;
    my $len = shift;
    my $offset = shift || 0;

    $$buf = '' if not defined($$buf);
    my $bufLen = length($$buf);
    my $bytesWritten =
      ( $offset + $len > $bufLen )
      ? $bufLen - $offset
      : $len;
    substr( $self->{content}, $self->{position}, $bytesWritten ) =
      substr( $$buf, $offset, $bytesWritten );
    $self->{size} = length( $self->{content} );
    return $bytesWritten;
}

sub clearerr() { 1 }

1;