HighPerl Version 2.5

generated: Sun Jun 16 14:39:37 2002

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