Return to counter7.pl CVS log

Up to [Local Repository] / db / prgsrc

Annotation of db/prgsrc/counter7.pl, revision 1.3

1.1       roma7       1: #!/usr/bin/perl
                      2: $wait=3;
                      3: $cfile = 'counts/count7.txt';
                      4: open STDERR, ">errors";
1.2       roma7       5: $lockdir="counts/";
1.1       roma7       6: $l = lc $ENV{'DOCUMENT_NAME'};
                      7: $header="Content-Type: text/html\n\n";
1.3     ! roma7       8: print $header;
        !             9: &lockfile && (print '?? раз', exit);
1.1       roma7      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);
1.3     ! roma7      26:     print "$c раз".&Suffix($c);
1.1       roma7      27:     &unlockfile ;
                     28:     exit
                     29:   }
                     30: }
                     31: 
                     32: open(F, ">>$cfile");
                     33: print F "1 - $l\n"; 
                     34: close(F);
                     35: 
1.3     ! roma7      36: print "первый раз";
1.1       roma7      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: }