temp.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

      my @dirs = (exists $dirs_to_unlink{$$} ?
		  @{ $dirs_to_unlink{$$} } : () );
      foreach my $dir (@dirs) {
	if (-d $dir) {
	  rmtree($dir, $DEBUG, 0);
	}
      }

      # clear the arrays
      @{ $files_to_unlink{$$} } = ()
	if exists $files_to_unlink{$$};
      @{ $dirs_to_unlink{$$} } = ()
	if exists $dirs_to_unlink{$$};
    }
  }


  # This is the sub called to register a file for deferred unlinking
  # This could simply store the input parameters and defer everything
  # until the END block. For now we do a bit of checking at this
  # point in order to make sure that (1) we have a file/dir to delete
  # and (2) we have been called with the correct arguments.
  sub _deferred_unlink {

    croak 'Usage:  _deferred_unlink($fh, $fname, $isdir)'
      unless scalar(@_) == 3;

    my ($fh, $fname, $isdir) = @_;

    warn "Setting up deferred removal of $fname\n"
      if $DEBUG;

    # If we have a directory, check that it is a directory
    if ($isdir) {

      if (-d $fname) {

	# Directory exists so store it
	# first on VMS turn []foo into [.foo] for rmtree
	$fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
	$dirs_to_unlink{$$} = [] 
	  unless exists $dirs_to_unlink{$$};
	push (@{ $dirs_to_unlink{$$} }, $fname);

      } else {
	carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
      }

    } else {

      if (-f $fname) {

	# file exists so store handle and name for later removal
	$files_to_unlink{$$} = []
	  unless exists $files_to_unlink{$$};
	push(@{ $files_to_unlink{$$} }, [$fh, $fname]);

      } else {
	carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
      }

    }

  }


}

=head1 OBJECT-ORIENTED INTERFACE

This is the primary interface for interacting with
C<File::Temp>. Using the OO interface a temporary file can be created
when the object is constructed and the file can be removed when the
object is no longer required.

Note that there is no method to obtain the filehandle from the
C<File::Temp> object. The object itself acts as a filehandle. Also,
the object is configured such that it stringifies to the name of the
temporary file, and can be compared to a filename directly. The object
isa C<IO::Handle> and isa C<IO::Seekable> so all those methods are
available.

=over 4

=item B<new>

Create a temporary file object.

  my $tmp = File::Temp->new();

by default the object is constructed as if C<tempfile>
was called without options, but with the additional behaviour
that the temporary file is removed by the object destructor
if UNLINK is set to true (the default).

Supported arguments are the same as for C<tempfile>: UNLINK
(defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
template is specified using the TEMPLATE option. The OPEN option
is not supported (the file is always opened).

 $tmp = File::Temp->new( TEMPLATE => 'tempXXXXX',
                        DIR => 'mydir',
                        SUFFIX => '.dat');

Arguments are case insensitive.

Can call croak() if an error occurs.

=cut

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;

  # read arguments and convert keys to upper case
  my %args = @_;
  %args = map { uc($_), $args{$_} } keys %args;

  # see if they are unlinking (defaulting to yes)
  my $unlink = (exists $args{UNLINK} ? $args{UNLINK} : 1 );
  delete $args{UNLINK};

  # template (store it in an error so that it will
  # disappear from the arg list of tempfile
  my @template = ( exists $args{TEMPLATE} ? $args{TEMPLATE} : () );
  delete $args{TEMPLATE};

  # Protect OPEN
  delete $args{OPEN};

  # Open the file and retain file handle and file name
  my ($fh, $path) = tempfile( @template, %args );

  print "Tmp: $fh - $path\n" if $DEBUG;

  # Store the filename in the scalar slot
  ${*$fh} = $path;

  # Cache the filename by pid so that the destructor can decide whether to remove it
  $FILES_CREATED_BY_OBJECT{$$}{$path} = 1;

  # Store unlink information in hash slot (plus other constructor info)
  %{*$fh} = %args;

  # create the object
  bless $fh, $class;

  # final method-based configuration
  $fh->unlink_on_destroy( $unlink );

  return $fh;
}

=item B<newdir>

Create a temporary directory using an object oriented interface.

  $dir = File::Temp->newdir();

By default the directory is deleted when the object goes out of scope.

Supports the same options as the C<tempdir> function. Note that directories
created with this method default to CLEANUP => 1.

  $dir = File::Temp->newdir( $template, %options );

=cut

sub newdir {
  my $self = shift;

  # need to handle args as in tempdir because we have to force CLEANUP
  # default without passing CLEANUP to tempdir
  my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
  my %options = @_;
  my $cleanup = (exists $options{CLEANUP} ? $options{CLEANUP} : 1 );

  delete $options{CLEANUP};

  my $tempdir;
  if (defined $template) {
    $tempdir = tempdir( $template, %options );
  } else {
    $tempdir = tempdir( %options );
  }
  return bless { DIRNAME => $tempdir,
		 CLEANUP => $cleanup,
		 LAUNCHPID => $$,
	       }, "File::Temp::Dir";
}

