Diff -- /var/www/vhosts/3dshawn.com/site1/MODS/Charts.pm

O Operator
Diff

/var/www/vhosts/3dshawn.com/site1/MODS/Charts.pm

modified on local at 2026-07-12 00:02:02

Added
+18
lines
Removed
-8
lines
Context
229
unchanged
Blobs
from 4b17b4998769
to 59483bc8e7f8
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
11package MODS::Charts;
22#======================================================================
33# DriftSense -- hand-rolled SVG chart helpers (zero external deps).
44#
55# All charts are inline SVG strings that use CSS variables from
66# drift_sense.css so palette + theme changes propagate automatically.
77#
88# Public functions (call as MODS::Charts::stacked_bars(...), etc.):
99#
1010# stacked_bars(days => \@days, series => { file => \@nums, schema => \@nums })
1111# Wide activity timeline. One bar per day, stacked by series.
1212#
1313# sparkline(values => \@nums, w => 80, h => 20)
1414# Tiny inline SVG summary line. Great next to file / table names.
1515#
1616# simple_donut(size, values => [{v, color, label}], center)
1717# Compact donut for savings / drift / dedup ratios.
1818#======================================================================
1919use strict;
2020use warnings;
2121
2222sub _esc {
2323 my $s = shift; $s //= '';
2424 $s =~ s/&/&amp;/g; $s =~ s/</&lt;/g; $s =~ s/>/&gt;/g;
2525 return $s;
2626}
2727
2828#---------------------------------------------------------------------
2929# stacked_bars({ days => [...], series => { file => [...], schema => [...] } })
3030#
3131# @days = arrayref of day labels (oldest -> newest). @series entries
3232# must be same-length arrayrefs of integers. Bars stack file (teal)
3333# below schema (amber). Y-axis auto-scales.
3434#---------------------------------------------------------------------
3535sub stacked_bars {
3636 my %a = @_;
3737 my $days = $a{days} || []; # display labels e.g. "Jul 10"
3838 my $day_keys = $a{day_keys} || []; # ISO YYYY-MM-DD for links/tooltips
3939 my $series = $a{series} || {};
4040 my $w = $a{width} || 900;
4141 my $h = $a{height} || 160;
4242 my $link_file = $a{link_file} || '/file_changes.cgi';
4343 my $link_schema = $a{link_schema} || '/schema_changes.cgi';
4444
4545 my $n = scalar @$days;
4646 return '' unless $n;
4747 # Fall back to display labels for keys if caller didn't pass ISO dates.
4848 my @keys = @$day_keys ? @$day_keys : @$days;
4949
5050 my @file_v = @{ $series->{file} || [] };
5151 my @schema_v = @{ $series->{schema} || [] };
5252
5353 my $max = 1;
5454 for my $i (0..$n-1) {
5555 my $t = ($file_v[$i] || 0) + ($schema_v[$i] || 0);
5656 $max = $t if $t > $max;
5757 }
5858
5959 my $pad_l = 40;
6060 my $pad_b = 22;
6161 my $pad_t = 8;
6262 my $pad_r = 8;
6363
6464 my $plot_w = $w - $pad_l - $pad_r;
6565 my $plot_h = $h - $pad_t - $pad_b;
6666
6767 my $bar_gap = 1;
6868 my $bar_w = ($plot_w - ($n - 1) * $bar_gap) / $n;
6969 $bar_w = 1 if $bar_w < 1;
7070
7171 my $svg = qq~<svg class="ds-timeline" viewBox="0 0 $w $h" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" style="width:100%;height:${h}px" preserveAspectRatio="none">~;
7272 $svg .= q~<style>
7373 .ds-timeline .ds-day { cursor: pointer; }
7474 .ds-timeline .ds-day:hover .ds-hit { fill: rgba(20,184,166,0.06); }
7575 .ds-timeline .ds-day:hover .ds-bar { opacity: 1; }
7676 .ds-timeline .ds-bar { transition: opacity .15s ease; }
7777 .ds-timeline a { text-decoration: none; }
7878 </style>~;
7979
8080 # Grid lines + Y-axis labels
8181 for my $frac (0, 0.25, 0.5, 0.75, 1) {
8282 my $y = $pad_t + $plot_h * (1 - $frac);
8383 my $lbl = int($max * $frac);
8484 $svg .= qq~<line x1="$pad_l" y1="$y" x2="~ . ($w - $pad_r) . qq~" y2="$y" stroke="#223050" stroke-width="1" stroke-dasharray="2 4" opacity="0.5"/>~;
8585 $svg .= qq~<text x="~ . ($pad_l - 6) . qq~" y="$y" text-anchor="end" dominant-baseline="middle" font-family="var(--mono, monospace)" font-size="9" fill="#6a7a94">$lbl</text>~;
8686 }
8787
8888 # Bars -- wrap each day in a group with data-* attributes so a JS
8989 # tooltip can pick up the counts on hover. Each segment is its own
9090 # <a> so click routes to file_changes or schema_changes.
9191 for my $i (0..$n-1) {
9292 my $fv = $file_v[$i] || 0;
9393 my $sv = $schema_v[$i] || 0;
9494 my $x = $pad_l + $i * ($bar_w + $bar_gap);
9595 my $file_h = ($fv / $max) * $plot_h;
9696 my $schema_h = ($sv / $max) * $plot_h;
9797 my $file_y = $pad_t + $plot_h - $file_h;
9898 my $schema_y = $file_y - $schema_h;
9999 my $key = _esc($keys[$i]);
100100 my $label = _esc($days->[$i]);
101101
102102 # Full-height invisible hit target for tooltip hover on empty days.
103103 # Sits behind the visible bars.
104104 $svg .= sprintf(
105105 qq~<g class="ds-day" data-key="%s" data-label="%s" data-file="%d" data-schema="%d" data-link-file="%s?on=%s" data-link-schema="%s?on=%s">~,
106106 $key, $label, $fv, $sv,
107107 _esc($link_file), $key, _esc($link_schema), $key,
108108 );
109109 $svg .= sprintf(
110110 qq~<rect class="ds-hit" x="%.2f" y="%.2f" width="%.2f" height="%.2f" fill="transparent"/>~,
111111 $x, $pad_t, $bar_w, $plot_h,
112112 );
113113 if ($fv > 0) {
114114 $svg .= sprintf(
115115 qq~<a xlink:href="%s?on=%s"><rect class="ds-bar ds-bar-file" x="%.2f" y="%.2f" width="%.2f" height="%.2f" fill="#14b8a6" opacity="0.85"/></a>~,
116116 _esc($link_file), $key, $x, $file_y, $bar_w, $file_h,
117117 );
118118 }
119119 if ($sv > 0) {
120120 $svg .= sprintf(
121121 qq~<a xlink:href="%s?on=%s"><rect class="ds-bar ds-bar-schema" x="%.2f" y="%.2f" width="%.2f" height="%.2f" fill="#f59e0b" opacity="0.85"/></a>~,
122122 _esc($link_schema), $key, $x, $schema_y, $bar_w, $schema_h,
123123 );
124124 }
125125 $svg .= qq~</g>~;
126126 }
127127
128128 # X-axis: label first, middle, last day
129129 my @tick_idx = (0, int($n/2), $n - 1);
130130 for my $i (@tick_idx) {
131131 my $x = $pad_l + $i * ($bar_w + $bar_gap) + ($bar_w / 2);
132132 my $y = $h - 6;
133133 my $lbl = _esc($days->[$i]);
134134 $svg .= qq~<text x="$x" y="$y" text-anchor="middle" font-family="var(--mono, monospace)" font-size="10" fill="#96a3b8">$lbl</text>~;
135135 }
136136
137 # Legend
138 my $legend_y = $pad_t + 8;
139 my $legend_x = $w - $pad_r - 160;
137 # Legend -- drawn LAST with a solid background rect so bars from
138 # busy days behind it can't visually intrude.
139 my $legend_y = $pad_t + 4;
140 my $legend_w = 172;
141 my $legend_h = 20;
142 my $legend_x = $w - $pad_r - $legend_w;
143 # Backdrop matches the module body bg + a subtle border for polish
144 $svg .= sprintf(
145 qq~<rect x="%.2f" y="%.2f" width="%d" height="%d" fill="#131e30" stroke="#223050" stroke-width="1" rx="6"/>~,
146 $legend_x, $legend_y, $legend_w, $legend_h,
147 );
148 my $lx = $legend_x + 10;
149 my $ly = $legend_y + 5;
140150 $svg .= qq~<g font-family="var(--sans, sans-serif)" font-size="10.5">~;
141 $svg .= qq~<rect x="$legend_x" y="$legend_y" width="10" height="10" fill="#14b8a6"/>~;
142 $svg .= qq~<text x="~ . ($legend_x + 14) . qq~" y="~ . ($legend_y + 9) . qq~" fill="#96a3b8">file changes</text>~;
143 my $legend_x2 = $legend_x + 90;
144 $svg .= qq~<rect x="$legend_x2" y="$legend_y" width="10" height="10" fill="#f59e0b"/>~;
145 $svg .= qq~<text x="~ . ($legend_x2 + 14) . qq~" y="~ . ($legend_y + 9) . qq~" fill="#96a3b8">schema</text>~;
151 $svg .= qq~<rect x="$lx" y="$ly" width="10" height="10" fill="#14b8a6" rx="1"/>~;
152 $svg .= qq~<text x="~ . ($lx + 14) . qq~" y="~ . ($ly + 9) . qq~" fill="#96a3b8">file changes</text>~;
153 my $lx2 = $lx + 88;
154 $svg .= qq~<rect x="$lx2" y="$ly" width="10" height="10" fill="#f59e0b" rx="1"/>~;
155 $svg .= qq~<text x="~ . ($lx2 + 14) . qq~" y="~ . ($ly + 9) . qq~" fill="#96a3b8">schema</text>~;
146156 $svg .= qq~</g>~;
147157
148158 $svg .= qq~</svg>~;
149159 return $svg;
150160}
151161
152162#---------------------------------------------------------------------
153163# sparkline({ values => \@nums, w, h, color })
154164#
155165# Tiny standalone SVG for inline use. Shows a 30-point (or however
156166# many values passed) mini line/bar chart. Great next to a file name
157167# or table name to convey "recent activity rhythm at a glance".
158168#---------------------------------------------------------------------
159169sub sparkline {
160170 my %a = @_;
161171 my $v = $a{values} || [];
162172 my $w = $a{width} || 80;
163173 my $h = $a{height} || 20;
164174 my $color = $a{color} || '#14b8a6';
165175
166176 my $n = scalar @$v;
167177 return '' unless $n;
168178
169179 my $max = 0;
170180 $max = $_ > $max ? $_ : $max for @$v;
171181 $max ||= 1;
172182
173183 my $gap = 1;
174184 my $bar_w = ($w - ($n - 1) * $gap) / $n;
175185 $bar_w = 1 if $bar_w < 1;
176186
177187 my $svg = qq~<svg viewBox="0 0 $w $h" xmlns="http://www.w3.org/2000/svg" style="display:inline-block;vertical-align:middle;width:${w}px;height:${h}px">~;
178188 for my $i (0..$n-1) {
179189 my $val = $v->[$i] || 0;
180190 next if $val == 0;
181191 my $bh = ($val / $max) * $h;
182192 my $x = $i * ($bar_w + $gap);
183193 my $y = $h - $bh;
184194 $svg .= sprintf(qq~<rect x="%.2f" y="%.2f" width="%.2f" height="%.2f" fill="%s" opacity="0.85"/>~,
185195 $x, $y, $bar_w, $bh, $color);
186196 }
187197 $svg .= qq~</svg>~;
188198 return $svg;
189199}
190200
191201#---------------------------------------------------------------------
192202# simple_donut({ size, values => [{v, color, label}], center_num, center_lbl })
193203#---------------------------------------------------------------------
194204sub simple_donut {
195205 my %a = @_;
196206 my $size = $a{size} || 140;
197207 my $thickness = $a{thickness} || 16;
198208 my $values = $a{values} || [];
199209 my $center_num = $a{center_num} // '';
200210 my $center_lbl = $a{center_lbl} // '';
201211
202212 my $cx = $size / 2; my $cy = $size / 2;
203213 my $r = ($size / 2) - ($thickness / 2) - 4;
204214 my $total = 0; $total += ($_->{v} || 0) for @$values;
205215 $total = 1 unless $total > 0;
206216
207217 my $svg = qq~<svg viewBox="0 0 $size $size" style="width:${size}px;height:${size}px">~;
208218 # Background ring
209219 $svg .= qq~<circle cx="$cx" cy="$cy" r="$r" stroke="#131e30" stroke-width="$thickness" fill="none"/>~;
210220
211221 my $start_deg = -90;
212222 foreach my $v (@$values) {
213223 my $angle = ($v->{v} / $total) * 360;
214224 next if $angle < 0.5;
215225 my $end_deg = $start_deg + $angle;
216226 my $large = ($angle > 180) ? 1 : 0;
217227 my ($x1, $y1) = _polar($cx, $cy, $r, $start_deg);
218228 my ($x2, $y2) = _polar($cx, $cy, $r, $end_deg);
219229 my $c = $v->{color} || '#14b8a6';
220230 $svg .= qq~<path d="M $x1 $y1 A $r $r 0 $large 1 $x2 $y2" stroke="$c" stroke-width="$thickness" fill="none" stroke-linecap="butt" opacity="0.95"/>~;
221231 $start_deg = $end_deg;
222232 }
223233
224234 my $cnum = _esc($center_num); my $clbl = _esc($center_lbl);
225235 $svg .= qq~<text x="$cx" y="$cy" text-anchor="middle" dy="4" font-family="var(--sans, sans-serif)" font-weight="800" font-size="20" fill="#e5edf5">$cnum</text>~;
226236 $svg .= qq~<text x="$cx" y="$cy" text-anchor="middle" dy="24" font-family="var(--sans, sans-serif)" font-size="10" letter-spacing="1.4" fill="#96a3b8">$clbl</text>~;
227237 $svg .= qq~</svg>~;
228238 return $svg;
229239}
230240
231241sub _polar {
232242 my ($cx, $cy, $r, $deg) = @_;
233243 my $rad = $deg * 3.14159265 / 180;
234244 return ($cx + $r * cos($rad), $cy + $r * sin($rad));
235245}
236246
2372471;