temp.pm

1. 记录每个帖子的访问人情况

  ($fh, $filename) = tempfile($template, UNLINK => 1);

Return the filename and filehandle as before except that the file is
automatically removed when the program exits. Default is for the file
to be removed if a file handle is requested and to be kept if the
filename is requested. In a scalar context (where no filename is 
returned) the file is always deleted either on exit or when it is closed.

If the template is not specified, a template is always
automatically generated. This temporary file is placed in tmpdir()
(L<File::Spec>) unless a directory is specified explicitly with the 
DIR option.

  $fh = tempfile( $template, DIR => $dir );

If called in scalar context, only the filehandle is returned
and the file will automatically be deleted when closed (see 
the description of tmpfile() elsewhere in this document).
This is the preferred mode of operation, as if you only 
have a filehandle, you can never create a race condition
by fumbling with the filename. On systems that can not unlink
an open file or can not mark a file as temporary when it is opened
(for example, Windows NT uses the C<O_TEMPORARY> flag))
the file is marked for deletion when the program ends (equivalent
to setting UNLINK to 1). The C<UNLINK> flag is ignored if present.

  (undef, $filename) = tempfile($template, OPEN => 0);

This will return the filename based on the template but
will not open this file.  Cannot be used in conjunction with
UNLINK set to true. Default is to always open the file 
to protect from possible race conditions. A warning is issued
if warnings are turned on. Consider using the tmpnam()
and mktemp() functions described elsewhere in this document
if opening the file is not required.

Options can be combined as required.

=cut

sub tempfile {

  # Can not check for argument count since we can have any
  # number of args

  # Default options
  my %options = (
		 "DIR"    => undef,  # Directory prefix
                "SUFFIX" => '',     # Template suffix
                "UNLINK" => 0,      # Do not unlink file on exit
                "OPEN"   => 1,      # Open file
		);

  # Check to see whether we have an odd or even number of arguments
  my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);

  # Read the options and merge with defaults
  %options = (%options, @_)  if @_;

  # First decision is whether or not to open the file
  if (! $options{"OPEN"}) {

    warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
      if $^W;

  }

  if ($options{"DIR"} and $^O eq 'VMS') {

      # on VMS turn []foo into [.foo] for concatenation
      $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
  }

  # Construct the template

  # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
  # functions or simply constructing a template and using _gettemp()
  # explicitly. Go for the latter

  # First generate a template if not defined and prefix the directory
  # If no template must prefix the temp directory
  if (defined $template) {
    if ($options{"DIR"}) {

      $template = File::Spec->catfile($options{"DIR"}, $template);

    }

  } else {

    if ($options{"DIR"}) {

      $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);

    } else {

      $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);

    }

  }

  # Now add a suffix
  $template .= $options{"SUFFIX"};

  # Determine whether we should tell _gettemp to unlink the file
  # On unix this is irrelevant and can be worked out after the file is
  # opened (simply by unlinking the open filehandle). On Windows or VMS
  # we have to indicate temporary-ness when we open the file. In general
  # we only want a true temporary file if we are returning just the 
  # filehandle - if the user wants the filename they probably do not
  # want the file to disappear as soon as they close it.
  # For this reason, tie unlink_on_close to the return context regardless
  # of OS.
  my $unlink_on_close = ( wantarray ? 0 : 1);

  # Create the file
  my ($fh, $path, $errstr);
  croak "Error in tempfile() using $template: $errstr"
    unless (($fh, $path) = _gettemp($template,
				    "open" => $options{'OPEN'},
				    "mkdir"=> 0 ,
                                    "unlink_on_close" => $unlink_on_close,
				    "suffixlen" => length($options{'SUFFIX'}),
				    "ErrStr" => \$errstr,
				   ) );

  # Set up an exit handler that can do whatever is right for the
  # system. This removes files at exit when requested explicitly or when
  # system is asked to unlink_on_close but is unable to do so because
  # of OS limitations.
  # The latter should be achieved by using a tied filehandle.
  # Do not check return status since this is all done with END blocks.
  _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};

  # Return
  if (wantarray()) {

    if ($options{'OPEN'}) {
      return ($fh, $path);
    } else {
      return (undef, $path);
    }

  } else {

    # Unlink the file. It is up to unlink0 to decide what to do with
    # this (whether to unlink now or to defer until later)
    unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";

    # Return just the filehandle.
    return $fh;
  }


}

