HighPerl Version 2.5

generated: Sun Jun 16 14:14:26 2002

1	#!/usr/bin/perl -wT
2	
3	use strict;
4	use CGI;
5	use HTML::Template;
6	
7	use constant FTMPL => "error.tmpl";
8	use constant UDDIR => "tc/";
9	use constant FLOCK => 0;        # Switch to 1 if your system supports FLOCK
10	
11	my $q=new CGI;
12	
13	# Header ausgeben
14	print $q->header;
15	
16	
17	my($file) = $q->param("file")=~/^([\w.]+)$/;
18	
19	unless ($file){
20	    # Sicherheitsfehler
21	
22	    fault(110,"Sicherheitsfehler beim übergeben des Dateinamens, der Dateiname darf nur reguläre Zeichen enthalten!");
23	}
24	
25	
26	open FILE,UDDIR.$file or fault(300,"Fehler beim Versuch die Datei ".UDDIR.$file." zu öffnen.");
27	    # Datei zum lesen locken
28	    if(FLOCK){ flock FILE, "LOCK_SH" or fault(301,"Fehler beim Versuch die Datei ".UDDIR.$file." zu locken."); }
29	    
30	
31	    my $count=<FILE>; $count++;
32	
33	    # Datei wieder freigeben
34	    if(FLOCK){ flock FILE, "LOCK_UN" or fault(302,"Fehler beim Versuch die Datei ".UDDIR.$file." zu entlocken."); }
35	close FILE or fault(302,"Fehler beim Versuch die Datei ".UDDIR.$file." zu schließen.");
36	
37	
38	open FILE, ">".UDDIR.$file or fault(300,"Fehler beim Versuch die Datei ".UDDIR.$file." zu öffnen.");
39	
40	    # Datei zum schreiben exklusiv locken
41	    if(FLOCK){flock FILE, "LOCK_EX" or fault(301,"Fehler beim Versuch die Datei ".UDDIR.$file." exklusiv zu locken."); }
42	    
43	    print FILE $count;
44	
45	    # Datei wieder freigeben
46	    if(FLOCK){ flock FILE, "LOCK_UN" or fault(302,"Fehler beim Versuch die Datei ".UDDIR.$file." zu entlocken."); }
47	close FILE or fault(302,"Fehler beim Versuch die Datei ".UDDIR.$file." zu schließen.");
48	
49	    # Jetzt nur noch das Nümmernchen ausgeben
50	    print "<script language=\"JavaScript\">\n   document.write(\'".$count."\');\n</script>";
51	
52	
53	return 1;
54	
55	sub fault {
56	    my $num  = shift(@_);
57	    my $desc = shift(@_);
58	
59	    my $tmpl = new HTML::Template(filename => FTMPL);
60	    
61	    $tmpl->param(num=>$num,desc=>$desc);
62	
63	    print $tmpl->output;
64	
65	    print $q->end_html();
66	
67	    die $desc;
68	}