added on local at 2026-07-01 12:34:01
| 1 | #!/usr/bin/perl | |
| 2 | ||
| 3 | ################################################################################################################################## | |
| 4 | # ______ ____ ____ ______ ______ ____ ___ __ ___ ______ _ __ ____ ____ __ __ _ __ _____ ____ | |
| 5 | # / ____// __ \ / __ \ / ____/ / ____// __ \ / | / |/ // ____/| | / // __ \ / __ \ / //_/ | | / /|__ / / __ \ | |
| 6 | # / / / / / // / / // __/ / /_ / /_/ // /| | / /|_/ // __/ | | /| / // / / // /_/ // ,< | | / / /_ < / / / / | |
| 7 | # / /___ / /_/ // /_/ // /___ / __/ / _, _// ___ | / / / // /___ | |/ |/ // /_/ // _, _// /| | | |/ / ___/ /_ / /_/ / | |
| 8 | # \____/ \____//_____//_____/ /_/ /_/ |_|/_/ |_|/_/ /_//_____/ |__/|__/ \____//_/ |_|/_/ |_| |___/ /____/(_)\____/ | |
| 9 | # | |
| 10 | # - Written by: Shawn Pickering | |
| 11 | # - shawn@shawnpickering.com | |
| 12 | ################################################################################################################################## | |
| 13 | use strict; | |
| 14 | use lib '/var/www/vhosts/3dshawn.com/ptmatrix.3dshawn.com'; | |
| 15 | ||
| 16 | ||
| 17 | ############################################################# | |
| 18 | ## Variables | |
| 19 | ############################################################# | |
| 20 | ||
| 21 | ||
| 22 | ||
| 23 | ############################################################ | |
| 24 | # Modules | |
| 25 | ############################################################ | |
| 26 | use CGI; my $query = new CGI; my $form = $query->Vars; | |
| 27 | use MODS::Login; my $login = new MODS::Login; | |
| 28 | use MODS::PTMatrix::Urls; my $getlist = new MODS::PTMatrix::Urls; my $url = $getlist->urls(); | |
| 29 | use MODS::Template; my $tfile = new MODS::Template; | |
| 30 | use MODS::PTMatrix::Wrapper; my $load = new MODS::PTMatrix::Wrapper; | |
| 31 | use MODS::DBConnect; my $db = new MODS::DBConnect; | |
| 32 | use MODS::PTMatrix::Config; my $config = new MODS::PTMatrix::Config; my $database_name = $config->settings('database_name'); | |
| 33 | use MODS::PTMatrix::PM; | |
| 34 | use MODS::PTMatrix::AIAssist; my $ai = new MODS::PTMatrix::AIAssist; | |
| 35 | use MODS::PTMatrix::EmailInbox; my $ei = new MODS::PTMatrix::EmailInbox; | |
| 36 | use Digest::SHA qw(sha1_hex); | |
| 37 | ||
| 38 | ||
| 39 | ||
| 40 | ############################################################# | |
| 41 | ## Get form data | |
| 42 | ############################################################# | |
| 43 | my %rawform = %$form; | |
| 44 | ||
| 45 | foreach my $line(keys %$form){ | |
| 46 | $form->{$line} =~ s/[^!-~\s]//g; | |
| 47 | $form->{$line} = quotemeta("$form->{$line}"); | |
| 48 | } | |
| 49 | ||
| 50 | ||
| 51 | ||
| 52 | ############################################################ | |
| 53 | # Program Controls | |
| 54 | ############################################################ | |
| 55 | $|=1; | |
| 56 | my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'ai_settings'; | |
| 57 | ||
| 58 | my $userinfo = $login->login_verify(); | |
| 59 | if(!$userinfo){ | |
| 60 | if($entry eq 'ai_slip_analysis'){&jerr('not_auth');} | |
| 61 | print qq~Content-type:text/html; Cache-Control:no-cache;\n\n<script>window.location="$url->{login}";</script>~; | |
| 62 | exit; | |
| 63 | } | |
| 64 | ||
| 65 | if($entry eq 'ai_slip_analysis'){&slip_analysis; exit;} | |
| 66 | ||
| 67 | my $act = $form->{act} || ''; | |
| 68 | if($act eq 'summarize' || $act eq 'suggest_reply'){&ai_json_call;} | |
| 69 | else{ | |
| 70 | my $is_admin = ($userinfo->{role} && ($userinfo->{role} eq 'company_admin' || $userinfo->{role} eq 'company_owner')) || $userinfo->{is_super_admin}; | |
| 71 | if(!$is_admin){print qq~Status: 403 Forbidden\nContent-Type: text/plain\n\nAdmin only.\n~; exit;} | |
| 72 | ||
| 73 | if(($ENV{REQUEST_METHOD}||'') eq 'POST' && $act eq 'save'){&save_ai_settings;} | |
| 74 | else{&ai_panel;} | |
| 75 | } | |
| 76 | ||
| 77 | ||
| 78 | ############################################################ | |
| 79 | # Subroutines | |
| 80 | ############################################################ | |
| 81 | sub ai_json_call{ | |
| 82 | #JSON endpoints for the in-page Summarize + Suggest Reply buttons | |
| 83 | my $cid = MODS::PTMatrix::PM::get_company_id($userinfo); | |
| 84 | my $uid = MODS::PTMatrix::PM::get_user_id($userinfo); | |
| 85 | ||
| 86 | my $task_id = $form->{task_id}; | |
| 87 | $task_id =~ s/[^0-9]//g if defined $task_id; | |
| 88 | ||
| 89 | print qq~Content-Type: application/json\nCache-Control: no-store\n\n~; | |
| 90 | ||
| 91 | my $dbh = $db->db_connect(); | |
| 92 | if(!$ai->schema_ready($db, $dbh, $database_name)){ | |
| 93 | $db->db_disconnect($dbh); | |
| 94 | print '{"ok":false,"error":"AI not provisioned"}'; | |
| 95 | return; | |
| 96 | } | |
| 97 | if(!$task_id){ | |
| 98 | $db->db_disconnect($dbh); | |
| 99 | print '{"ok":false,"error":"task_id required"}'; | |
| 100 | return; | |
| 101 | } | |
| 102 | ||
| 103 | my $result = ($act eq 'summarize') | |
| 104 | ? $ai->summarize_thread($db, $dbh, $database_name, $cid, $task_id, $uid) | |
| 105 | : $ai->suggest_reply($db, $dbh, $database_name, $cid, $task_id, $uid, $rawform{hint}); | |
| 106 | $db->db_disconnect($dbh); | |
| 107 | ||
| 108 | if($result->{error}){ | |
| 109 | my $e = $result->{error}; | |
| 110 | $e =~ s/"/\\"/g; | |
| 111 | $e =~ s/\n/ /g; | |
| 112 | print qq~{"ok":false,"error":"$e"}~; | |
| 113 | }else{ | |
| 114 | my $t = $result->{text}; | |
| 115 | $t =~ s/\\/\\\\/g; | |
| 116 | $t =~ s/"/\\"/g; | |
| 117 | $t =~ s/\n/\\n/g; | |
| 118 | $t =~ s/\r/\\r/g; | |
| 119 | my $in = $result->{input_tokens} || 0; | |
| 120 | my $out = $result->{output_tokens} || 0; | |
| 121 | print qq~{"ok":true,"text":"$t","input_tokens":$in,"output_tokens":$out}~; | |
| 122 | } | |
| 123 | } | |
| 124 | ||
| 125 | sub save_ai_settings{ | |
| 126 | my $cid = MODS::PTMatrix::PM::get_company_id($userinfo); | |
| 127 | ||
| 128 | my $dbh = $db->db_connect(); | |
| 129 | if(!$ai->schema_ready($db, $dbh, $database_name)){ | |
| 130 | $db->db_disconnect($dbh); | |
| 131 | &ai_panel; | |
| 132 | return; | |
| 133 | } | |
| 134 | ||
| 135 | my $is_enabled = ($form->{is_enabled} && $form->{is_enabled} eq '1') ? 1 : 0; | |
| 136 | my $model = $form->{model} || 'claude-haiku-4-5-20251001'; | |
| 137 | $model =~ s/[^A-Za-z0-9\-_.]//g; | |
| 138 | my $key_plain = $rawform{anthropic_api_key_plain} || ''; | |
| 139 | my $monthly = $form->{monthly_token_limit}; | |
| 140 | $monthly =~ s/[^0-9]//g if defined $monthly; | |
| 141 | ||
| 142 | my $existing = $db->db_readwrite($dbh, qq~SELECT company_id FROM `${database_name}`.ai_company_settings WHERE company_id='$cid' LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 143 | ||
| 144 | my @sets = ( | |
| 145 | "is_enabled='$is_enabled'", | |
| 146 | "model='$model'", | |
| 147 | "monthly_token_limit=" . (length($monthly || '') ? "'$monthly'" : 'NULL'), | |
| 148 | ); | |
| 149 | if(length $key_plain){ | |
| 150 | my $enc = $ei->encrypt_password($db, $dbh, $database_name, $key_plain); | |
| 151 | $enc =~ s/'/''/g; | |
| 152 | push @sets, "anthropic_api_key_enc='$enc'"; | |
| 153 | } | |
| 154 | my $set = join(',', @sets); | |
| 155 | ||
| 156 | if($existing && $existing->{company_id}){ | |
| 157 | $db->db_readwrite($dbh, qq~UPDATE `${database_name}`.ai_company_settings SET $set WHERE company_id='$cid'~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 158 | }else{ | |
| 159 | $db->db_readwrite($dbh, qq~INSERT INTO `${database_name}`.ai_company_settings SET company_id='$cid', $set~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 160 | } | |
| 161 | ||
| 162 | $db->db_disconnect($dbh); | |
| 163 | &ai_panel('ok', 'AI settings saved.'); | |
| 164 | } | |
| 165 | ||
| 166 | sub ai_panel{ | |
| 167 | my($flash_kind, $flash_msg) = @_; | |
| 168 | $flash_kind ||= ''; | |
| 169 | $flash_msg ||= ''; | |
| 170 | ||
| 171 | my $cid = MODS::PTMatrix::PM::get_company_id($userinfo); | |
| 172 | ||
| 173 | my $dbh = $db->db_connect(); | |
| 174 | my $schema_ready = $ai->schema_ready($db, $dbh, $database_name); | |
| 175 | ||
| 176 | my $settings = $schema_ready ? $ai->get_settings($db, $dbh, $database_name, $cid) : undef; | |
| 177 | ||
| 178 | #------------------------------------------------------------------------------------------------------ | |
| 179 | #Last 20 generation events for the "recent" panel | |
| 180 | my @recent = $schema_ready ? $db->db_readwrite_multiple($dbh, qq~SELECT id, task_id, kind, succeeded, input_tokens, output_tokens, generated_at, user_id FROM `${database_name}`.ai_generations WHERE company_id='$cid' ORDER BY id DESC LIMIT 20~, $ENV{SCRIPT_NAME}, __LINE__) : (); | |
| 181 | #------------------------------------------------------------------------------------------------------ | |
| 182 | ||
| 183 | $db->db_disconnect($dbh); | |
| 184 | ||
| 185 | my @recent_rows; | |
| 186 | foreach my $r(@recent){ | |
| 187 | push @recent_rows, { | |
| 188 | id => $r->{id}, | |
| 189 | task_id => $r->{task_id} || '', | |
| 190 | kind => $r->{kind}, | |
| 191 | succeeded => $r->{succeeded} ? 1 : 0, | |
| 192 | in_tok => $r->{input_tokens} || 0, | |
| 193 | out_tok => $r->{output_tokens} || 0, | |
| 194 | generated_at => $r->{generated_at}, | |
| 195 | }; | |
| 196 | } | |
| 197 | ||
| 198 | my $current_model = ($settings && $settings->{model}) || 'claude-haiku-4-5-20251001'; | |
| 199 | ||
| 200 | print qq~Content-Type: text/html; charset=utf-8\nCache-Control: no-store\n\n~; | |
| 201 | ||
| 202 | #Create all template variables | |
| 203 | my $tvars; | |
| 204 | $tvars->{schema_ready} = $schema_ready ? 1 : 0; | |
| 205 | $tvars->{schema_missing} = $schema_ready ? 0 : 1; | |
| 206 | $tvars->{flash_kind} = $flash_kind; | |
| 207 | $tvars->{flash_msg} = $flash_msg; | |
| 208 | $tvars->{has_flash} = $flash_msg ne '' ? 1 : 0; | |
| 209 | $tvars->{is_enabled_attr} = ($settings && $settings->{is_enabled}) ? 'checked' : ''; | |
| 210 | $tvars->{is_enabled} = ($settings && $settings->{is_enabled}) ? 1 : 0; | |
| 211 | $tvars->{model_haiku} = ($current_model =~ /haiku/) ? 1 : 0; | |
| 212 | $tvars->{model_sonnet} = ($current_model =~ /sonnet/) ? 1 : 0; | |
| 213 | $tvars->{model_opus} = ($current_model =~ /opus/) ? 1 : 0; | |
| 214 | $tvars->{model} = $current_model; | |
| 215 | $tvars->{monthly_token_limit}= $settings->{monthly_token_limit} || ''; | |
| 216 | $tvars->{tokens_used} = $settings->{tokens_used_this_month} || 0; | |
| 217 | $tvars->{has_key} = ($settings && $settings->{anthropic_api_key_enc}) ? 1 : 0; | |
| 218 | $tvars->{recent} = \@recent_rows; | |
| 219 | $tvars->{has_recent} = scalar(@recent_rows) ? 1 : 0; | |
| 220 | ||
| 221 | my $body = join('', $tfile->template('tf_ai_settings.html', $tvars, $userinfo)); | |
| 222 | ||
| 223 | $load->render({ | |
| 224 | userinfo => $userinfo, | |
| 225 | page_key => 'ai_settings', | |
| 226 | title => 'AI Assist', | |
| 227 | body => $body, | |
| 228 | }); | |
| 229 | } | |
| 230 | ||
| 231 | #============================================================ | |
| 232 | # ai_slip_analysis entry: "Why did this slip?" JSON endpoint | |
| 233 | #============================================================ | |
| 234 | sub jout{ | |
| 235 | my($payload) = @_; | |
| 236 | print qq~Content-Type: application/json; charset=utf-8\nCache-Control: no-store\n\n~; | |
| 237 | require JSON::PP; | |
| 238 | print JSON::PP::encode_json($payload); | |
| 239 | exit; | |
| 240 | } | |
| 241 | ||
| 242 | sub jerr{ | |
| 243 | &jout({ ok => 0, error => $_[0] }); | |
| 244 | } | |
| 245 | ||
| 246 | sub slip_analysis{ | |
| 247 | my $cid = MODS::PTMatrix::PM::get_company_id($userinfo); | |
| 248 | my $tid = MODS::PTMatrix::PM::safe_int($form->{task}); | |
| 249 | &jerr('no task') unless $tid; | |
| 250 | ||
| 251 | my $dbh = $db->db_connect(); | |
| 252 | ||
| 253 | if(!$ai->is_enabled($db, $dbh, $database_name, $cid)){ | |
| 254 | $db->db_disconnect($dbh); | |
| 255 | &jerr('AI is not enabled. A company admin needs to add an Anthropic API key on the AI Settings page.'); | |
| 256 | } | |
| 257 | ||
| 258 | my $task = $db->db_readwrite($dbh, qq~SELECT t.*, p.name AS project_name, p.key_prefix FROM `${database_name}`.tasks t JOIN `${database_name}`.projects p ON p.id = t.project_id WHERE t.id='$tid' AND t.company_id='$cid' LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 259 | if(!$task || !$task->{id}){$db->db_disconnect($dbh); &jerr('task not found');} | |
| 260 | if(!MODS::PTMatrix::PM::can_view_project($userinfo, { id => $task->{project_id}, company_id => $task->{company_id} })){ | |
| 261 | $db->db_disconnect($dbh); | |
| 262 | &jerr('forbidden'); | |
| 263 | } | |
| 264 | ||
| 265 | my @comments = $db->db_readwrite_multiple($dbh, qq~SELECT c.body, c.created_at, u.display_name FROM `${database_name}`.task_comments c LEFT JOIN `${database_name}`.users u ON u.id = c.user_id WHERE c.task_id='$tid' ORDER BY c.created_at LIMIT 40~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 266 | my @audits = $db->db_readwrite_multiple($dbh, qq~SELECT a.action, a.occurred_at, a.details, u.display_name FROM `${database_name}`.audit_log a LEFT JOIN `${database_name}`.users u ON u.id = a.user_id WHERE a.target_type='task' AND a.target_id='$tid' ORDER BY a.occurred_at LIMIT 60~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 267 | ||
| 268 | my $input = join("\n", | |
| 269 | "T:$task->{title}", | |
| 270 | "S:$task->{status}", | |
| 271 | "P:$task->{priority}", | |
| 272 | "C:$task->{created_at}", | |
| 273 | "D:" . ($task->{due_date} // ''), | |
| 274 | "X:" . ($task->{completed_at} // ''), | |
| 275 | "EH:" . ($task->{estimated_hours} // ''), | |
| 276 | "AH:" . ($task->{actual_hours} // ''), | |
| 277 | "comments:" . scalar(@comments), | |
| 278 | "audits:" . scalar(@audits), | |
| 279 | (map { "c:$_->{created_at}:" . substr($_->{body} // '', 0, 200) } @comments), | |
| 280 | (map { "a:$_->{occurred_at}:$_->{action}" } @audits), | |
| 281 | ); | |
| 282 | my $sig = sha1_hex($input); | |
| 283 | ||
| 284 | if(!$form->{regenerate}){ | |
| 285 | my $cache = $db->db_readwrite($dbh, qq~SELECT body, input_signature, created_at FROM `${database_name}`.task_ai_analyses WHERE task_id='$tid' AND kind='slip_cause' LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 286 | if($cache && $cache->{body} && ($cache->{input_signature} || '') eq $sig){ | |
| 287 | $db->db_disconnect($dbh); | |
| 288 | &jout({ ok => 1, body => $cache->{body}, generated_at => $cache->{created_at}, from_cache => 1 }); | |
| 289 | } | |
| 290 | } | |
| 291 | ||
| 292 | my $system = <<'SYS'; | |
| 293 | You analyze project-management task histories and write short, blame-free explanations of why a task slipped or stalled. Be concrete: name the actual signals you see in the data (status changes, comment content, blocker mentions, time gaps, scope changes). Be honest if the data doesn't show a clear cause. Output: 2-4 sentences, plain text, no headers, no bullet points. Maximum 4 sentences. | |
| 294 | SYS | |
| 295 | ||
| 296 | my $user_msg = "TASK: $task->{title}\n"; | |
| 297 | $user_msg .= "Project: $task->{key_prefix} $task->{project_name}\n"; | |
| 298 | $user_msg .= "Status: $task->{status} | Priority: $task->{priority}\n"; | |
| 299 | $user_msg .= "Created: $task->{created_at}\n"; | |
| 300 | $user_msg .= "Due: " . ($task->{due_date} // 'none') . "\n"; | |
| 301 | $user_msg .= "Completed: " . ($task->{completed_at} // 'not yet') . "\n"; | |
| 302 | $user_msg .= "Estimated hours: " . ($task->{estimated_hours} // 'none') . " | Actual: " . ($task->{actual_hours} // '0') . "\n\n"; | |
| 303 | ||
| 304 | $user_msg .= "AUDIT EVENTS (chronological):\n"; | |
| 305 | if(@audits){ | |
| 306 | for my $a(@audits){ | |
| 307 | my $by = $a->{display_name} || 'system'; | |
| 308 | my $det = $a->{details} ? " [$a->{details}]" : ''; | |
| 309 | $user_msg .= "- $a->{occurred_at} $by: $a->{action}$det\n"; | |
| 310 | } | |
| 311 | }else{ | |
| 312 | $user_msg .= "(none recorded)\n"; | |
| 313 | } | |
| 314 | ||
| 315 | $user_msg .= "\nCOMMENTS (chronological):\n"; | |
| 316 | if(@comments){ | |
| 317 | for my $c(@comments){ | |
| 318 | my $by = $c->{display_name} || 'unknown'; | |
| 319 | my $body = $c->{body} // ''; | |
| 320 | $body =~ s/\s+/ /g; | |
| 321 | $body = substr($body, 0, 400); | |
| 322 | $user_msg .= "- $c->{created_at} $by: $body\n"; | |
| 323 | } | |
| 324 | }else{ | |
| 325 | $user_msg .= "(no comments)\n"; | |
| 326 | } | |
| 327 | $user_msg .= "\nQUESTION: Why did this task slip or stall, based only on the data above? If the data is too thin, say so plainly."; | |
| 328 | ||
| 329 | my $result = $ai->ask_for_company($db, $dbh, $database_name, $cid, | |
| 330 | system => $system, | |
| 331 | user => $user_msg, | |
| 332 | max_tokens => 600, | |
| 333 | ); | |
| 334 | if($result->{error}){ | |
| 335 | $db->db_disconnect($dbh); | |
| 336 | &jerr($result->{error}); | |
| 337 | } | |
| 338 | ||
| 339 | my $answer = $result->{text}; | |
| 340 | my $body_q = MODS::PTMatrix::PM::sql_quote($answer); | |
| 341 | my $sig_q = MODS::PTMatrix::PM::sql_quote($sig); | |
| 342 | ||
| 343 | my $sql = qq~INSERT INTO `${database_name}`.task_ai_analyses (company_id, task_id, kind, body, input_signature, created_at) VALUES ('$cid', '$tid', 'slip_cause', '$body_q', '$sig_q', NOW()) ON DUPLICATE KEY UPDATE body=VALUES(body), input_signature=VALUES(input_signature), created_at=NOW()~; | |
| 344 | $db->db_readwrite($dbh, $sql, $ENV{SCRIPT_NAME}, __LINE__); | |
| 345 | ||
| 346 | my $now = $db->db_readwrite($dbh, qq~SELECT NOW() AS t~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 347 | $db->db_disconnect($dbh); | |
| 348 | ||
| 349 | &jout({ ok => 1, body => $answer, generated_at => ($now ? $now->{t} : ''), from_cache => 0 }); | |
| 350 | } |