pliva-si/m/menu.pl

#! /usr/local/bin/perl -w

use strict;
use DBI;
use Image::Magick;

use constant TYPE_NONE => scalar 2;
use constant TYPE_BULLET => scalar 3;
use constant TYPE_LINE => scalar 1;
use constant TYPE_BLUEDOT => scalar 4;

# size of menu image
my $w=125;
my $h_base=13;
my $h;

my $dir="/data/pliva-si/m";

my %iso2utf_tab = (
'¹' => 0x0161, 'ð' => 0x0111, 'è' => 0x010d, 'æ' => 0x0107, '¾' => 0x017e,
'©' => 0x0160, 'Ð' => 0x0110, 'È' => 0x010c, 'Æ' => 0x0106, '®' => 0x017d
);

sub iso2utf {
        local($_)=@_;

        sub utf8 {
                local($_)=@_;
                return $_ < 0x80 ? chr($_) :
                 $_ < 0x800 ? chr($_>>6&0x3F|0xC0) . chr($_&0x3F|0x80) :
                  chr($_>>12&0x0F|0xE0).chr($_>>6&0x3F|0x80).chr($_&0x3F|0x80);
        }
        s/([¹ðèæ¾©ÐÈÆ®])/utf8($iso2utf_tab{$1})/ge;
        return $_;
}

sub dump_gif {
        my ($text, $type, $file) = @_;
        $type ||= TYPE_NONE;
        $file ||= "$text-$type";
        $file =~ s/[^a-zA-Z0-9\-]/_/g;
        $file = lc($file);
        print "$text" unless ($file eq "-");
        my $tmp=$text;
        my $nl=1;
        $tmp =~ s/\\n/$nl++/gie;
        $h=$h_base*$nl;
        my $image = Image::Magick->new;
        $image->Set('size' => "${w}x${h}");
        $image->Read('xc:#283880');
        $text=~tr/ðèæÐÈÆ/¹ð¾èæ©Ð®ÈÆ/;       # 1250 -> iso8859-2
        $text=iso2utf($text);
        if ($type == TYPE_BULLET) {
                $image->Annotate('text' => $text, 'geometry' => '+17+10',
                        'font' => "\@$dir/arialbd.ttf", 'pointsize' => 11,
                        'fill' => '#ffffff', 'align' => 'left');
#               $image->Annotate('text' => $text, 'geometry' => '+17+1',
#                       'font' => "\@$dir/arialbd.ttf", 'pointsize' => 11,
#                       'pen' => '#FFFFFF', 'align' => 'left');
#               $image->Blur('radius' => 0.1);
                $image->Draw('primitive' => 'rectangle', 'stroke' => '#00D000',
                        'fill' => '#00D000', 'antialias' => 1, 'points' =>
                        '7,4 10,7');
        } elsif ($type == TYPE_BLUEDOT) {
                $image->Annotate('text' => $text, 'geometry' => '+17+10',
                        'font' => "\@$dir/arialbd.ttf", 'pointsize' => 11,
                        'fill' => '#ffffff', 'align' => 'left');
                $image->Draw('primitive' => 'rectangle', 'stroke' => '#00b2dc',
                        'fill' => '#00b2dc', 'antialias' => 1, 'points' =>
                        '7,4 10,7');
        } else {
                if ($type == TYPE_LINE) {
                        $image->Draw('primitive' => 'line',
                                'stroke' => '#00FF00', 'fill' => '#00FF00',
                                'antialias' => 1, 'points' => '1,'.($h-2).' 63,'.($h-2));
                        my ($br, $bg, $bb) = (0x00, 0xFF, 0x00);
                        my ($er, $eg, $eb) = (0x28, 0x38, 0x80);
                        my $range = $w - 64;
                        for (my $i = 0; $i < $range; $i++) {
                                my $j = $i + 64;
                                my $color = sprintf("#%02X%02X%02X",
                                        $br + (($er - $br) / $range) * $i,
                                        $bg + (($eg - $bg) / $range) * $i,
                                        $bb + (($eb - $bb) / $range) * $i
                                );
                                $image->Draw('primitive' => 'point',
                                        'stroke' => $color,
                                        'fill' => $color,
                                        'antialias' => 1,
                                        'points' => "$j,".($h-2));
                        }
                }
                $image->Annotate('text' => $text, 'geometry' => '+3+10',
                        'font' => "\@$dir/arialbd.ttf", 'pointsize' => 11,
                        'fill' => '#FFFFFF', 'align' => 'left');
#               $image->Blur('radius' => 1);
        }
        print " -> " unless ($file eq "-");
        $file .= ".gif" unless ($file eq "-");
        $image->Write('filename' => "gif:$dir/$file", 'colors' => 256,
                'interlace' => "none", 'compress' => 'lzw');
        print "$file\n" unless ($file eq "-");
        return "$file";
}