=item B<filename>

Return the name of the temporary file associated with this object
(if the object was created using the "new" constructor).

  $filename = $tmp->filename;

This method is called automatically when the object is used as
a string.

=cut

sub filename {
  my $self = shift;
  return ${*$self};
}

sub STRINGIFY {
  my $self = shift;
  return $self->filename;
}

=item B<dirname>

Return the name of the temporary directory associated with this
object (if the object was created using the "newdir" constructor).

  $dirname = $tmpdir->dirname;

This method is called automatically when the object is used in string context.

=item B<unlink_on_destroy>

Control whether the file is unlinked when the object goes out of scope.
The file is removed if this value is true and $KEEP_ALL is not.

 $fh->unlink_on_destroy( 1 );

Default is for the file to be removed.

=cut

sub unlink_on_destroy {
  my $self = shift;
  if (@_) {
    ${*$self}{UNLINK} = shift;
  }
  return ${*$self}{UNLINK};
}

=item B<DESTROY>

When the object goes out of scope, the destructor is called. This
destructor will attempt to unlink the file (using C<unlink1>)
if the constructor was called with UNLINK set to 1 (the default state
if UNLINK is not specified).

No error is given if the unlink fails.

If the object has been passed to a child process during a fork, the
file will be deleted when the object goes out of scope in the parent.

For a temporary directory object the directory will be removed
unless the CLEANUP argument was used in the constructor (and set to
false) or C<unlink_on_destroy> was modified after creation.

If the global variable $KEEP_ALL is true, the file or directory
will not be removed.

=cut

sub DESTROY {
  my $self = shift;
  if (${*$self}{UNLINK} && !$KEEP_ALL) {
    print "# --------->   Unlinking $self\n" if $DEBUG;

    # only delete if this process created it
    return unless exists $FILES_CREATED_BY_OBJECT{$$}{$self->filename};

    # The unlink1 may fail if the file has been closed
    # by the caller. This leaves us with the decision
    # of whether to refuse to remove the file or simply
    # do an unlink without test. Seems to be silly
    # to do this when we are trying to be careful
    # about security
    _force_writable( $self->filename ); # for windows
    unlink1( $self, $self->filename )
      or unlink($self->filename);
  }
}

=back

=head1 FUNCTIONS

This section describes the recommended interface for generating
temporary files and directories.

=over 4

=item B<tempfile>

This is the basic function to generate temporary files.
The behaviour of the file can be changed using various options:

  $fh = tempfile();
  ($fh, $filename) = tempfile();

Create a temporary file in  the directory specified for temporary
files, as specified by the tmpdir() function in L<File::Spec>.

  ($fh, $filename) = tempfile($template);

Create a temporary file in the current directory using the supplied
template.  Trailing `X' characters are replaced with random letters to
generate the filename.  At least four `X' characters must be present
at the end of the template.

  ($fh, $filename) = tempfile($template, SUFFIX => $suffix)

Same as previously, except that a suffix is added to the template
after the `X' translation.  Useful for ensuring that a temporary
filename has a particular extension when needed by other applications.
But see the WARNING at the end.

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

Translates the template as before except that a directory name
is specified.

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

Equivalent to specifying a DIR of "File::Spec->tmpdir", writing the file
into the same temporary directory as would be used if no template was
specified at all.

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

Return the filename and filehandle as before except that the file is
automatically removed when the program exits (dependent on
$KEEP_ALL). 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 (depending on the operating system) on exit or when it is
closed (unless $KEEP_ALL is true when the temp file is created).

Use the object-oriented interface if fine-grained control of when
a file is removed is required.

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( DIR => $dir );

If called in scalar context, only the filehandle is returned and the
file will automatically be deleted when closed on operating systems
that support this (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.

If the operating system supports it (for example BSD derived systems), the 
filehandle will be opened with O_EXLOCK (open with exclusive file lock). 
This can sometimes cause problems if the intention is to pass the filename 
to another system that expects to take an exclusive lock itself (such as 
DBD::SQLite) whilst ensuring that the tempfile is not reused. In this 
situation the "EXLOCK" option can be passed to tempfile. By default EXLOCK 
will be true (this retains compatibility with earlier releases).

  ($fh, $filename) = tempfile($template, EXLOCK => 0);

Options can be combined as required.

Will croak() if there is an error.

=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
		"TMPDIR" => 0,     # Place tempfile in tempdir if template specified
		"EXLOCK" => 1,      # Open file with O_EXLOCK
	       );

  # 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) {
    # End up with current directory if neither DIR not TMPDIR are set
    if ($options{"DIR"}) {

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

    } elsif ($options{TMPDIR}) {

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

    }

  } else {

    if ($options{"DIR"}) {

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

    } else {

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