[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: CGI-Perl Scripting



Brian Loss schrieb:
> 
> Hello Other Members,
> I am creating a CGI script, and I would like to know how to delete a
> file within a CGI scipt.

Hi Brian,
Try the unlink function:

$filename = "example.txt";
unlink($filename);

The file in $filename must be writeable and couldn't be actual opened by
another process/user. In web environment use file locking to do it. But
with windows the Perl 'flock' function will always fail. (ActiveState Perl
5.04 build 316). So I use my own locking mechanism under Windows:


##################################
# timeout constant for locking   #
# operations, your functions     #
# should not lock a file for a   #
# longer time if multiple users  #
# access it                      #
##################################

$locktimeout = 30;

##################################
# Locks a file and return TRUE   #
# if file is locked return FALSE #
# if file is already locked by   #
# another user (The mechanism of #
# temporary *.LCK file is used   #
# 'cause some OS' don't support  #
# perls flock() function         #
##################################

sub Lock {
   my $result = 0;
   my $lockfilename = shift(@_);
   $lockfilename =~ s/[.]+[a-z]*/.lck/gi;
   $lockfilename =~ tr/[A-Z]/[a-z]/;
   my $to = time + $locktimeout;
   my $ti = time;
   while ((-e $lockfilename) && ($ti <= $to)) {
      $ti = time;
   };
   # lockfile timeout ?
   if ($ti <= $to) {
      open(LOCKFILE, "+>$lockfilename");
      close(LOCKFILE);
      $result = 1;
   };
   return $result;
};

###############################
# Unlocks a file and return   #
# TRUE if file is unlocked    #
# return FALSE if file wasn't #
# locked with Lock() before   #
###############################

sub Unlock {
   my $result = 0;
   my $lockfilename = shift(@_);
   if (-e $lockfilename) { 
      $lockfilename =~ s/[.]+[a-z]*/.lck/gi;
      $lockfilename =~ tr/[A-Z]/[a-z]/;
      unlink($lockfilename);
      $result = 1;
   };
   return $result;
};

################################
# Tests the retrun code of the #
# above 2 functions and raises #
# an error if 0 is returened   #
################################

sub CheckLock {
  HandleError('cannot_lock') unless @_;
};

> 
> ______________________________________________________
> Get Your Private, Free Email at http://www.hotmail.com

-- 
with regards
Holger

---------------------------------------------------------
Holger 'Zimpel' Zimmermann    Contact me:
---------------------------------------------------------
Wendishain                    tel./fax company: on demand
Germany                       tel./fax private: on demand
---------------------------------------------------------
homepage: http://home.t-online.de/home/zimpel/
web server: surf to it from my homepage (online every
            Sunday 20:00-24:00 GMT, start shifted again)
e-Mail:     zimpel@t-online.de
--------------------------------------------------------