1package Prima::PS::TempFile;
2
3use strict;
4use warnings;
5
6eval "use Compress::Raw::Zlib;";
7my $use_zlib = !$@;
8
9sub new_filename
10{
11	my $tmpdir = $ENV{TMPDIR} // $ENV{TEMPDIR} // (($^O =~ /win/i) ? ($ENV{TEMP} // "$ENV{SystemDrive}\\TEMP") : "/tmp");
12	my $id = unpack('H*', pack('f', rand(10 ** rand(37))));
13	return "$tmpdir/p-$id-$$.ps";
14}
15
16sub new
17{
18	my ( $class, %opt ) = @_;
19
20	my %self = ( filename => new_filename );
21	if ( open( my $f, '+>', $self{filename})) {
22		$self{fh} = $f;
23		binmode $self{fh};
24	} else {
25		warn "cannot create temp file $self{filename}: $!\n" if $opt{warn} // 1;
26		return undef;
27	}
28	if ($opt{unlink} // 1) {
29		my $ok = unlink $self{filename};
30		unless ($ok) {
31			# win32 doesn't let it?
32			$self{force_unlink} = 1;
33		}
34	}
35	$self{size} = 0;
36
37	$self{compress} = Compress::Raw::Zlib::Deflate->new if $opt{compress} && $use_zlib;
38
39	return bless \%self, $class;
40}
41
42sub DESTROY
43{
44	if ($_[0]->{force_unlink}) {
45		close $_[0]->{fh};
46		unlink $_[0]->{filename};
47	}
48}
49
50sub remove { unlink shift->{filename} }
51
52sub is_deflated { $_[0]->{compress} ? 1 : 0 }
53
54sub size { $_[0]-> {size} }
55
56sub write
57{
58	my $self = shift;
59
60	if ( $self-> {compress} ) {
61		my $output = '';
62		$self->{compress}->deflate($_[0], $output);
63		local $self->{compress} = undef;
64		return $self-> write($output);
65	}
66
67	my $n = syswrite $self->{fh}, $_[0];
68	unless (defined $n) {
69		warn "cannot write to temp file $self->{filename}: $!\n";
70		return 0;
71	}
72	$self->{size} += length $_[0];
73	return 1;
74}
75
76sub reset
77{
78	my ($self) = @_;
79	if ( $self-> {compress} ) {
80		my $output = '';
81		$self->{compress}->flush($output);
82		$self->{compress} = undef;
83		$self-> write($output);
84	}
85	seek( $self->{fh}, 0, 0);
86}
87
88sub tell
89{
90	my $self = shift;
91	return CORE::tell( $self->{fh} );
92}
93
94sub seek
95{
96	my ($self, $pos) = @_;
97	return CORE::seek( $self->{fh}, $pos, 0 );
98}
99
100sub read
101{
102	my ( $self, $bytes ) = @_;
103	my $buf = '';
104	my $n = sysread( $self->{fh}, $buf, $bytes);
105	return undef if !defined $n;
106	return $buf;
107}
108
109sub read_str
110{
111	my $self = shift;
112	my $buf = '';
113	my $n = sysread( $self->{fh}, $buf, 2);
114	return undef if !defined $n;
115	my $bytes = unpack('n', $buf);
116	$buf = '';
117	$n = sysread( $self->{fh}, $buf, $bytes);
118	return undef if !defined $n;
119	return $buf;
120}
121
122sub evacuate
123{
124	my ($self, $cb, $blocksize) = @_;
125
126	$self->reset;
127	$blocksize //= 16384;
128	my $ok = 0;
129
130	while (1) {
131		my $buf = '';
132		my $n = sysread( $self->{fh}, $buf, $blocksize);
133		if ( !defined $n) {
134			warn "cannot read back from temp file $self->{filename}: $!\n";
135			goto EXIT;
136		}
137		last unless $n;
138		goto EXIT unless $cb->($buf);
139	}
140
141	$ok = 1;
142EXIT:
143	close $self->{fh};
144	return $ok;
145}
146
1471;
148
149=pod
150
151=head1 NAME
152
153Prima::PS::TempFile - store parts of PS output in files
154
155=head1 DESCRIPTION
156
157Temp files are allocated, then are written to, accumulating PS code.
158Then the code is read back and is sent to main PS file.
159
160=cut
161