/[omni_gantt]/db2gantt.cgi
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /db2gantt.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations)
Thu Sep 12 16:35:35 2002 UTC (21 years, 6 months ago) by dpavlin
Branch: MAIN
Changes since 1.2: +51 -17 lines
draw it's own pngs, fixes

1 dpavlin 1.1 #!/usr/bin/perl -w
2    
3     use strict;
4     use DBI;
5     use Data::Dumper;
6     use Date::Parse;
7 dpavlin 1.3 use CGI qw/:standard/;
8    
9     # default range
10     my $from="2002-09-11 18:00";
11     my $to="2002-09-13 00:00:00";
12    
13     my $debug = 1;
14     my $width = 800;
15    
16     #--- no user servicable parts below this line
17    
18     my %cols = (
19     'In Progress' => '0,255,0',
20     'In Progress/Failure' => '255,128,128',
21     'In Progress/Errors' => '255,128,128',
22     'Queuing' => '255,255,0',
23     'Aborted', => '255,0,0',
24     'Failed', => '255,0,0',
25     'Completed', => '0,255,0',
26     'Completed/Errors' => '0,255,255',
27     'Completed/Failure', => '0,255,255'
28     );
29    
30    
31     if (param('pic')) {
32     print "Content-type: image/png\n\n";
33     # create picture using GD
34     use GD;
35     my $im = new GD::Image(1,8);
36     my $back = $im->colorAllocate(255,255,255);
37     $im->transparent($back);
38     my ($r,$g,$b) = split(/,/,param('pic'));
39     my $col = $im->colorAllocate($r,$g,$b);
40     $im->fill(0,0,$col);
41     binmode STDOUT;
42     print $im->png;
43     exit;
44     }
45 dpavlin 1.1
46     print "Content-type: text/html\n\n";
47    
48     # all vars ending in *_t have utime in them.
49     #
50     my $from_t = str2time($from);
51     my $to_t = str2time($to);
52     my $len_t = $to_t - $from_t;
53    
54     die "interval must be positive and bigger than 1 sec !" if ($len_t < 1);
55    
56     my $dbh = DBI->connect("DBI:Pg:dbname=gantt","","") || die $DBI::errstr;
57 dpavlin 1.3 my $q=new CGI;
58 dpavlin 1.1
59    
60     print "<table>";
61 dpavlin 1.3 print "<tr bgcolor=#e0e0e0><td>Specification</td><td align=left>$from</td><td align=right>$to</td></tr>\n";
62    
63 dpavlin 1.1
64    
65     sub draw {
66     my $l = shift @_; # lenght of event utime
67 dpavlin 1.3 my $status = shift @_; # what to draw
68 dpavlin 1.2 my $alt = shift @_;
69    
70 dpavlin 1.1 my $size = int($l / ($len_t / $width)) || 1; # dump size (min. size=1)
71    
72 dpavlin 1.3 print STDERR "l[$status]:$l scale:",($len_t/$width)," size:$size<br>\n" if ($debug);
73 dpavlin 1.1
74 dpavlin 1.3 my $col = $cols{$status} || '240,240,240';
75     print "<img src=".$q->url(-relative=>1)."?pic=$col width=$size height=8 alt=\"$alt\">";
76 dpavlin 1.1 }
77    
78     my $sql = "select start,finish,specification,status
79     from gantt
80     where (start < '$from' and finish > '$from') or
81     (start > '$from' and start < '$to')
82     order by specification
83     ";
84    
85     my $sth = $dbh->prepare($sql) || die "sql: $sql ".$dbh->errstr;
86    
87     my %spec; # specification hash
88    
89     my $curr_spec;
90     my $curr_t = $from_t;
91    
92     $sth->execute() || die "sql: $sql ".$dbh->errstr;
93 dpavlin 1.2
94 dpavlin 1.1 while(my $row = $sth->fetchrow_hashref) {
95     if ($row->{specification} ne $curr_spec) {
96    
97 dpavlin 1.3 if ($curr_t < $to_t && $curr_spec) {
98 dpavlin 1.1 my $t = $to_t - $curr_t;
99     print STDERR "[filler $curr_t:$t]" if ($debug);
100 dpavlin 1.3 draw($t,undef,$row->{start}." - ".$row->{finish}." ".$row->{status});
101 dpavlin 1.1 }
102    
103     print "</td></tr>\n" if ($curr_t != 0);
104     print "<tr><td>", $row->{specification},"</td><td colspan=2>";
105    
106     $curr_t = $from_t; # init timeline
107     $curr_spec = $row->{specification};
108    
109     }
110    
111     my $start_t = str2time($row->{start});
112     my $fin_t = str2time($row->{finish});
113    
114     if ($start_t > $curr_t) {
115     my $t = $start_t - $curr_t;
116     print STDERR "[filler $curr_t:$t]" if ($debug);
117 dpavlin 1.3 draw($t,undef,$row->{start}." - ".$row->{finish}." ".$row->{status});
118 dpavlin 1.1 $curr_t = $start_t;
119     }
120    
121     my $len = $fin_t - $start_t;
122     # $len = $len_t if ($len > $len_t);
123     my $less = '';
124     my $more = '';
125    
126     if ($start_t < $from_t) {
127     # $len += ($from_t - $start_t);
128     $len = ($fin_t - $curr_t);
129     $less = "<<";
130     }
131     if ($fin_t > $to_t) {
132     # $len -= ($fin_t - $to_t);
133     $len = ($to_t - $curr_t);
134     $more = ">>"; # event now shown whole
135     }
136    
137     print STDERR "[$less",$row->{status}," $curr_t:$len$more]" if ($debug);
138 dpavlin 1.3 draw($len,$row->{status},$row->{start}." - ".$row->{finish}." ".$row->{status});
139 dpavlin 1.1
140     $curr_t += $len;
141    
142     # print Dumper($row);
143    
144     }
145    
146     if ($curr_t < $to_t ) {
147     my $t = $to_t - $curr_t;
148     print STDERR "[filler $curr_t:$t]" if ($debug);
149 dpavlin 1.3 draw($t);
150 dpavlin 1.1 }
151    
152     undef $sth;
153     $dbh->disconnect;
154    
155 dpavlin 1.3 print "</td></tr>\n</table>";
156 dpavlin 1.1

  ViewVC Help
Powered by ViewVC 1.1.26