File:  [Local Repository] / db / prgsrc / counter7.pl
Revision 1.3: download - view: text, annotated - select for diffs - revision graph
Mon Dec 31 18:22:32 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: print $header;
    9: &lockfile && (print '?? раз', exit);
   10: 
   11: open(F, $cfile);
   12: @DATA = <F>;
   13: close(F);
   14: foreach (@DATA) {
   15:   ($c, $bl) = split / - /;
   16:   chomp $bl;
   17:   if ($bl eq $l)
   18:   {
   19:     $c++;
   20:     $_ = "$c - $bl\n";
   21:     $tmp = "cfile$$.tmp";
   22:     open(F, ">$tmp");
   23:     print F @DATA;
   24:     close(F);
   25:     rename("$tmp", $cfile);
   26:     print "$c раз".&Suffix($c);
   27:     &unlockfile ;
   28:     exit
   29:   }
   30: }
   31: 
   32: open(F, ">>$cfile");
   33: print F "1 - $l\n"; 
   34: close(F);
   35: 
   36: print "первый раз";
   37: &unlockfile;
   38: 
   39: sub lockfile
   40: {  
   41:    $tmp="$lockdir$cfile$$.tmp";
   42:    $lock="$lockdir$cfile.loc";
   43:    open F,">$tmp" or return 1;
   44:    print F $$;
   45:    close F;
   46:    if (-e $lock) {
   47:     for (1..$wait){
   48:        sleep(1); 
   49:        last unless -e $lock
   50:     }
   51:    }
   52:    if ((-e $lock) && (-M $lock<0)){unlink $tmp;
   53: return 2}
   54:    elsif (!rename($tmp,$lock)) {return 3}
   55:    open(LOCK,"<$lock") or return 3;
   56:    $lock_pid=<LOCK>;
   57:    close(LOCK);
   58:    return 2 unless $lock_pid == $$;
   59:    return 0; 
   60: }
   61: 
   62: sub unlockfile
   63: {
   64:   open (LOCK, "<$lock") or return 1;
   65:   $lock_pid=<LOCK>;
   66:   close(LOCK);
   67:   return 2 unless $lock_pid==$$;
   68:   unlink($lock) or return 3;
   69:   return 0;
   70: }
   71: 
   72: 
   73: sub Suffix {
   74: 	my ($qnum) = @_;
   75:    my ($suffix) = 'а' if $qnum =~ /[234]$/;
   76:    $suffix = '' if $qnum =~ /156789$/ || $qnum =~ /1.$/;
   77:    return $suffix;
   78: }

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