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 $font="arialbd.ttf";
my $font="trebucbd.ttf";

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