jablonka.czprosek.czf

czf4bfu.prosek.czf

 Subversion Repositories:
[/] [zal/] [genservices.pl] - Blame information for rev 10

 

Line No. Rev Author Line
11simandl#!/usr/bin/perl
2#
3# Cte ze stdin DEU a generuje z nich html stranku
4# Autor: Petr Mensik <pihhan@cipis.net>
5#
6use strict;
7 
8my (@parameters);
9 
10my %record;
11my %services;
12my %options;
13 
14 
15my $image_prefix = "icons/";
16my $image_suffix = "png";
17my $services_prefix = "/home/www/html/czf4bfu/services/";
18my $image_systemprefix = "$services_prefix";
19my $all_list = $services_prefix."index.html";
20 
21sub check_icon
22{
23 my ($fileh,$svcname) = @_;
24 
25 my $webfile = "$image_prefix$svcname.$image_suffix";
26 my $file = "$image_systemprefix$webfile";
27 open(EXTRA, "< $file") || return 1;
28 close(EXTRA);
29 print $fileh "<img src=\"$webfile\" alt=\"$svcname\" />";
30 return 0;
31# } else {
32# print STDERR "nepodarilo se $svcname\n";
33 return 1;
34# }
35}
36 
37sub service_header
38{
39 my ($svcname) = @_;
40 
41 open( SVC, "> $services_prefix$svcname.html") || return 1;
42 print SVC "
43<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
44 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
45<html>
46<head>
47<title>Seznam poskytovatelů služby $svcname</title>
48</head>
49<body>
50<h1>Poskytovatelé služby $svcname v síti CzFree.net</h1>
51";
52 close(SVC);
53}
54 
55sub service_footer
56{
57 my ($svcname) = @_;
58 
59 open( SVC, ">> $services_prefix$svcname.html") || return 1;
60 
61 print SVC "
62 <p id=\"summary\">
63 Nalezených služeb tohoto typu: $services{$svcname}
64 </p>
65 </body>
66 </html>";
67}
68 
69# z jednoho deu udelej jeden HTML
70sub makeone
71{
72 my ($file) = @_;
73 
74 if (!$file) {
75 $file = $all_list;
76 }
77 
78 open (SVC, ">> $file") || die "Nelze pridat zaznam do $file: $_";
79 
80 print SVC "<div id=\"svc$record{IDPOLOZKY}\">\n";
81 print SVC "<h2>\n";
82 if ($record{TYP}) {
83 check_icon(\*SVC, $record{TYP});
84 }
85 print SVC " $record{NAZEV}</h2>\n";
86 
87 print SVC "<p>
88 ";
89 print SVC "<span id=\"id\">[$record{IDPOLOZKY}]</span> ";
90 
91 print SVC "
92 <a href=\"$record{TYP}.html\" id=\"typ\">$record{TYP}</a>
93 ";
94 if ($record{URL}) {
95 print SVC "<a href=\"$record{URL}\" id=\"dns\">[dns]</a>
96 ";
97 }
98 if ($record{URLIP}) {
99 print SVC "<a href=\"$record{URLIP}\" id=\"ip\">[ip-only]</a>
100 ";
101 }
102 
103 if ($record{URLINET}) {
104 print SVC "<a href=\"$record{URLINET}\" id=\"inet\">[internet]</a>
105 ";
106 }
107 
108 if ($record{PRIVATNI}) {
109 print SVC "(privátní) ";
110 }
111 
112 print SVC "</p>\n";
113 
114 print SVC "<p>
115 $record{POPIS}
116 </p>\n";
117# print "
118# <dt id=\"typ\">typ</dt><dd>$record{TYP}</dd>
119# ";
120 
121 if ($record{OBLASTI}) {
122 print SVC "<dt id=\"oblasti\">oblasti</dt><dd>$record{OBLASTI}</dd>
123 ";
124 }
125 if ($record{IP}) {
126 print SVC "<dt id=\"hostname\">hostname</dt><dd>$record{HOST}</dd>
127 ";
128 }
129 if ($record{IP}) {
130 print SVC "<dt id=\"host\">IP</dt><dd>$record{IP}</dd>
131 ";
132 }
133 if ($record{KONTAKT}) {
134 my $kontakt = $record{KONTAKT};
135 print SVC "<dt id=\"kontakt\">kontakt</dt><dd>$record{KONTAKT}</dd>
136 ";
137 }
138 if ($record{ORIGIN}) {
139 print SVC "<dt id=\"origin\">původ</dt><dd>$record{ORIGIN}</dd>
140 ";
141 }
142 if ($record{ALT}) {
143 print SVC "<dt id=\"alt\">alternativní</dt><dd>$record{ALT}</dd>
144 ";
145 }
146 
147 print SVC "
148 </div>
149 ";
150 
151 close(SVC);
152}
153 
154#getopts("", \%options );
155 
156open(SVC, "> $all_list");
157 
158print SVC "
159<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
160 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
161<html>
162<head>
163<title>Seznam služeb z CZF4BFU listu</title>
164</head>
165<body>
166<h1>Seznam všech nalezených služeb</h1>
167";
168 
169close(SVC);
170 
171foreach my $file (@ARGV) {
172 open(DEU, "< $file") || die("Chyba otevirani $file");
173 print "Processing $file\n";
174 while (<DEU>) {
175 chomp;
176# pokus o ostraneni dosoveho CR
177 $_ =~ s/\r$//;
178 
179 if (/^\s*$/ && $record{TYP}) {
180 # prazdny radek, oddelovac
181 # pokud nenacteme aspon prvni TYP, nedelame nic.
182 # ochrana proti vice prazdnym radkum
183 
184 $record{FILE}= $file;
185 $record{ORIGIN} = $file;
186 $record{ORIGIN} =~ s/.*global-(\d+\.\d+\.\d+\.\d+).txt$/\1/;
187 
188 makeone($all_list,\%record);
189 my $typ = $record{TYP};
190 if (!$services{$typ}) {
191 
192 print "New service $typ\n";
193 service_header($typ);
194 $services{$typ} = 0;
195 }
196 makeone("$services_prefix$typ.html");
197 $services{$typ}++;
198 %record = ();
199 } elsif (/^([A-Zi]+):\s*(.*)\s{0,1}$/) {
200 # jelikoz se zda, ze prvni zaznam ma prioritu pred nasledujicimi, budu pro
201 # jednoduchost mit jenom prvni zaznam tak, ze ty dalsi ignoruju
202 $record{$1} = $2 unless ($record{$1});
203# print "dbg: $1 $2 $record{URL}\n";
204 } else {
205 print STDERR "Nepodporovany radek $_\n.";
206 }
207 } # while
208 
209 close(DEU);
210 
211} # foreach
212open (SVC, ">> $all_list") || die "Nelze pridat do $all_list";
213print SVC "
214</body>
215</html>
216";
217 
218foreach my $typ (keys %services) {
219 service_footer($typ);
220}
221 
222close(SVC);

Powered by WebSVN 2.2.1