#print "Content-Type: image/gif\n\n";
#dump_gif("NOVOSTI", TYPE_LINE, "-");
#exit $?;

#
my $dbh = DBI->connect("DBI:Pg:dbname=plivasi", "dpavlin", "") ||
        die $DBI::errstr;
my $sth = $dbh->prepare("SELECT section,item,url,level,num FROM menu") ||
        die $dbh->errstr();
$sth->execute() || die $sth->errstr();
while (my @arr = $sth->fetchrow_array()) {
        my $sql="UPDATE menu SET file='".dump_gif($arr[1], $arr[3])."',w=$w,h=$h WHERE num=$arr[4]";
        $dbh->do($sql);
}
$sth->finish;
$dbh->disconnect;
exit $?;

1	ravilov	1.1	#! /usr/local/bin/perl -w
2
3			use strict;
4			use DBI;
5			use Image::Magick;
6
7	dpavlin	1.2	use constant TYPE_NONE => scalar 2;
8			use constant TYPE_BULLET => scalar 3;
9			use constant TYPE_LINE => scalar 1;
10	dpavlin	1.6	use constant TYPE_BLUEDOT => scalar 4;
11	ravilov	1.1
12	dpavlin	1.4	# size of menu image
13			my $w=125;
14			my $h_base=13;
15			my $h;
16
17	dpavlin	1.8	my $dir="/data/pliva-si/m";
18
19	dpavlin	1.6	my %iso2utf_tab = (
20			'¹' => 0x0161, 'ð' => 0x0111, 'è' => 0x010d, 'æ' => 0x0107, '¾' => 0x017e,
21			'©' => 0x0160, 'Ð' => 0x0110, 'È' => 0x010c, 'Æ' => 0x0106, '®' => 0x017d
22			);
23
24			sub iso2utf {
25			local($_)=@_;
26
27			sub utf8 {
28			local($_)=@_;
29			return $_ < 0x80 ? chr($_) :
30			$_ < 0x800 ? chr($_>>6&0x3F\|0xC0) . chr($_&0x3F\|0x80) :
31			chr($_>>12&0x0F\|0xE0).chr($_>>6&0x3F\|0x80).chr($_&0x3F\|0x80);
32			}
33			s/([¹ðèæ¾©ÐÈÆ®])/utf8($iso2utf_tab{$1})/ge;
34			return $_;
35			}
36
37	ravilov	1.1	sub dump_gif {
38			my ($text, $type, $file) = @_;
39			$type \|\|= TYPE_NONE;
40	dpavlin	1.7	$file \|\|= "$text-$type";
41	ravilov	1.1	$file =~ s/[^a-zA-Z0-9\-]/_/g;
42	dpavlin	1.5	$file = lc($file);
43	ravilov	1.1	print "$text" unless ($file eq "-");
44	dpavlin	1.4	my $tmp=$text;
45			my $nl=1;
46			$tmp =~ s/\\n/$nl++/gie;
47			$h=$h_base*$nl;
48	ravilov	1.1	my $image = Image::Magick->new;
49	dpavlin	1.4	$image->Set('size' => "${w}x${h}");
50	ravilov	1.1	$image->Read('xc:#283880');
51	dpavlin	1.6	$text=~tr/ðèæÐÈÆ/¹ð¾èæ©Ð®ÈÆ/; # 1250 -> iso8859-2
52			$text=iso2utf($text);
53	ravilov	1.1	if ($type == TYPE_BULLET) {
54	dpavlin	1.2	$image->Annotate('text' => $text, 'geometry' => '+17+10',
55	dpavlin	1.8	'font' => "\@$dir/arialbd.ttf", 'pointsize' => 11,
56	dpavlin	1.2	'fill' => '#ffffff', 'align' => 'left');
57			# $image->Annotate('text' => $text, 'geometry' => '+17+1',
58	dpavlin	1.8	# 'font' => "\@$dir/arialbd.ttf", 'pointsize' => 11,
59	dpavlin	1.2	# 'pen' => '#FFFFFF', 'align' => 'left');
60			# $image->Blur('radius' => 0.1);
61	ravilov	1.1	$image->Draw('primitive' => 'rectangle', 'stroke' => '#00D000',
62			'fill' => '#00D000', 'antialias' => 1, 'points' =>
63	dpavlin	1.6	'7,4 10,7');
64			} elsif ($type == TYPE_BLUEDOT) {
65			$image->Annotate('text' => $text, 'geometry' => '+17+10',
66	dpavlin	1.8	'font' => "\@$dir/arialbd.ttf", 'pointsize' => 11,
67	dpavlin	1.6	'fill' => '#ffffff', 'align' => 'left');
68			$image->Draw('primitive' => 'rectangle', 'stroke' => '#00b2dc',
69			'fill' => '#00b2dc', 'antialias' => 1, 'points' =>
70	ravilov	1.1	'7,4 10,7');
71			} else {
72			if ($type == TYPE_LINE) {
73			$image->Draw('primitive' => 'line',
74			'stroke' => '#00FF00', 'fill' => '#00FF00',
75	dpavlin	1.4	'antialias' => 1, 'points' => '1,'.($h-2).' 63,'.($h-2));
76	ravilov	1.1	my ($br, $bg, $bb) = (0x00, 0xFF, 0x00);
77			my ($er, $eg, $eb) = (0x28, 0x38, 0x80);
78	dpavlin	1.4	my $range = $w - 64;
79	ravilov	1.1	for (my $i = 0; $i < $range; $i++) {
80			my $j = $i + 64;
81			my $color = sprintf("#%02X%02X%02X",
82			$br + (($er - $br) / $range) * $i,
83			$bg + (($eg - $bg) / $range) * $i,
84			$bb + (($eb - $bb) / $range) * $i
85			);
86			$image->Draw('primitive' => 'point',
87			'stroke' => $color,
88	dpavlin	1.3	'fill' => $color,
89	ravilov	1.1	'antialias' => 1,
90	dpavlin	1.4	'points' => "$j,".($h-2));
91	ravilov	1.1	}
92			}
93	dpavlin	1.4	$image->Annotate('text' => $text, 'geometry' => '+3+10',
94	dpavlin	1.8	'font' => "\@$dir/arialbd.ttf", 'pointsize' => 11,
95	dpavlin	1.4	'fill' => '#FFFFFF', 'align' => 'left');
96			# $image->Blur('radius' => 1);
97	ravilov	1.1	}
98			print " -> " unless ($file eq "-");
99			$file .= ".gif" unless ($file eq "-");
100	dpavlin	1.8	$image->Write('filename' => "gif:$dir/$file", 'colors' => 256,
101	ravilov	1.1	'interlace' => "none", 'compress' => 'lzw');
102			print "$file\n" unless ($file eq "-");
103			return "$file";
104			}
105
106	dpavlin	1.2	#print "Content-Type: image/gif\n\n";
107			#dump_gif("NOVOSTI", TYPE_LINE, "-");
108			#exit $?;
109	ravilov	1.1
110	dpavlin	1.7	#
111	dpavlin	1.8	my $dbh = DBI->connect("DBI:Pg:dbname=plivasi", "dpavlin", "") \|\|
112	ravilov	1.1	die $DBI::errstr;
113	dpavlin	1.4	my $sth = $dbh->prepare("SELECT section,item,url,level,num FROM menu") \|\|
114	ravilov	1.1	die $dbh->errstr();
115			$sth->execute() \|\| die $sth->errstr();
116			while (my @arr = $sth->fetchrow_array()) {
117	dpavlin	1.4	my $sql="UPDATE menu SET file='".dump_gif($arr[1], $arr[3])."',w=$w,h=$h WHERE num=$arr[4]";
118			$dbh->do($sql);
119	ravilov	1.1	}
120			$sth->finish;
121			$dbh->disconnect;
122			exit $?;
123	dpavlin	1.4