czf4bfu.prosek.czf

Subversion Repositories:
[/] [zal/] [genservices.pl] - Rev 10 Go to most recent revision
Compare with Previous - Blame - Download
#!/usr/bin/perl
#
# Cte ze stdin DEU a generuje z nich html stranku
# Autor: Petr Mensik <pihhan@cipis.net>
#
use strict;

my (@parameters);

my %record;
my %services;
my %options;


my $image_prefix = "icons/";
my $image_suffix = "png";
my $services_prefix = "/home/www/html/czf4bfu/services/";
my $image_systemprefix = "$services_prefix";
my $all_list = $services_prefix."index.html";

sub check_icon
{
        my ($fileh,$svcname) = @_;

        my $webfile = "$image_prefix$svcname.$image_suffix";
        my $file = "$image_systemprefix$webfile";
        open(EXTRA, "< $file") || return 1;
                close(EXTRA);
                print $fileh "<img src=\"$webfile\" alt=\"$svcname\" />";
                return 0;
#       } else {
#               print STDERR "nepodarilo se $svcname\n";
         return 1;
#        }
}

sub service_header
{
        my ($svcname) = @_;

        open( SVC, "> $services_prefix$svcname.html") || return 1;
        print SVC "
<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
   \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
<html>
<head>
<title>Seznam poskytovatelů služby $svcname</title>
</head>
<body>
<h1>Poskytovatelé služby $svcname v síti CzFree.net</h1>
";
        close(SVC);     
}

sub service_footer
{
        my ($svcname) = @_;

        open( SVC, ">> $services_prefix$svcname.html") || return 1;

        print SVC "
        <p id=\"summary\">
                Nalezených služeb tohoto typu: $services{$svcname}
        </p>
        </body>
        </html>";
}

# z jednoho deu udelej jeden HTML
sub makeone
{
        my ($file) = @_;
        
        if (!$file) {
                $file = $all_list;
        }
        
        open (SVC, ">> $file") || die "Nelze pridat zaznam do $file: $_";

        print SVC "<div id=\"svc$record{IDPOLOZKY}\">\n";
        print SVC "<h2>\n";
        if ($record{TYP}) {
                check_icon(\*SVC, $record{TYP});
        }
        print SVC "     $record{NAZEV}</h2>\n";

        print SVC "<p>
        ";
        print SVC "<span id=\"id\">[$record{IDPOLOZKY}]</span> ";
        
        print SVC "
        <a href=\"$record{TYP}.html\" id=\"typ\">$record{TYP}</a>
        ";
        if ($record{URL}) {
                print SVC "<a href=\"$record{URL}\" id=\"dns\">[dns]</a>
                ";
        }
        if ($record{URLIP}) {
        print SVC "<a href=\"$record{URLIP}\" id=\"ip\">[ip-only]</a>
                ";
        }

        if ($record{URLINET}) {
        print SVC "<a href=\"$record{URLINET}\" id=\"inet\">[internet]</a>
                ";
        }

        if ($record{PRIVATNI}) {
        print SVC "(privátní) ";
        }

        print SVC "</p>\n";

        print SVC "<p>
        $record{POPIS}
        </p>\n";
#       print "
#       <dt id=\"typ\">typ</dt><dd>$record{TYP}</dd>
#       ";
        
        if ($record{OBLASTI}) {
                print SVC "<dt id=\"oblasti\">oblasti</dt><dd>$record{OBLASTI}</dd>
                ";
        }
        if ($record{IP}) {
                print SVC "<dt id=\"hostname\">hostname</dt><dd>$record{HOST}</dd>
                ";
        }
        if ($record{IP}) {
                print SVC "<dt id=\"host\">IP</dt><dd>$record{IP}</dd>
                ";
        }
        if ($record{KONTAKT}) {
                my $kontakt = $record{KONTAKT};
                print SVC "<dt id=\"kontakt\">kontakt</dt><dd>$record{KONTAKT}</dd>
                ";
        }
        if ($record{ORIGIN}) {
                print SVC "<dt id=\"origin\">původ</dt><dd>$record{ORIGIN}</dd>
                ";
        }
        if ($record{ALT}) {
                print SVC "<dt id=\"alt\">alternativní</dt><dd>$record{ALT}</dd>
                ";
        }

        print SVC "
        </div>
        ";

        close(SVC);
}

#getopts("", \%options );

open(SVC, "> $all_list");

print SVC "
<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
   \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
<html>
<head>
<title>Seznam služeb z CZF4BFU listu</title>
</head>
<body>
<h1>Seznam všech nalezených služeb</h1>
";

close(SVC);

foreach my $file (@ARGV) {
        open(DEU, "< $file") || die("Chyba otevirani $file");
        print "Processing $file\n";
        while (<DEU>) {
        chomp;
# pokus o ostraneni dosoveho CR
        $_ =~ s/\r$//;

        if (/^\s*$/ && $record{TYP}) {
                # prazdny radek, oddelovac
                # pokud nenacteme aspon prvni TYP, nedelame nic.
                # ochrana proti vice prazdnym radkum

                $record{FILE}= $file;
                $record{ORIGIN} = $file;
                $record{ORIGIN} =~ s/.*global-(\d+\.\d+\.\d+\.\d+).txt$/\1/;

                makeone($all_list,\%record);
                my $typ = $record{TYP};
                if (!$services{$typ}) {

                        print "New service $typ\n";
                        service_header($typ);
                        $services{$typ} = 0;
                }
                makeone("$services_prefix$typ.html");
                $services{$typ}++; 
                %record = ();
        } elsif (/^([A-Zi]+):\s*(.*)\s{0,1}$/) {
        # jelikoz se zda, ze prvni zaznam ma prioritu pred nasledujicimi, budu pro
        # jednoduchost mit jenom prvni zaznam tak, ze ty dalsi ignoruju
                $record{$1} = $2 unless ($record{$1});
#               print "dbg: $1 $2 $record{URL}\n";
        } else {
                print STDERR "Nepodporovany radek $_\n.";
        }
        } # while

        close(DEU);

} # foreach
open (SVC, ">> $all_list") || die "Nelze pridat do $all_list";
print SVC "
</body>
</html>
";

foreach my $typ (keys %services) {
        service_footer($typ);
}

close(SVC);