← Index
NYTProf Performance Profile   « line view »
For ./move_planets.pl
  Run on Tue Jan 23 21:11:41 2024
Reported on Tue Jan 23 21:12:47 2024

Filename/aoa_test/cron/utils/utils.pl
StatementsExecuted 8 statements in 813µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
3319215.57ms5.57msmain::::CORE:matchmain::CORE:match (opcode)
331479µs479µsmain::::CORE:printmain::CORE:print (opcode)
11112µs15µsmain::::BEGIN@8.3main::BEGIN@8.3
1118µs44µsmain::::BEGIN@14main::BEGIN@14
0000s0smain::::RUNTIMEmain::RUNTIME
0000s0smain::::add2journalmain::add2journal
0000s0smain::::alert_new_mailmain::alert_new_mail
0000s0smain::::email_usermain::email_user
0000s0smain::::get_galaxymain::get_galaxy
0000s0smain::::get_nearestplanetmain::get_nearestplanet
0000s0smain::::mail_usermain::mail_user
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1#!/usr/local/bin/perl -wT
2#
3# $Id: utils.pl 650 2023-03-18 19:31:16Z tiggr $
4#
5# scriptname.pl -s=pr for pr game, -s=env reads from ENV, pass nothing defaults to test
6# other things on the command line are left alone, starting $ARGV[0]
7
8247µs218µs
# spent 15µs (12+3) within main::BEGIN@8.3 which was called: # once (12µs+3µs) by main::RUNTIME at line 8
use strict;
# spent 15µs making 1 call to main::BEGIN@8.3 # spent 3µs making 1 call to strict::import
916µs$ENV{PATH}="";
1012µs$ENV{ENV}="";
11
1213µs119.4msmy $dbh = &db_setup;
# spent 19.4ms making 1 call to main::db_setup
13
142746µs279µs
# spent 44µs (8+36) within main::BEGIN@14 which was called: # once (8µs+36µs) by main::RUNTIME at line 14
use CGI::Carp;
# spent 44µs making 1 call to main::BEGIN@14 # spent 36µs making 1 call to CGI::Carp::import
15
16sub add2journal {
17 my ( $loginid, $entry, $category ) = @_;
18
19 if ( !$entry ) { $entry = ''; }
20 if ( !$category ) { $category = 'misc'; }
21 my ($tradeflag) = 0;
22 if ( "$category" eq "factoryai" ) {
23 $category = "factory";
24 $tradeflag = 1;
25 } elsif ( "$category" eq "farmai" ) {
26 $category = "farm";
27 $tradeflag = 1;
28 } elsif ( "$category" eq "outpostai" ) {
29 $category = "outpost";
30 $tradeflag = 1;
31 } elsif ( "$category" eq "silversmithai" ) {
32 $category = "silversmith";
33 $tradeflag = 1;
34 }
35
36 my ($type) = db_domyquery($dbh,"SELECT `type` FROM `users` WHERE `id`=".$dbh->quote($loginid)."");
37 if ($type eq 'user') {
38 my ($add) = db_domyquery( $dbh,"SELECT `journal_$category` FROM `notifications` WHERE `owner_id`='$loginid'");
39 if ($add) {
40 if ( $tradeflag == 1 ) {
41 db_domyquery( $dbh,"INSERT INTO `journals` (`owner_id`,`entry`,`date`,`category`,`trade`) VALUES (".$dbh->quote($loginid).",".$dbh->quote($entry).",NOW(),".$dbh->quote($category).",'yes')" );
42 } else {
43 db_domyquery( $dbh,"INSERT INTO `journals` (`owner_id`,`entry`,`date`,`category`) VALUES (".$dbh->quote($loginid).",".$dbh->quote($entry).",NOW(),".$dbh->quote($category).")");
44 }
45 } else {
46 # add anyway but mark it deleted. helps bug reports if I can see what actually did happen
47 if ( $tradeflag == 1 ) {
48 db_domyquery( $dbh,"INSERT INTO `journals` (`owner_id`,`entry`,`date`,`category`,`trade`,`deleted`) VALUES (".$dbh->quote($loginid).",".$dbh->quote($entry).",NOW(),".$dbh->quote($category).",'yes',1)");
49 } else {
50 db_domyquery($dbh,"INSERT INTO `journals` (`owner_id`,`entry`,`date`,`category`,`deleted`) VALUES (".$dbh->quote($loginid).",".$dbh->quote($entry).",NOW(),".$dbh->quote($category).",1)");
51 }
52 }
53 }
54}
55
56sub email_user {
57 my ( $uid, $email, $subject, $body ) = @_;
58 my ( $type) = db_domyquery($dbh,"SELECT `type` FROM `users` WHERE `id`=".$dbh->quote($uid)."");
59 if ( $type eq 'user') {
60 if ($email && $email !~ /westwood-high.staffs.sch.uk/i && $email !~ /joanne\_507\@hotmail\.com/ && $email !~ /Krunto\@yohoo\.com/) {
61 my $from = 'tiggr@ashesofangels.com';
62 my $to = $email;
63 $body .= "\n\n";
64 $body .= "AoA Team\n";
65
66 #open(SM,"| /usr/sbin/sendmail -t") || die("can't find sendmail");
67 open( SM, "| /usr/local/sbin/ssmtp -t" ) || die("can't find ssmtp");
68 print SM "From: $from\n";
69 print SM "To: $to\n";
70 print SM "Subject: $subject\n";
71 print SM "\n";
72 print SM "$body";
73 close(SM);
74 }
75 }
76}
77
78sub alert_new_mail {
79 my ( $uid, $from, $subject ) = @_;
80 my ($type) = db_domyquery($dbh,"SELECT `type` FROM `users` WHERE `id`=".$dbh->quote($uid)."");
81 if ( $type eq 'user') {
82 my ($yes) = db_domyquery($dbh,"SELECT `generic_email` FROM `notifications` WHERE `owner_id`='$uid'");
83 if ($yes) {
84 my ($from) = db_domyquery($dbh,"SELECT `login` FROM `users` WHERE `id`=$from");
85 my ( $email, $login ) = db_domyquery( $dbh,"SELECT `email`,`login` FROM `users` WHERE `id`='$uid'");
86 email_user( $uid, $email, "AOA - New message - from $from","You have received a new message for your account '$login', with subject '$subject'");
87 }
88 }
89}
90
91
92sub mail_user {
93 my ( $to, $from, $subject, $body ) = @_;
94 my ($enabled, $type) = db_domyquery($dbh,"SELECT `enabled`,`type` FROM `users` WHERE `id`=".$dbh->quote($to)."");
95 if ( $enabled == 1 && $type eq 'user') {
96 db_domyquery($dbh,"INSERT INTO `mail` (`body`,`subject`,`mail_to`,`mail_from`,`date_posted`) VALUES (".$dbh->quote($body).",".$dbh->quote($subject).",".$dbh->quote($to).",".$dbh->quote($from).", NOW())");
97 alert_new_mail( $to, $from, $subject );
98 }
99}
100
101sub get_galaxy {
102 my ( $x, $y, $z ) = @_;
103 my ($gid) = db_domyquery($dbh,"SELECT `id`
104 FROM `solar_systems`
105 WHERE `minx`<='$x' AND `maxx`>='$x'
106 AND `miny`<='$y' AND `maxy`>='$y'
107 AND `minz`<='$z' AND `maxz`>='$z'");
108 if ( !$gid ) { $gid = 0; }
109 return $gid;
110}
111
112sub get_nearestplanet {
113 my ( $ux, $uy, $uz ) = @_;
114 # tiggr: this single query seems to work too ;)
115 my($closestpid,$dist2target)=db_domyquery($dbh,"SELECT
116 `id`,
117 SQRT(POW((`x`-$ux),2)+POW((`y`-$uy),2)+POW((`z`-$uz),2)) AS `distance`
118 FROM `planets`
119 WHERE `habitable`=1
120 ORDER BY `distance` ASC
121 LIMIT 1;
122 ");
123 print "closest planet is $closestpid\n";
124 return ( $closestpid, $dist2target );
125}
126
12719µs1;
 
# spent 5.57ms within main::CORE:match which was called 3319 times, avg 2µs/call: # 2212 times (4.56ms+0s) by main::db_domyquery at line 27 of /aoa_test/cron/db/mysql.pl, avg 2µs/call # 1107 times (1.00ms+0s) by main::db_domyquery at line 33 of /aoa_test/cron/db/mysql.pl, avg 904ns/call
sub main::CORE:match; # opcode
# spent 479µs within main::CORE:print which was called 3 times, avg 160µs/call: # once (449µs+0s) by main::RUNTIME at line 98 of /server-root/ashesofangels.com/htdocs/test/cron/tick/move_planets.pl # once (27µs+0s) by main::RUNTIME at line 26 of /server-root/ashesofangels.com/htdocs/test/cron/tick/move_planets.pl # once (4µs+0s) by main::RUNTIME at line 27 of /server-root/ashesofangels.com/htdocs/test/cron/tick/move_planets.pl
sub main::CORE:print; # opcode
Report produced by the NYTProf 6.14 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.