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;

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

sub dump_gif {
        my ($text, $type, $file) = @_;
        $type ||= TYPE_NONE;
        $file ||= $text;
        $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');
        if ($type == TYPE_BULLET) {
                $image->Annotate('text' => $text, 'geometry' => '+17+10',
                        'font' => "\@arialbd.ttf", 'pointsize' => 11,
                        'fill' => '#ffffff', 'align' => 'left');
#               $image->Annotate('text' => $text, 'geometry' => '+17+1',
#                       'font' => "\@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');
        } 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' => "\@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:$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", "", "") ||
        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	ravilov	1.1
11	dpavlin	1.4	# size of menu image
12			my $w=125;
13			my $h_base=13;
14			my $h;
15
16	ravilov	1.1	sub dump_gif {
17			my ($text, $type, $file) = @_;
18			$type \|\|= TYPE_NONE;
19			$file \|\|= $text;
20			$file =~ s/[^a-zA-Z0-9\-]/_/g;
21	dpavlin	1.5	$file = lc($file);
22	ravilov	1.1	print "$text" unless ($file eq "-");
23	dpavlin	1.4	my $tmp=$text;
24			my $nl=1;
25			$tmp =~ s/\\n/$nl++/gie;
26			$h=$h_base*$nl;
27	ravilov	1.1	my $image = Image::Magick->new;
28	dpavlin	1.4	$image->Set('size' => "${w}x${h}");
29	ravilov	1.1	$image->Read('xc:#283880');
30			if ($type == TYPE_BULLET) {
31	dpavlin	1.2	$image->Annotate('text' => $text, 'geometry' => '+17+10',
32	ravilov	1.1	'font' => "\@arialbd.ttf", 'pointsize' => 11,
33	dpavlin	1.2	'fill' => '#ffffff', 'align' => 'left');
34			# $image->Annotate('text' => $text, 'geometry' => '+17+1',
35			# 'font' => "\@arialbd.ttf", 'pointsize' => 11,
36			# 'pen' => '#FFFFFF', 'align' => 'left');
37			# $image->Blur('radius' => 0.1);
38	ravilov	1.1	$image->Draw('primitive' => 'rectangle', 'stroke' => '#00D000',
39			'fill' => '#00D000', 'antialias' => 1, 'points' =>
40			'7,4 10,7');
41			} else {
42			if ($type == TYPE_LINE) {
43			$image->Draw('primitive' => 'line',
44			'stroke' => '#00FF00', 'fill' => '#00FF00',
45	dpavlin	1.4	'antialias' => 1, 'points' => '1,'.($h-2).' 63,'.($h-2));
46	ravilov	1.1	my ($br, $bg, $bb) = (0x00, 0xFF, 0x00);
47			my ($er, $eg, $eb) = (0x28, 0x38, 0x80);
48	dpavlin	1.4	my $range = $w - 64;
49	ravilov	1.1	for (my $i = 0; $i < $range; $i++) {
50			my $j = $i + 64;
51			my $color = sprintf("#%02X%02X%02X",
52			$br + (($er - $br) / $range) * $i,
53			$bg + (($eg - $bg) / $range) * $i,
54			$bb + (($eb - $bb) / $range) * $i
55			);
56			$image->Draw('primitive' => 'point',
57			'stroke' => $color,
58	dpavlin	1.3	'fill' => $color,
59	ravilov	1.1	'antialias' => 1,
60	dpavlin	1.4	'points' => "$j,".($h-2));
61	ravilov	1.1	}
62			}
63	dpavlin	1.4	$image->Annotate('text' => $text, 'geometry' => '+3+10',
64			'font' => "\@arialbd.ttf", 'pointsize' => 11,
65			'fill' => '#FFFFFF', 'align' => 'left');
66			# $image->Blur('radius' => 1);
67	ravilov	1.1	}
68			print " -> " unless ($file eq "-");
69			$file .= ".gif" unless ($file eq "-");
70			$image->Write('filename' => "gif:$file", 'colors' => 256,
71			'interlace' => "none", 'compress' => 'lzw');
72			print "$file\n" unless ($file eq "-");
73			return "$file";
74			}
75
76	dpavlin	1.2	#print "Content-Type: image/gif\n\n";
77			#dump_gif("NOVOSTI", TYPE_LINE, "-");
78			#exit $?;
79	ravilov	1.1
80	dpavlin	1.2	my $dbh = DBI->connect("DBI:Pg:dbname=plivasi", "", "") \|\|
81	ravilov	1.1	die $DBI::errstr;
82	dpavlin	1.4	my $sth = $dbh->prepare("SELECT section,item,url,level,num FROM menu") \|\|
83	ravilov	1.1	die $dbh->errstr();
84			$sth->execute() \|\| die $sth->errstr();
85			while (my @arr = $sth->fetchrow_array()) {
86	dpavlin	1.4	my $sql="UPDATE menu SET file='".dump_gif($arr[1], $arr[3])."',w=$w,h=$h WHERE num=$arr[4]";
87			$dbh->do($sql);
88	ravilov	1.1	}
89			$sth->finish;
90			$dbh->disconnect;
91			exit $?;
92	dpavlin	1.4