← Back to branch summary

~ubuntu-branches/ubuntu/maverick/libfile-fu-perl/maverick

« back to all changes in this revision

Viewing changes to lib/File/Fu/File/Temp.pm

  • Committer: Bazaar Package Importer
  • Author(s): Jonathan Yu
  • Date: 2009-07-25 07:10:04 UTC
  • Revision ID: james.westby@ubuntu.com-20090725071004-p7cmwowvpf0f7k81
Tags: upstream-0.0.6
Import upstream version 0.0.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/File/Fu/File/Temp.pm
 
1
package File::Fu::File::Temp;
 
2
$VERSION = v0.0.6;
 
3
 
 
4
use warnings;
 
5
use strict;
 
6
use Carp;
 
7
 
 
8
=head1 NAME
 
9
 
 
10
File::Fu::File::Temp - temporary files
 
11
 
 
12
=head1 SYNOPSIS
 
13
 
 
14
  use File::Fu;
 
15
  my $handle = File::Fu->temp_file;
 
16
 
 
17
=cut
 
18
 
 
19
use File::Temp ();
 
20
# XXX should be File::Fu::Handle;
 
21
#use base 'File::Temp';
 
22
 
 
23
=head2 new
 
24
 
 
25
The directory argument is required, followed by an optional template
 
26
argument and/or flags.  The template may contain some number of 'X'
 
27
characters.  If it does not, ten of them will be appended.
 
28
 
 
29
  my $handle = File::Fu::File::Temp->new($dir, 'foo');
 
30
  my $file = $handle->name;
 
31
 
 
32
By default, the file will be deleted when the handle goes out of scope.
 
33
Optionally, it may be deleted immediately after creation or just not
 
34
deleted.
 
35
 
 
36
  my $handle = File::Fu::File::Temp->new($dir, 'foo', -secure);
 
37
 
 
38
  my $handle = File::Fu::File::Temp->new($dir, -noclean);
 
39
  # also $handle->noclean;
 
40
 
 
41
=over
 
42
 
 
43
=item -secure
 
44
 
 
45
Delete the named file (if the OS supports it) immediately after opening.
 
46
 
 
47
Calling name() on this sort of handle throws an error.
 
48
 
 
49
=item -nocleanup
 
50
 
 
51
Don't attempt to remove the file when the $handle goes out of scope.
 
52
 
 
53
=back
 
54
 
 
55
=cut
 
56
 
 
57
{
 
58
my %argmap = (
 
59
  secure => [],
 
60
  nocleanup => [UNLINK => 0],
 
61
);
 
62
sub new {
 
63
  my $proto = shift;
 
64
  my $class = ref($proto) || $proto;
 
65
  my ($dir, $send, $opt) = $class->_validate(\%argmap, @_);
 
66
 
 
67
  my ($self, $fn);
 
68
  if($opt->{secure}) {
 
69
    $self = File::Temp::tempfile(@$send);
 
70
    $class .= '::HasNoFileName';
 
71
  }
 
72
  else {
 
73
    ($self, $fn) = File::Temp::tempfile(@$send);
 
74
    ${*$self} = $dir->file_class->new($fn);
 
75
  }
 
76
  %{*$self} = %$opt;
 
77
  bless($self, $class);
 
78
  return($self);
 
79
}} # end subroutine new definition
 
80
########################################################################
 
81
 
 
82
=for internal head2 _validate
 
83
  my ($dir, $send, $opt) = $class->_validate(\%map, @_);
 
84
 
 
85
=cut
 
86
 
 
87
sub _validate {
 
88
  my $class = shift;
 
89
  my %argmap = %{shift(@_)};
 
90
  my ($dir, @opt) = @_;
 
91
  croak("invalid directory '$dir' ")
 
92
    unless(eval {$dir->can('e')} and $dir->e);
 
93
 
 
94
  my @send;
 
95
  my %opt;
 
96
  for(my $i = 0; $i < @opt; $i++) {
 
97
    ($opt[$i] =~ s/^-//) or next;
 
98
    my ($key) = splice(@opt, $i, 1); $i--;
 
99
    my $do = $argmap{$key} or croak("invalid argument '$key'");
 
100
    push(@send, @$do);
 
101
    $opt{$key} = 1;
 
102
  }
 
103
  if(@opt) {
 
104
    my $template = shift(@opt);
 
105
    croak("invalid arguments '@opt'") if(@opt);
 
106
 
 
107
    $template .= $class->XXX unless($template =~ m/X/);
 
108
    # XXX File::Temp specific
 
109
    unshift(@send, $template);
 
110
  }
 
111
  $opt{auto_delete} = ! delete($opt{nocleanup});
 
112
 
 
113
  push(@send, DIR => "$dir");
 
114
 
 
115
  return($dir, \@send, \%opt);
 
116
} # end subroutine _validate definition
 
117
########################################################################
 
118
 
 
119
=head2 name
 
120
 
 
121
  my $file_obj = $handle->name;
 
122
 
 
123
=cut
 
124
 
 
125
sub name {
 
126
  my $self = shift;
 
127
  return(${*$self});
 
128
} # end subroutine name definition
 
129
########################################################################
 
130
 
 
131
=head2 nocleanup
 
132
 
 
133
Disable autocleanup.
 
134
 
 
135
  $handle->nocleanup;
 
136
 
 
137
=cut
 
138
 
 
139
sub nocleanup {
 
140
  my $self = shift;
 
141
  my %opt = %{*$self};
 
142
  $opt{auto_delete} = 0;
 
143
} # end subroutine nocleanup definition
 
144
########################################################################
 
145
 
 
146
=head2 DESTROY
 
147
 
 
148
Called automatically when the handle goes out of scope.
 
149
 
 
150
  $handle->DESTROY;
 
151
 
 
152
=cut
 
153
 
 
154
sub DESTROY {
 
155
  my $self = shift;
 
156
  my %opt = %{*$self};
 
157
  return if($opt{secure} or ! $opt{auto_delete});
 
158
  $self->name->unlink;
 
159
} # end subroutine DESTROY definition
 
160
########################################################################
 
161
 
 
162
use constant XXX => 'X'x10;
 
163
 
 
164
=head1 AUTHOR
 
165
 
 
166
Eric Wilhelm @ <ewilhelm at cpan dot org>
 
167
 
 
168
http://scratchcomputing.com/
 
169
 
 
170
=head1 BUGS
 
171
 
 
172
If you found this module on CPAN, please report any bugs or feature
 
173
requests through the web interface at L<http://rt.cpan.org>.  I will be
 
174
notified, and then you'll automatically be notified of progress on your
 
175
bug as I make changes.
 
176
 
 
177
If you pulled this development version from my /svn/, please contact me
 
178
directly.
 
179
 
 
180
=head1 COPYRIGHT
 
181
 
 
182
Copyright (C) 2008 Eric L. Wilhelm, All Rights Reserved.
 
183
 
 
184
=head1 NO WARRANTY
 
185
 
 
186
Absolutely, positively NO WARRANTY, neither express or implied, is
 
187
offered with this software.  You use this software at your own risk.  In
 
188
case of loss, no person or entity owes you anything whatsoever.  You
 
189
have been warned.
 
190
 
 
191
=head1 LICENSE
 
192
 
 
193
This program is free software; you can redistribute it and/or modify it
 
194
under the same terms as Perl itself.
 
195
 
 
196
=cut
 
197
 
 
198
# vi:ts=2:sw=2:et:sta
 
199
1;