File:  [Local Repository] / db / prgsrc / counter7.pl
Revision 1.2: download - view: text, annotated - select for diffs - revision graph
Mon Dec 31 18:11:52 2001 UTC (22 years, 4 months ago) by roma7
Branches: MAIN
CVS tags: HEAD
*** empty log message ***

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>