Return to counter7.pl CVS log

Up to [Local Repository] / db / prgsrc

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

1.1     ! roma7       1: #!/usr/bin/perl
        !             2: $wait=3;
        !             3: $cfile = 'counts/count7.txt';
        !             4: open STDERR, ">errors";
        !             5: $lockdir="c:/html/countdir/";
        !             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: }