=item B<tempdir>

This is the recommended interface for creation of temporary directories.
The behaviour of the function depends on the arguments:

  $tempdir = tempdir();

Create a directory in tmpdir() (see L<File::Spec|File::Spec>).

  $tempdir = tempdir( $template );

Create a directory from the supplied template. This template is
similar to that described for tempfile(). `X' characters at the end
of the template are replaced with random letters to construct the
directory name. At least four `X' characters must be in the template.

  $tempdir = tempdir ( DIR => $dir );

Specifies the directory to use for the temporary directory.
The temporary directory name is derived from an internal template.

  $tempdir = tempdir ( $template, DIR => $dir );

Prepend the supplied directory name to the template. The template
should not include parent directory specifications itself. Any parent
directory specifications are removed from the template before
prepending the supplied directory.

  $tempdir = tempdir ( $template, TMPDIR => 1 );

Using the supplied template, creat the temporary directory in 
a standard location for temporary files. Equivalent to doing

  $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);

but shorter. Parent directory specifications are stripped from the
template itself. The C<TMPDIR> option is ignored if C<DIR> is set
explicitly.  Additionally, C<TMPDIR> is implied if neither a template
nor a directory are supplied.

  $tempdir = tempdir( $template, CLEANUP => 1);

Create a temporary directory using the supplied template, but 
attempt to remove it (and all files inside it) when the program
exits. Note that an attempt will be made to remove all files from
the directory even if they were not created by this module (otherwise
why ask to clean it up?). The directory removal is made with
the rmtree() function from the L<File::Path|File::Path> module.
Of course, if the template is not specified, the temporary directory
will be created in tmpdir() and will also be removed at program exit.

=cut

# '

sub tempdir  {

  # Can not check for argument count since we can have any
  # number of args

  # Default options
  my %options = (
		 "CLEANUP"    => 0,  # Remove directory on exit
		 "DIR"        => '', # Root directory
		 "TMPDIR"     => 0,  # Use tempdir with template
		);

  # Check to see whether we have an odd or even number of arguments
  my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );

  # Read the options and merge with defaults
  %options = (%options, @_)  if @_;

  # Modify or generate the template

  # Deal with the DIR and TMPDIR options
  if (defined $template) {

    # Need to strip directory path if using DIR or TMPDIR
    if ($options{'TMPDIR'} || $options{'DIR'}) {

      # Strip parent directory from the filename
      #
      # There is no filename at the end
      $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
      my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);

      # Last directory is then our template
      $template = (File::Spec->splitdir($directories))[-1];

      # Prepend the supplied directory or temp dir
      if ($options{"DIR"}) {

        $template = File::Spec->catdir($options{"DIR"}, $template);

      } elsif ($options{TMPDIR}) {

	# Prepend tmpdir
	$template = File::Spec->catdir(File::Spec->tmpdir, $template);

      }

    }

  } else {

    if ($options{"DIR"}) {

      $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);

    } else {

      $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);

    }

  }

  # Create the directory
  my $tempdir;
  my $suffixlen = 0;
  if ($^O eq 'VMS') {  # dir names can end in delimiters
    $template =~ m/([\.\]:>]+)$/;
    $suffixlen = length($1);
  }

  my $errstr;
  croak "Error in tempdir() using $template: $errstr"
    unless ((undef, $tempdir) = _gettemp($template,
				    "open" => 0,
				    "mkdir"=> 1 ,
				    "suffixlen" => $suffixlen,
				    "ErrStr" => \$errstr,
				   ) );

  # Install exit handler; must be dynamic to get lexical
  if ( $options{'CLEANUP'} && -d $tempdir) {
    _deferred_unlink(undef, $tempdir, 1);
  }

  # Return the dir name
  return $tempdir;

}

