added on local at 2026-07-13 14:36:25
| 1 | package MODS::Charts; | |
| 2 | #====================================================================== | |
| 3 | # DriftSense -- hand-rolled SVG chart helpers (zero external deps). | |
| 4 | # | |
| 5 | # All charts are inline SVG strings that use CSS variables from | |
| 6 | # drift_sense.css so palette + theme changes propagate automatically. | |
| 7 | # | |
| 8 | # Public functions (call as MODS::Charts::stacked_bars(...), etc.): | |
| 9 | # | |
| 10 | # stacked_bars(days => \@days, series => { file => \@nums, schema => \@nums }) | |
| 11 | # Wide activity timeline. One bar per day, stacked by series. | |
| 12 | # | |
| 13 | # sparkline(values => \@nums, w => 80, h => 20) | |
| 14 | # Tiny inline SVG summary line. Great next to file / table names. | |
| 15 | # | |
| 16 | # simple_donut(size, values => [{v, color, label}], center) | |
| 17 | # Compact donut for savings / drift / dedup ratios. | |
| 18 | #====================================================================== | |
| 19 | use strict; | |
| 20 | use warnings; | |
| 21 | ||
| 22 | sub _esc { | |
| 23 | my $s = shift; $s //= ''; | |
| 24 | $s =~ s/&/&/g; $s =~ s/</</g; $s =~ s/>/>/g; | |
| 25 | return $s; | |
| 26 | } | |
| 27 | ||
| 28 | #--------------------------------------------------------------------- | |
| 29 | # stacked_bars({ days => [...], series => { file => [...], schema => [...] } }) | |
| 30 | # | |
| 31 | # @days = arrayref of day labels (oldest -> newest). @series entries | |
| 32 | # must be same-length arrayrefs of integers. Bars stack file (teal) | |
| 33 | # below schema (amber). Y-axis auto-scales. | |
| 34 | #--------------------------------------------------------------------- | |
| 35 | sub stacked_bars { | |
| 36 | my %a = @_; | |
| 37 | my $days = $a{days} || []; # display labels e.g. "Jul 10" | |
| 38 | my $day_keys = $a{day_keys} || []; # ISO YYYY-MM-DD for links/tooltips | |
| 39 | my $series = $a{series} || {}; | |
| 40 | my $w = $a{width} || 900; | |
| 41 | my $h = $a{height} || 160; | |
| 42 | my $link_file = $a{link_file} || '/file_changes.cgi'; | |
| 43 | my $link_schema = $a{link_schema} || '/schema_changes.cgi'; | |
| 44 | ||
| 45 | my $n = scalar @$days; | |
| 46 | return '' unless $n; | |
| 47 | # Fall back to display labels for keys if caller didn't pass ISO dates. | |
| 48 | my @keys = @$day_keys ? @$day_keys : @$days; | |
| 49 | ||
| 50 | my @file_v = @{ $series->{file} || [] }; | |
| 51 | my @schema_v = @{ $series->{schema} || [] }; | |
| 52 | ||
| 53 | my $max = 1; | |
| 54 | for my $i (0..$n-1) { | |
| 55 | my $t = ($file_v[$i] || 0) + ($schema_v[$i] || 0); | |
| 56 | $max = $t if $t > $max; | |
| 57 | } | |
| 58 | ||
| 59 | my $pad_l = 40; | |
| 60 | my $pad_b = 22; | |
| 61 | my $pad_t = 44; # reserved band at top for the legend + ~18px breathing gap | |
| 62 | my $pad_r = 8; | |
| 63 | ||
| 64 | my $plot_w = $w - $pad_l - $pad_r; | |
| 65 | my $plot_h = $h - $pad_t - $pad_b; | |
| 66 | ||
| 67 | my $bar_gap = 1; | |
| 68 | my $bar_w = ($plot_w - ($n - 1) * $bar_gap) / $n; | |
| 69 | $bar_w = 1 if $bar_w < 1; | |
| 70 | ||
| 71 | 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">~; | |
| 72 | $svg .= q~<style> | |
| 73 | .ds-timeline .ds-day { cursor: pointer; } | |
| 74 | .ds-timeline .ds-day:hover .ds-hit { fill: rgba(20,184,166,0.06); } | |
| 75 | .ds-timeline .ds-day:hover .ds-bar { opacity: 1; } | |
| 76 | .ds-timeline .ds-bar { transition: opacity .15s ease; } | |
| 77 | .ds-timeline a { text-decoration: none; } | |
| 78 | </style>~; | |
| 79 | ||
| 80 | # Grid lines + Y-axis labels | |
| 81 | for my $frac (0, 0.25, 0.5, 0.75, 1) { | |
| 82 | my $y = $pad_t + $plot_h * (1 - $frac); | |
| 83 | my $lbl = int($max * $frac); | |
| 84 | $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"/>~; | |
| 85 | $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>~; | |
| 86 | } | |
| 87 | ||
| 88 | # Bars -- wrap each day in a group with data-* attributes so a JS | |
| 89 | # tooltip can pick up the counts on hover. Each segment is its own | |
| 90 | # <a> so click routes to file_changes or schema_changes. | |
| 91 | for my $i (0..$n-1) { | |
| 92 | my $fv = $file_v[$i] || 0; | |
| 93 | my $sv = $schema_v[$i] || 0; | |
| 94 | my $x = $pad_l + $i * ($bar_w + $bar_gap); | |
| 95 | my $file_h = ($fv / $max) * $plot_h; | |
| 96 | my $schema_h = ($sv / $max) * $plot_h; | |
| 97 | my $file_y = $pad_t + $plot_h - $file_h; | |
| 98 | my $schema_y = $file_y - $schema_h; | |
| 99 | my $key = _esc($keys[$i]); | |
| 100 | my $label = _esc($days->[$i]); | |
| 101 | ||
| 102 | # Full-height invisible hit target for tooltip hover on empty days. | |
| 103 | # Sits behind the visible bars. | |
| 104 | $svg .= sprintf( | |
| 105 | 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">~, | |
| 106 | $key, $label, $fv, $sv, | |
| 107 | _esc($link_file), $key, _esc($link_schema), $key, | |
| 108 | ); | |
| 109 | $svg .= sprintf( | |
| 110 | qq~<rect class="ds-hit" x="%.2f" y="%.2f" width="%.2f" height="%.2f" fill="transparent"/>~, | |
| 111 | $x, $pad_t, $bar_w, $plot_h, | |
| 112 | ); | |
| 113 | if ($fv > 0) { | |
| 114 | $svg .= sprintf( | |
| 115 | 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>~, | |
| 116 | _esc($link_file), $key, $x, $file_y, $bar_w, $file_h, | |
| 117 | ); | |
| 118 | } | |
| 119 | if ($sv > 0) { | |
| 120 | $svg .= sprintf( | |
| 121 | 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>~, | |
| 122 | _esc($link_schema), $key, $x, $schema_y, $bar_w, $schema_h, | |
| 123 | ); | |
| 124 | } | |
| 125 | $svg .= qq~</g>~; | |
| 126 | } | |
| 127 | ||
| 128 | # X-axis: label first, middle, last day | |
| 129 | my @tick_idx = (0, int($n/2), $n - 1); | |
| 130 | for my $i (@tick_idx) { | |
| 131 | my $x = $pad_l + $i * ($bar_w + $bar_gap) + ($bar_w / 2); | |
| 132 | my $y = $h - 6; | |
| 133 | my $lbl = _esc($days->[$i]); | |
| 134 | $svg .= qq~<text x="$x" y="$y" text-anchor="middle" font-family="var(--mono, monospace)" font-size="10" fill="#96a3b8">$lbl</text>~; | |
| 135 | } | |
| 136 | ||
| 137 | # Legend -- sits in the dedicated top band ($pad_t = 34 reserved for it). | |
| 138 | # Bars start at y=$pad_t, so the legend never overlaps a bar regardless | |
| 139 | # of how tall the day gets. | |
| 140 | my $legend_y = 6; | |
| 141 | my $legend_w = 172; | |
| 142 | my $legend_h = 20; | |
| 143 | my $legend_x = $w - $pad_r - $legend_w; | |
| 144 | # Backdrop matches the module body bg + a subtle border for polish | |
| 145 | $svg .= sprintf( | |
| 146 | qq~<rect x="%.2f" y="%.2f" width="%d" height="%d" fill="#131e30" stroke="#223050" stroke-width="1" rx="6"/>~, | |
| 147 | $legend_x, $legend_y, $legend_w, $legend_h, | |
| 148 | ); | |
| 149 | my $lx = $legend_x + 10; | |
| 150 | my $ly = $legend_y + 5; | |
| 151 | $svg .= qq~<g font-family="var(--sans, sans-serif)" font-size="10.5">~; | |
| 152 | $svg .= qq~<rect x="$lx" y="$ly" width="10" height="10" fill="#14b8a6" rx="1"/>~; | |
| 153 | $svg .= qq~<text x="~ . ($lx + 14) . qq~" y="~ . ($ly + 9) . qq~" fill="#96a3b8">file changes</text>~; | |
| 154 | my $lx2 = $lx + 88; | |
| 155 | $svg .= qq~<rect x="$lx2" y="$ly" width="10" height="10" fill="#f59e0b" rx="1"/>~; | |
| 156 | $svg .= qq~<text x="~ . ($lx2 + 14) . qq~" y="~ . ($ly + 9) . qq~" fill="#96a3b8">schema</text>~; | |
| 157 | $svg .= qq~</g>~; | |
| 158 | ||
| 159 | $svg .= qq~</svg>~; | |
| 160 | return $svg; | |
| 161 | } | |
| 162 | ||
| 163 | #--------------------------------------------------------------------- | |
| 164 | # sparkline({ values => \@nums, w, h, color }) | |
| 165 | # | |
| 166 | # Tiny standalone SVG for inline use. Shows a 30-point (or however | |
| 167 | # many values passed) mini line/bar chart. Great next to a file name | |
| 168 | # or table name to convey "recent activity rhythm at a glance". | |
| 169 | #--------------------------------------------------------------------- | |
| 170 | sub sparkline { | |
| 171 | my %a = @_; | |
| 172 | my $v = $a{values} || []; | |
| 173 | my $w = $a{width} || 80; | |
| 174 | my $h = $a{height} || 20; | |
| 175 | my $color = $a{color} || '#14b8a6'; | |
| 176 | ||
| 177 | my $n = scalar @$v; | |
| 178 | return '' unless $n; | |
| 179 | ||
| 180 | my $max = 0; | |
| 181 | $max = $_ > $max ? $_ : $max for @$v; | |
| 182 | $max ||= 1; | |
| 183 | ||
| 184 | my $gap = 1; | |
| 185 | my $bar_w = ($w - ($n - 1) * $gap) / $n; | |
| 186 | $bar_w = 1 if $bar_w < 1; | |
| 187 | ||
| 188 | 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">~; | |
| 189 | for my $i (0..$n-1) { | |
| 190 | my $val = $v->[$i] || 0; | |
| 191 | next if $val == 0; | |
| 192 | my $bh = ($val / $max) * $h; | |
| 193 | my $x = $i * ($bar_w + $gap); | |
| 194 | my $y = $h - $bh; | |
| 195 | $svg .= sprintf(qq~<rect x="%.2f" y="%.2f" width="%.2f" height="%.2f" fill="%s" opacity="0.85"/>~, | |
| 196 | $x, $y, $bar_w, $bh, $color); | |
| 197 | } | |
| 198 | $svg .= qq~</svg>~; | |
| 199 | return $svg; | |
| 200 | } | |
| 201 | ||
| 202 | #--------------------------------------------------------------------- | |
| 203 | # simple_donut({ size, values => [{v, color, label}], center_num, center_lbl }) | |
| 204 | #--------------------------------------------------------------------- | |
| 205 | sub simple_donut { | |
| 206 | my %a = @_; | |
| 207 | my $size = $a{size} || 140; | |
| 208 | my $thickness = $a{thickness} || 16; | |
| 209 | my $values = $a{values} || []; | |
| 210 | my $center_num = $a{center_num} // ''; | |
| 211 | my $center_lbl = $a{center_lbl} // ''; | |
| 212 | ||
| 213 | my $cx = $size / 2; my $cy = $size / 2; | |
| 214 | my $r = ($size / 2) - ($thickness / 2) - 4; | |
| 215 | my $total = 0; $total += ($_->{v} || 0) for @$values; | |
| 216 | $total = 1 unless $total > 0; | |
| 217 | ||
| 218 | my $svg = qq~<svg viewBox="0 0 $size $size" style="width:${size}px;height:${size}px">~; | |
| 219 | # Background ring | |
| 220 | $svg .= qq~<circle cx="$cx" cy="$cy" r="$r" stroke="#131e30" stroke-width="$thickness" fill="none"/>~; | |
| 221 | ||
| 222 | my $start_deg = -90; | |
| 223 | foreach my $v (@$values) { | |
| 224 | my $angle = ($v->{v} / $total) * 360; | |
| 225 | next if $angle < 0.5; | |
| 226 | my $end_deg = $start_deg + $angle; | |
| 227 | my $large = ($angle > 180) ? 1 : 0; | |
| 228 | my ($x1, $y1) = _polar($cx, $cy, $r, $start_deg); | |
| 229 | my ($x2, $y2) = _polar($cx, $cy, $r, $end_deg); | |
| 230 | my $c = $v->{color} || '#14b8a6'; | |
| 231 | $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"/>~; | |
| 232 | $start_deg = $end_deg; | |
| 233 | } | |
| 234 | ||
| 235 | my $cnum = _esc($center_num); my $clbl = _esc($center_lbl); | |
| 236 | $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>~; | |
| 237 | $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>~; | |
| 238 | $svg .= qq~</svg>~; | |
| 239 | return $svg; | |
| 240 | } | |
| 241 | ||
| 242 | sub _polar { | |
| 243 | my ($cx, $cy, $r, $deg) = @_; | |
| 244 | my $rad = $deg * 3.14159265 / 180; | |
| 245 | return ($cx + $r * cos($rad), $cy + $r * sin($rad)); | |
| 246 | } | |
| 247 | ||
| 248 | 1; |