Return to counter7.pl CVS log

Up to [Local Repository] / db / prgsrc

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

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