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