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