added on local at 2026-07-13 16:25:53
| 1 | #!/usr/bin/perl | |
| 2 | use strict; | |
| 3 | use warnings; | |
| 4 | use CGI (); | |
| 5 | use MODS::Config; | |
| 6 | use MODS::DBConnect; | |
| 7 | use MODS::Template; | |
| 8 | use MODS::PageWrapper; | |
| 9 | use MODS::Charts; | |
| 10 | use MODS::RangePicker; | |
| 11 | use POSIX (); | |
| 12 | ||
| 13 | my $cgi = CGI->new; | |
| 14 | my $db = MODS::DBConnect->new; | |
| 15 | my $tpl = MODS::Template->new; | |
| 16 | ||
| 17 | $|=1; print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n"; | |
| 18 | ||
| 19 | my $dbh = $db->db_connect or die "DB connect failed\n"; | |
| 20 | ||
| 21 | my $r = MODS::RangePicker::parse($cgi); | |
| 22 | my $q = $cgi->param('q') || ''; | |
| 23 | my $server_filter = int($cgi->param('server') || 0); | |
| 24 | my $mid_filter = int($cgi->param('mid') || 0); | |
| 25 | my $show_baseline = $cgi->param('baseline') ? 1 : 0; # opt-in to see baseline | |
| 26 | ||
| 27 | my $where = $r->{sql_where}->('fc.date_time'); | |
| 28 | $where .= " AND fc.file_name LIKE " . $dbh->quote('%' . $q . '%') if length $q; | |
| 29 | $where .= " AND fc.server_id = $server_filter" if $server_filter; | |
| 30 | $where .= " AND fc.file_monitor_list_id = $mid_filter" if $mid_filter; | |
| 31 | $where .= " AND fc.is_baseline = 0" unless $show_baseline; | |
| 32 | ||
| 33 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 34 | SELECT fc.file_changes_id AS id, fc.file_name, fc.status, | |
| 35 | UNIX_TIMESTAMP(fc.date_time) AS ts_epoch, | |
| 36 | fc.date_time, | |
| 37 | fc.blob_sha, fc.diff_blob_sha, fc.is_ts_only, fc.uid, fc.gid, fc.permissions, | |
| 38 | s.server_name, | |
| 39 | m.scan_name AS site_name, | |
| 40 | fc.file_monitor_list_id AS site_mid | |
| 41 | FROM FILE_CHANGES fc | |
| 42 | LEFT JOIN SERVERS s ON s.server_id = fc.server_id | |
| 43 | LEFT JOIN FILE_MONITOR_SETTINGS m ON m.file_monitor_list_id = fc.file_monitor_list_id | |
| 44 | WHERE $where | |
| 45 | ORDER BY fc.date_time DESC | |
| 46 | LIMIT 200 | |
| 47 | ~, __FILE__, __LINE__); | |
| 48 | ||
| 49 | # --- Per-file 30-day sparkline data. One query, then bucket in Perl. --- | |
| 50 | my %spark; | |
| 51 | { | |
| 52 | my @dedupe_files; | |
| 53 | my %seen; | |
| 54 | foreach my $r_row (@rows) { | |
| 55 | next unless defined $r_row->{file_name}; | |
| 56 | next if $seen{$r_row->{file_name}}++; | |
| 57 | push @dedupe_files, $r_row->{file_name}; | |
| 58 | } | |
| 59 | if (@dedupe_files) { | |
| 60 | my @quoted = map { $dbh->quote($_) } @dedupe_files; | |
| 61 | my $in_list = join(',', @quoted); | |
| 62 | my @day_rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 63 | SELECT file_name, | |
| 64 | DATE_FORMAT(date_time, '%Y-%m-%d') AS d, | |
| 65 | COUNT(*) AS n | |
| 66 | FROM FILE_CHANGES | |
| 67 | WHERE file_name IN ($in_list) | |
| 68 | AND date_time >= DATE_SUB(NOW(), INTERVAL 30 DAY) | |
| 69 | GROUP BY file_name, d | |
| 70 | ~, __FILE__, __LINE__); | |
| 71 | my %by_file; | |
| 72 | foreach my $dr (@day_rows) { | |
| 73 | $by_file{$dr->{file_name}}{$dr->{d}} = $dr->{n}; | |
| 74 | } | |
| 75 | my $now = time; | |
| 76 | my @day_keys; | |
| 77 | for (my $i = 29; $i >= 0; $i--) { | |
| 78 | push @day_keys, POSIX::strftime('%Y-%m-%d', localtime($now - $i * 86400)); | |
| 79 | } | |
| 80 | foreach my $fname (@dedupe_files) { | |
| 81 | my @series; | |
| 82 | for my $k (@day_keys) { | |
| 83 | push @series, ($by_file{$fname}{$k} || 0); | |
| 84 | } | |
| 85 | $spark{$fname} = \@series; | |
| 86 | } | |
| 87 | } | |
| 88 | } | |
| 89 | ||
| 90 | foreach my $row (@rows) { | |
| 91 | $row->{status_pill} = $row->{status} && $row->{status} eq 'added' ? 'pill-ok' | |
| 92 | : $row->{status} && $row->{status} eq 'modified' ? 'pill-warn' | |
| 93 | : $row->{status} && $row->{status} eq 'deleted' ? 'pill-bad' | |
| 94 | : 'pill-mute'; | |
| 95 | $row->{status} //= 'unknown'; | |
| 96 | ||
| 97 | # Site badge: 2-letter initials + palette hue derived from scan_name. | |
| 98 | # Turns "/var/www/vhosts/3dshawn.com/site1/..." from opaque path into | |
| 99 | # a visible site identity in the row (DS / PT / AS / SC / RP / AB / | |
| 100 | # CF / WS / MA / etc). | |
| 101 | ($row->{site_badge}, $row->{site_badge_bg}, $row->{site_badge_fg}) = _site_badge($row->{site_name} // ''); | |
| 102 | $row->{site_label} = $row->{site_name} // '?'; | |
| 103 | $row->{site_link} = "/file_changes.cgi?mid=$row->{site_mid}"; | |
| 104 | ||
| 105 | # Strip the vhost prefix from the display path so files read as | |
| 106 | # site-relative rather than "/var/www/vhosts/foo.com/httpdocs/bar.pl". | |
| 107 | my $disp = $row->{file_name} // ''; | |
| 108 | $disp =~ s{^/var/www/vhosts/[^/]+/(?:site\d+|httpdocs)/?}{}; | |
| 109 | $disp = '/' . $disp if length $disp && substr($disp, 0, 1) ne '/'; | |
| 110 | $row->{file_name_h} = $disp; | |
| 111 | $row->{file_name_h} = length($row->{file_name_h}) > 90 | |
| 112 | ? '...' . substr($row->{file_name_h}, -87) | |
| 113 | : $row->{file_name_h}; | |
| 114 | $row->{blob_short} = $row->{blob_sha} ? substr($row->{blob_sha}, 0, 8) : '-'; | |
| 115 | $row->{diff_url} = "/diff.cgi?kind=file&id=$row->{id}"; | |
| 116 | $row->{restore_url} = "/restore.cgi?id=$row->{id}"; | |
| 117 | my $enc_path = $row->{file_name} // ''; | |
| 118 | $enc_path =~ s/([^A-Za-z0-9\-\._~])/sprintf('%%%02X', ord($1))/eg; | |
| 119 | $row->{bio_url} = "/file_bio.cgi?path=$enc_path"; | |
| 120 | $row->{can_restore} = ($row->{blob_sha} && $row->{status} ne 'deleted') ? 1 : 0; | |
| 121 | $row->{ts_epoch} //= 0; | |
| 122 | my $series = $spark{$row->{file_name} // ''}; | |
| 123 | $row->{sparkline_svg} = $series | |
| 124 | ? MODS::Charts::sparkline(values => $series, width => 88, height => 20, color => '#14b8a6') | |
| 125 | : ''; | |
| 126 | } | |
| 127 | my $total = scalar @rows; | |
| 128 | ||
| 129 | # Count baseline captures that are hidden in the current window so we can | |
| 130 | # tell the operator "N baseline captures hidden -- show them". | |
| 131 | my $baseline_where = $r->{sql_where}->('fc.date_time'); | |
| 132 | $baseline_where .= " AND fc.file_name LIKE " . $dbh->quote('%' . $q . '%') if length $q; | |
| 133 | $baseline_where .= " AND fc.server_id = $server_filter" if $server_filter; | |
| 134 | $baseline_where .= " AND fc.file_monitor_list_id = $mid_filter" if $mid_filter; | |
| 135 | $baseline_where .= " AND fc.is_baseline = 1"; | |
| 136 | my $bcnt_row = $show_baseline ? undef : $db->db_readwrite($dbh, qq~ | |
| 137 | SELECT COUNT(*) AS n FROM FILE_CHANGES fc WHERE $baseline_where | |
| 138 | ~, __FILE__, __LINE__); | |
| 139 | my $baseline_hidden = ($bcnt_row && $bcnt_row->{n}) || 0; | |
| 140 | ||
| 141 | $db->db_disconnect($dbh); | |
| 142 | ||
| 143 | my $picker_html = MODS::RangePicker::picker_html( | |
| 144 | action => '/file_changes.cgi', | |
| 145 | range => $r, | |
| 146 | hidden => { q => $q, ($server_filter ? (server => $server_filter) : ()) }, | |
| 147 | ); | |
| 148 | ||
| 149 | my $tvars = { | |
| 150 | rows => \@rows, | |
| 151 | has_rows => $total ? 1 : 0, | |
| 152 | total => $total, | |
| 153 | q => $q, | |
| 154 | picker_html => $picker_html, | |
| 155 | range_label => $r->{range_label}, | |
| 156 | is_day_view => $r->{is_day} ? 1 : 0, | |
| 157 | day_label => $r->{on}, | |
| 158 | show_baseline => $show_baseline, | |
| 159 | baseline_hidden => $baseline_hidden, | |
| 160 | has_baseline_hidden => $baseline_hidden ? 1 : 0, | |
| 161 | }; | |
| 162 | my @body = $tpl->template('file_changes.html', $tvars); | |
| 163 | ||
| 164 | MODS::PageWrapper->new->wrapper( | |
| 165 | page_title => 'File changes', page_key => 'file_changes', | |
| 166 | body_html => join('', @body), | |
| 167 | userinfo => { display_name => 'Operator' }, | |
| 168 | ); | |
| 169 | ||
| 170 | #--------------------------------------------------------------------- | |
| 171 | # _site_badge($scan_name) -> (initials, bg_color, fg_color) | |
| 172 | # Deterministic 2-letter + palette hue from scan name so each site | |
| 173 | # gets a stable colored chip. | |
| 174 | #--------------------------------------------------------------------- | |
| 175 | sub _site_badge { | |
| 176 | my ($name) = @_; | |
| 177 | $name //= ''; | |
| 178 | my $slug = lc($name); | |
| 179 | $slug =~ s/\(.*$//; | |
| 180 | $slug =~ s/[^a-z]//g; | |
| 181 | ||
| 182 | my %map = ( | |
| 183 | driftsense => { i => 'DS', bg => '#0f766e', fg => '#a7f3d0' }, | |
| 184 | webstls => { i => 'WS', bg => '#1e40af', fg => '#93c5fd' }, | |
| 185 | ptmatrix => { i => 'PT', bg => '#7c2d12', fg => '#fca5a5' }, | |
| 186 | affsoft => { i => 'AS', bg => '#374151', fg => '#d1d5db' }, | |
| 187 | shopcart => { i => 'SC', bg => '#155e75', fg => '#67e8f9' }, | |
| 188 | repricer => { i => 'RP', bg => '#3f6212', fg => '#bef264' }, | |
| 189 | abforge => { i => 'AB', bg => '#6b21a8', fg => '#d8b4fe' }, | |
| 190 | contactforge => { i => 'CF', bg => '#9d174d', fg => '#f9a8d4' }, | |
| 191 | metaadmin => { i => 'MA', bg => '#7f1d1d', fg => '#fca5a5' }, | |
| 192 | ); | |
| 193 | # Match on the leading token of the scan name | |
| 194 | foreach my $key (keys %map) { | |
| 195 | if (index($slug, $key) == 0) { | |
| 196 | return ($map{$key}{i}, $map{$key}{bg}, $map{$key}{fg}); | |
| 197 | } | |
| 198 | } | |
| 199 | # Fallback: 2 initials from words in the name, teal palette | |
| 200 | my @tok = grep { length } split /[\s_\-\.\/]+/, ($name =~ s/\(.*$//r); | |
| 201 | my $i = @tok >= 2 ? uc(substr($tok[0], 0, 1) . substr($tok[1], 0, 1)) | |
| 202 | : @tok ? uc(substr($tok[0], 0, 2)) | |
| 203 | : '??'; | |
| 204 | return ($i, '#1e3a5f', '#93c5fd'); | |
| 205 | } |