Browse Source

Initial code for Archive::StorableStream

themage
Merlin, theMage 10 years ago
commit
04e62d81bf
1 changed files with 164 additions and 0 deletions
  1. 164 0
      lib/Archive/StorableStream.pm

+ 164 - 0
lib/Archive/StorableStream.pm

@ -0,0 +1,164 @@
1
package Archive::StorableStream;
2
3
use strict;
4
use warnings;
5
6
our $VERSION = v0.1.0;
7
8
#Signature
9
our $sign="StorStrm000100"; 
10
11
# Don't change the signature lenght or you will brake
12
# Version compatibility. Keep the signature with 14 chars.
13
our $signlen=14;
14
our $signvstart=8;
15
our $signvlen=$signlen-$signvstart;
16
# Just to make sure the signature was not broken.
17
die "Invalid Signature\n"
18
	unless length($sign) == $signlen
19
		and substr($sign, $signvstart, $signvlen) =~ m{^\d+$};
20
21
my $ioblocksize=1024;
22
23
use Carp qw(carp croak);
24
use Storable qw(nfreeze thaw);
25
use IO::Handle;
26
use IO::File;
27
use bytes;
28
29
sub new {
30
	my $class = shift;
31
	my $self = bless {}, $class;
32
33
	my %args;
34
	if ($#_ == 0) {
35
		if (ref $_[0] or defined fileno $_[0]) {
36
			$args{fh} = shift;
37
		} else {
38
			$args{filename} = shift;
39
		}
40
	} else {
41
		%args=@_;
42
	}
43
44
	$self->init(%args);
45
46
	return $self;
47
}
48
49
sub init {
50
	my $self=shift;
51
	my %args=@_;
52
	my $mode = $args{'mode'} || '+<';
53
54
	if ($args{fh}) {
55
		if (ref $args{fh}) {
56
			$self->{_fh} = $args{fh};
57
		} else {
58
			my $io=IO::Handle->new();
59
			if ($io->fdopen(fileno($args{fh}), $mode)) {
60
				$self->{_fh} = $io;
61
			} else {
62
				carp "Can't open the handle: $!";
63
			}
64
		}
65
	} elsif ($args{filename}) {
66
		if (my $io = IO::File->new($args{filename}, $mode)) {
67
			$self->{_fh} = $io;
68
		} else {
69
			carp "Can't open the file: $!";
70
		}
71
	} else {
72
		carp ref($self)." needs a fh or filename argument";
73
	}
74
75
	$self->{_signed} = 0;
76
	$self->{__buf} = '';
77
78
	delete $args{fh};
79
	delete $args{filename};
80
	delete $args{mode};
81
82
	$self->{flags}->{compress} = 0;
83
84
	$self->{args} = \%args;
85
}
86
87
sub put {
88
	my $self=shift;
89
90
	unless ($self->{_signed}) {
91
		$self->{_fh}->print($sign, "\0");
92
93
		my $flags = "";
94
		$flags .= 'C' if $self->{flags}->{compress};
95
		$self->{_fh}->print(length($flags)."\0".$flags);
96
		$self->{_signed} = 1;
97
	}
98
99
	while (my $ref = shift) {
100
		my $frozen=nfreeze($ref);
101
		$self->{_fh}->print(length($frozen)."\0".$frozen);
102
	}
103
}
104
105
sub get {
106
	my $self=shift;
107
108
	unless ($self->{_signed}) {
109
		my $sig;
110
		$self->{_fh}->read($sig, $signlen);
111
		if (substr($sig,0,$signvstart) eq substr($sign,0,$signvstart)) {
112
			unless (substr($sig, $signvstart, $signvlen)
113
					<= substr($sig, $signvstart, $signvlen)) {
114
				carp("Trying to read a bogen file from a newer version\n".
115
					  "\tLib version: ".substr($sign, $sign, $signvstart)."\n".
116
					  "\tFile version: ".substr($sig, $signvstart, $signvlen)."\n");
117
			}
118
			$self->_read();
119
			if ($self->{__buf}=~m{^(\d+)\0}) {
120
				my $fs = $1; # blockSize
121
				substr($self->{__buf}, 0, length($fs) + 1) = '';
122
				my $flags=substr($self->{__buf}, 0, $fs);
123
				substr($self->{__buf}, 0, $fs) = '';
124
				$self->{flags}->{compress}=1 if $flags=~s/C//g;
125
			} else {
126
				carp("Trying to read a invalid file");
127
			}
128
			$self->{_signed}=1;
129
		} else {
130
			carp "Not a StorableStream file: Missing signature";
131
		}
132
	}
133
134
	return if $self->{_fh}->eof() and length($self->{__buf})==0;
135
136
	$self->_read() unless $self->{__buf}=~m{^(\d+)\0};
137
	return if $self->{_fh}->eof() and length($self->{__buf})==0;
138
139
	if ($self->{__buf}=~m{^(\d+)\0}) {
140
		my $bs=$1; # blockSize
141
		substr($self->{__buf}, 0, length($bs) + 1) = '';
142
		$self->_read() while length($self->{__buf}) < $bs;
143
144
		my $block=substr($self->{__buf},0,$bs);
145
		substr($self->{__buf},0,$bs)='';
146
147
		return thaw($block);
148
	} else {
149
		carp "OhOohh: StorableStream file with unexpected format\n";
150
	}
151
}
152
153
sub _read {
154
	my $self=shift;
155
156
	return if $self->{_fh}->eof();
157
158
	my $buf='';
159
	$self->{_fh}->read($buf, $ioblocksize);
160
161
	$self->{__buf} .= $buf;
162
}
163
164
1;