Return to counter7.pl CVS log

Up to [Local Repository] / db / prgsrc

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

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";
                      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: }