root/lang/perl/Google-Chart-DBIC/trunk/lib/Google/Chart/DBIC.pm @ 17840

Revision 17840, 6.2 kB (checked in by lopnor, 5 years ago)

lang/perl/Google-Chart-DBIC: fix default color

Line 
1package Google::Chart::DBIC;
2use Moose;
3use Google::Chart;
4use Google::Chart::Types;
5use Google::Chart::DBIC::Types;
6use Data::Dumper ();
7use POSIX ();
8use Scalar::Util ();
9our $VERSION = '0.01';
10
11has 'size' => (
12    is => 'rw',
13    isa => 'Google::Chart::Size',
14    coerce => 1,
15    required => 1,
16    default => sub {
17        Class::MOP::load_class('Google::Chart::Size');
18        Google::Chart::Size->new( width => 400, height => 400 );
19    },
20);
21has 'type' => (
22    is => 'rw',
23    isa => 'Google::Chart::Type',
24    coerce => 1,
25    required => 1,
26    default => sub {
27        Class::MOP::load_class('Google::Chart::Type::Line');
28        Google::Chart::Type::Line->new;
29    },
30);
31has 'color' => (
32    is => 'rw',
33    isa => 'Google::Chart::Color',
34    coerce => 1,
35    required => 1,
36    default => sub {
37        Class::MOP::load_class('Google::Chart::Color');
38#        my @default;
39#        for (1 .. 10) {
40#            push @default, (sprintf "%06X", rand() * 0xffffff);
41#        }
42        my @default = qw(
43            ffff00
44            ff00ff
45            00ffff
46            ff0000
47            00ff00
48            0000ff
49            669900
50            996600
51            006699
52            009966
53            990066
54            660099
55        );
56        Google::Chart::Color->new(values => \@default);
57    },
58);
59has 'resultset' => (
60    is => 'rw',
61    isa => 'DBIx::Class::ResultSet',
62    required => 1,
63);
64has 'min_value' => (
65    is => 'rw',
66    isa => 'Num',
67);
68has 'max_value' => (
69    is => 'rw',
70    isa => 'Num',
71);
72has 'axis_column' => (
73    is => 'rw',
74    isa => 'Str',
75);
76has 'key_column' => (
77    is => 'rw',
78    coerce => 1,
79    isa => 'Google::Chart::DBIC::KeyColumn'
80);
81
82__PACKAGE__->meta->make_immutable;
83
84no Moose;
85
86
87sub __find_axis_column {
88    my ($self, $row) = @_;
89
90    my @primary = $self->resultset->result_source->primary_columns;
91    my $axis_column = $self->axis_column || 'axis_x';
92
93    if ( $row->has_column_loaded($axis_column))
94    {
95        # no op. we're fine
96    } elsif (scalar @primary == 1) {
97        # either we don't have a axis_column defined, or the
98        # selected query did not use axis_column... but we have a
99        # primary key
100        $axis_column = $primary[0];
101    } else {
102        # In this case, as_uri() will Do The Right Thing
103        $axis_column = undef;
104    }
105
106    return $axis_column;
107}
108
109sub as_uri {
110    my $self = shift;
111    my $dataset = {};
112    my $axis_x = [];
113    my $max_value = 0;
114    my $min_value = 0;
115
116    my $resultset = $self->resultset;
117                     
118    my $axis_column; # this will be calculated only once
119    while (my $row = $resultset->next) {
120        my $axis = '';
121
122        $axis_column ||= $self->__find_axis_column( $row );
123        $axis = $row->get_column($axis_column) if $axis_column;
124        push @$axis_x, $axis unless grep {$_ eq $axis} @$axis_x;
125
126#        if ($axis_column && scalar @primary > 1 &&
127        for my $col ($row->columns) {
128            next unless $row->has_column_loaded($col);
129            next if $axis_column && $col eq $axis_column;
130            my $v = $row->$col;
131            next unless Scalar::Util::looks_like_number $v;
132            my $k = $col;
133            $k = join(':', map( {$row->get_column($_)} @{$self->key_column} ), $k) if $self->key_column;
134            push @{$dataset->{$k}}, Scalar::Util::looks_like_number $v ? $v : undef;
135            $max_value = $v if $v >= $max_value;
136            $min_value = $v if $v < $min_value;
137        }
138    }
139    $max_value = $self->max_value || $max_value;
140    $min_value = $self->min_value || $min_value;
141    my $chart = Google::Chart->new(
142        size => $self->size,
143        type => $self->type,
144        axis => [
145            {
146                location => 'x',
147                labels   => $axis_x ? $self->_roughen($axis_x, 5) : [],
148            },
149            {
150                location => 'y',
151                labels   => [ map { ($_ * ($max_value - $min_value)) + $min_value } map { 0.2 * $_ } (0 .. 5) ],
152            }
153        ],
154        data => {
155            module => 'Extended',
156            args => {
157                dataset => [values %$dataset],
158                max_value => $max_value,
159                min_value => $min_value,
160            },
161        },
162#        color => [@{$self->color}[0 .. (scalar values %$dataset) - 1]],
163        color => $self->color,
164        legend => [keys %$dataset],
165    );
166    return $chart->as_uri;
167}
168
169sub _roughen {
170    my ($self, $arr, $count) = @_;
171
172    return $arr if scalar @$arr < ($count - 1);
173    my $gap = POSIX::ceil($#{$arr}/ ($count - 1));
174    my $ret = [];
175    for my $i (0 .. $#{$arr}) {
176        push @$ret, ($i % $#{$arr} && $i % $gap) ? '' : $arr->[$i];
177    }
178    return $ret;
179}
180
1811;
182__END__
183
184=head1 NAME
185
186Google::Chart::DBIC - glue class for Google::Chart and DIBC
187
188=head1 SYNOPSIS
189
190  use TestApp::Schema;
191  use Google::Chart::DBIC;
192
193  my $schema = TestApp::Schema->connect(
194      "dbi:SQLite:$dbfile"
195  );
196  my @list = TestApp::Schema->resultset('Climate')->search({
197      place => 'Tokyo',
198  }{
199      select => ['high','low','month'],
200      as => ['high','low','axis_x'],
201  });
202  my $chart = Google::Chart::DBIC->new({
203      resultset => \@list,
204      size => '300x400',
205      type => 'line',
206  });
207  my $uri = $chart->as_uri;   
208
209 
210=head1 DESCRIPTION
211
212Google::Chart::DBIC is glue class for Google::Chart and DBIC.
213
214=head1 METHODS
215
216=head2 new(%args)
217
218Constructor.
219
220=over 4
221
222=item type
223
224will be passed to Google::Chart constructor.
225
226=item size
227
228will be passed to Google::Chart constructor.
229
230=item resultset
231
232'looks_like_number' value in the resultset will be plotted on the chart.
233If there is a column named 'axis_x', it will be assigned as bottom axis of the chart.
234
235=item max_value
236
237specify max_value of the chart. defaults max value of the resultset.
238
239=item color
240
241specify color if you don't like default colors.
242
243=item axis_column
244
245specify column name to use as bottom axis of the chart.
246
247=item key_column
248
249specify column name to use as hash key.
250
251=item value_column
252
253specify column name to use as hash value.
254
255=back
256
257=head2 as_uri
258
259Returns google chart uri.
260
261=head1 AUTHOR
262
263Author E<lt>nobuo.danjou@gmail.comE<gt>
264
265This library is free software; you can redistribute it and/or modify
266it under the same terms as Perl itself.
267
268=head1 SEE ALSO
269
270L<Google::Chart>
271
272=cut
273
Note: See TracBrowser for help on using the browser.