=back

=head1 MKTEMP FUNCTIONS

The following functions are Perl implementations of the 
mktemp() family of temp file generation system calls.

=over 4

=item B<mkstemp>

Given a template, returns a filehandle to the temporary file and the name
of the file.

  ($fh, $name) = mkstemp( $template );

In scalar context, just the filehandle is returned.

The template may be any filename with some number of X's appended
to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
with unique alphanumeric combinations.

=cut



sub mkstemp {

  croak "Usage: mkstemp(template)"
    if scalar(@_) != 1;

  my $template = shift;

  my ($fh, $path, $errstr);
  croak "Error in mkstemp using $template: $errstr"
    unless (($fh, $path) = _gettemp($template,
				    "open" => 1,
				    "mkdir"=> 0 ,
				    "suffixlen" => 0,
				    "ErrStr" => \$errstr,
				   ) );

  if (wantarray()) {
    return ($fh, $path);
  } else {
    return $fh;
  }

}


=item B<mkstemps>

Similar to mkstemp(), except that an extra argument can be supplied
with a suffix to be appended to the template.

  ($fh, $name) = mkstemps( $template, $suffix );

For example a template of C<testXXXXXX> and suffix of C<.dat>
would generate a file similar to F<testhGji_w.dat>.

Returns just the filehandle alone when called in scalar context.

=cut

sub mkstemps {

  croak "Usage: mkstemps(template, suffix)"
    if scalar(@_) != 2;


  my $template = shift;
  my $suffix   = shift;

  $template .= $suffix;

  my ($fh, $path, $errstr);
  croak "Error in mkstemps using $template: $errstr"
    unless (($fh, $path) = _gettemp($template,
				    "open" => 1,
				    "mkdir"=> 0 ,
				    "suffixlen" => length($suffix),
				    "ErrStr" => \$errstr,
				   ) );

  if (wantarray()) {
    return ($fh, $path);
  } else {
    return $fh;
  }

}

=item B<mkdtemp>

Create a directory from a template. The template must end in
X's that are replaced by the routine.

  $tmpdir_name = mkdtemp($template);

Returns the name of the temporary directory created.
Returns undef on failure.

Directory must be removed by the caller.

=cut

#' # for emacs

sub mkdtemp {

  croak "Usage: mkdtemp(template)"
    if scalar(@_) != 1;

  my $template = shift;
  my $suffixlen = 0;
  if ($^O eq 'VMS') {  # dir names can end in delimiters
    $template =~ m/([\.\]:>]+)$/;
    $suffixlen = length($1);
  }
  my ($junk, $tmpdir, $errstr);
  croak "Error creating temp directory from template $template\: $errstr"
    unless (($junk, $tmpdir) = _gettemp($template,
					"open" => 0,
					"mkdir"=> 1 ,
					"suffixlen" => $suffixlen,
					"ErrStr" => \$errstr,
				       ) );

  return $tmpdir;

}

=item B<mktemp>

Returns a valid temporary filename but does not guarantee
that the file will not be opened by someone else.

  $unopened_file = mktemp($template);

Template is the same as that required by mkstemp().

=cut

sub mktemp {

  croak "Usage: mktemp(template)"
    if scalar(@_) != 1;

  my $template = shift;

  my ($tmpname, $junk, $errstr);
  croak "Error getting name to temp file from template $template: $errstr"
    unless (($junk, $tmpname) = _gettemp($template,
					 "open" => 0,
					 "mkdir"=> 0 ,
					 "suffixlen" => 0,
					 "ErrStr" => \$errstr,
					 ) );

  return $tmpname;
}