Return to counter7.pl CVS log

Up to [Local Repository] / db / prgsrc

spellchecked

    1: #!/usr/bin/perl
    2: $wait=3;
    3: $header="Content-Type: text/html\n\n";
    4: print $header;
    5: 
    6: $cfile	= 'count7';
    7: $cfiledir = '/home/piataev/public_html/cgi-bin/counts7';
    8: chdir $cfiledir;
    9: 
   10: open STDERR, ">errors" or print "Oppa";
   11: $lockdir="";
   12: $lockdir=$cfiledir;
   13: $l = lc $ENV{'DOCUMENT_NAME'};
   14: if ($a=&lockfile)
   15:   { print "$a ?? раз"; 
   16:     exit ;
   17:   }
   18: 
   19: open(F, "$cfile");
   20: @DATA = <F>;
   21: close(F);
   22: foreach (@DATA) {
   23:   ($c, $bl) = split / - /;
   24:   chomp $bl;
   25:   if ($bl eq $l)
   26:   {
   27:     $c++;
   28:     $_ = "$c - $bl\n";
   29:     $tmp = "$cfile$$.tmp";
   30:     open(F, ">$tmp");
   31:     print F @DATA;
   32:     close(F);
   33:     rename("$tmp", $cfile);
   34:     print "$c раз".&Suffix($c);
   35:     &unlockfile ;
   36:     exit
   37:   }
   38: }
   39: 
   40: open(F, ">>$cfile");
   41: print F "1 - $l\n"; 
   42: close(F);
   43: 
   44: print "первый раз";
   45: &unlockfile;
   46: 
   47: sub lockfile
   48: {  
   49:    $tmp="$cfile$$.tmp";
   50:    $lock="$cfile.loc";
   51:    open F,">$tmp" or (print $@,return 1);
   52:    print F $$;
   53:    close F;
   54:    if (-e $lock) {
   55:     for (1..$wait){
   56:        sleep(1); 
   57:        last unless -e $lock
   58:     }
   59:    }
   60:    if ((-e $lock) && (-M $lock<0)){unlink $tmp;
   61: return 2}
   62:    elsif (!rename($tmp,$lock)) {return 3}
   63:    open(LOCK,"<$lock") or return 3;
   64:    $lock_pid=<LOCK>;
   65:    close(LOCK);
   66:    return 2 unless $lock_pid == $$;
   67:    return 0; 
   68: }
   69: 
   70: sub unlockfile
   71: {
   72:   open (LOCK, "<$lock") or return 1;
   73:   $lock_pid=<LOCK>;
   74:   close(LOCK);
   75:   return 2 unless $lock_pid==$$;
   76:   unlink($lock) or return 3;
   77:   return 0;
   78: }
   79: 
   80: 
   81: sub Suffix {
   82: 	my ($qnum) = @_;
   83:    my ($suffix) = 'а' if $qnum =~ /[234]$/;
   84:    $suffix = '' if $qnum =~ /156789$/ || $qnum =~ /1.$/;
   85:    return $suffix;
   86: }