Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Sleep has high cpu

by slojuggler (Beadle)
on Nov 09, 2002 at 02:47 UTC ( [id://211606]=perlquestion: print w/replies, xml ) Need Help??

slojuggler has asked for the wisdom of the Perl Monks concerning the following question:

Hi,

Note: This is all experimental code. I still need to tweak this to remove non-needed lines. Thanks go to ybiC for his initial code:

http://www.perlmonks.org/index.pl?node_id=181972

Currently, I've discovered that when I use Activestate Perl on NT, when I use a program that uses the

sleep

command, the command take up 100% of the CPU time.


Is there a way to sleep without taking up so much CPU cycles? I know I can dumb down the priority of the task through Task Manager, but that requires user intervention.


My program basically does this:

1. Check disk usage. Spit out a msgbox if threshold is exceeded.

2. Sleep for 2 hours. <--HIGH CPU

3. Go to 1.

Thanks in advance --slojuggler

#!perl # wdf.pl # pod at tail use warnings; # avoid D'oh! bugs use strict; # avoid D'oh! bugs use Win32::AdminMisc; # host+drive stuff (www.roth.net/perl/pack +ages) use Win32::EventLog; # log program runs (core ActivePerl mo +dule) use POSIX; # round decimal places (core ActivePerl mo +dule) use Net::SMTP; # email notification (core ActivePerl mo +dule) use File::Spec; # strip path from $0 (core ActivePerl mo +dule) use Tie::IxHash; # ordered hash (core ActivePerl mo +dule) use Getopt::Long; # options & arguments (core ActivePerl mo +dule) use Pod::Usage; # elim redundant Usage() (core ActivePerl mo +dule) use Win32(); # For Msgboxen $|++; # make STDOUT hot my $VERSION = '0.09.07'; ## PRELIMINARIES ## my $host = Win32::AdminMisc::GetComputerName(); my ($notUsed,$not_used,$program) = File::Spec->splitpath( $0 ); ## OPTIONS+ARGUMENTS ## my ($arg_lowFree, @arg_recipients, $arg_smtp); my ($opt_eventLog, $opt_versions, $opt_help, $opt_man); GetOptions( 'lowfree=i' => \$arg_lowFree, 'recipient=s' => \@arg_recipients, 'smtp=s' => \$arg_smtp, 'eventlog!' => \$opt_eventLog, 'versions!' => \$opt_versions, 'help!' => \$opt_help, 'man!' => \$opt_man, ) or pod2usage(-verbose => 1) && exit; #Default threshold if none is defined $arg_lowFree=2.5 if !$arg_lowFree; push my @eventLogStrings, " = $program run started =" if($opt_eventLo +g); pod2usage(-verbose => 1) && exit if $opt_help; pod2usage(-verbose => 2) && exit if $opt_man; pod2usage(-verbose => 1) && exit unless $arg_lowFree && $arg_lowFree > + 0; $arg_smtp = $host unless $arg_smtp; while (1) { ## QUERY DRIVES, GEN INDIVIDUAL DRIVE REPORTS ## my (@report, @lowDrives); my @drives=Win32::AdminMisc::GetDrives(DRIVE_FIXED); for my $drive(@drives){ my ($total, $free) = Win32::AdminMisc::GetDriveSpace($drive); next unless $total; my $used = $total-$free; my $percentUsed = Round(($used/$total)*100); my $percentFree = Round(($free/$total)*100); my($cTotal, $cUsed, $cFree) = Commify(Round($total, $used, $free)); #my $report = " # $drive #$percentUsed percent used #$percentFree percent free # $cTotal bytes total # $cUsed bytes used #$cFree bytes free"; #push @report, $report; push @lowDrives, $drive if($percentFree < $arg_lowFree); } ## COMBINE INDIVIDUAL REPORTS INTO MESSAGE ## my $low = @lowDrives > 0 ? join(' and ', @lowDrives) : 'No'; next if ($low eq 'No'); my $plural = @lowDrives == 1 ? '' : 's'; my $alarum = " $host\'s $low drive$plural have less than ${arg_lowFre +e}% free space!"; unshift @report, $alarum; my $message = join("\n", @report); my ($mins, $hours, $day, $month, $year) = (localtime) [1,2,3,4,5]; #Adjust for 1-digit minutes and $hours $mins = "0" . $mins if ($mins<10); $hours = "0" . $hours if ($hours<10); my $timestamp = ($month+1) . "/" . $day . "/" . ($year+1900) . " - " . + $hours . ":" . $mins; Win32::MsgBox("$message",48,"Running low on space at $timestamp..."); #print "\n$message\n"; push @eventLogStrings, " = $program report =\n$message" if($opt_event +Log); #Sleep for 2 hours, then respawn sleep 2 * 3600; #sleep 5; ## OPTIONAL EMAIL NOTIFICATION ## if(@arg_recipients && @lowDrives > 0){ my $autoMsg = "Message automatically generated by $program program and sent to:" +; my $recipListMsg = join("\n ", @arg_recipients); for my $recipient(@arg_recipients){ print "Sending message to $recipient... "; if(my $smtp = new Net::SMTP($arg_smtp)){ $smtp->mail("$program\@$host"); $smtp->to($recipient); $smtp->data(); $smtp->datasend("To: $recipient\n"); $smtp->datasend("Subject: ALERT - $host DISK SPACE GETTING LOW\n +"); $smtp->datasend("\n"); $smtp->datasend("\n$autoMsg\n $recipListMsg\n\n$message"); $smtp->dataend(); $smtp->quit(); print "successful"; push @eventLogStrings, " = $program sent email to $recipient" if($opt_eventLog); } else { print "failed"; push @eventLogStrings, "ERROR = $program failed to email $recip +ient =" if($opt_eventLog); } print "\n"; } } ## WRAP IT UP ## END{ my @verMsg = ( "\nVersions info:", " Win32::AdminMisc $Win32::AdminMisc::VERSION", " Win32::EventLog $Win32::EventLog::VERSION", " POSIX $POSIX::VERSION", " Net::SMTP $Net::SMTP::VERSION", " File::Spec $File::Spec::VERSION", " Getopt::Long $Getopt::Long::VERSION", " Pod::Usage $Pod::Usage::VERSION", " Perl $]", " wdf.pl $VERSION", " $^O", ); tie my %winVer, "Tie::IxHash"; %winVer = Win32::AdminMisc::GetWinVersion; for my $key (keys %winVer) { push @verMsg, " $key - $winVer{$key}"; } my $verMsg = join("\n", @verMsg); print $verMsg if($opt_versions); ## OPTIONAL EVENT LOGGING ## if($opt_eventLog){ push @eventLogStrings, " = $program run complete ="; my $strings = join("\n", @eventLogStrings); my $eventType = @lowDrives > 0 ?'EVENTLOG_WARNING_TYPE':'EVENTLOG_INFORMATION_TY +PE'; Win32::EventLog::Open( my $event ) or warn 'fail on Win32::EventLog::Open()'; $event->Report({ Computer => $host, Source => $program, EventType => $eventType, ## FIXM +E ## Strings => "\n\n$strings\n$verMsg", }) or warn 'fail on Win32::EventLog::Report()'; ## $event->Close or warn 'fail on Win32::EventLog::Close'; ## FIXM +E ## } } } ###################################################################### +#### # Round long-decimal numbers for legibility: # (from Math::Round source) sub Round { my $halfhex = unpack('H*', pack('d', 0.5)); my $half = unpack('d',pack('H*', $halfhex)); my $x; my @res = (); for $x (@_) { if ($x >= 0) { push @res, POSIX::floor($x + $half); } else { push @res, POSIX::ceil ($x - $half); } } return (wantarray) ? @res : $res[0]; } ###################################################################### +#### # Insert commas in long numbers for legibility: sub Commify { my @output; for(@_){ my $input = $_; $input = reverse $input; $input =~ s<(\d\d\d)(?=\d)(?!\d*\.)><$1,>g; $input = reverse $input; push @output, $input; } return @output; } ###################################################################### +#### =head1 TITLE wdf.pl - Check free disk space of all hard disks on a Win32 localhost =head1 SYNOPSIS wdf <arguments> <options> eg; wdf.pl --versions --lowFree 15 --recipient pastor@church.org Arguments and options may be called by short or long form, or even mi +xed eg; wdf --lowFree 5 --recipient admin@church.org --smtp mail.church.org wdf -l 5 -r admin@church.org -s mail.church.org wdf -l 5 --recipient admin@church.org -s mail.church.org Arguments accept an optional '=' eg; wdf -lowFree=30 wdf -lowFree 30 =head1 DESCRIPTION Check free disk space of all hard disks on Win32 locallhost. Optional email notification on low free space. Optional Event Log entry on program run. Intended to run periodically as a scheduled task. =head1 ARGUMENTS --lowFree <positive_integer> --recipient <valid_email_address> --smtp <nearby_SMTP_server> "lowFree" is the minimum percentage of free disk space to check for. If there is less free space than this, print to console and optionally send email alert. "recipient" is the email address to send alert message to. Accepts only one argument, but can be specified multiple times: eg; wdf -r pastor@church.org -r officemgr@church.org "smtp" is an IP address or name of a nearby SMTP server. Default value of localhost. =head1 OPTIONS --eventlog report results to Win32 Event Log --versions print Modules, Perl, OS, Program info --help print contents of pod USAGE, ARGUMENTS, OPTIONS --man print pod in it's entiretya =head1 WIN32 NOTES assoc .pl=Perl ftype Perl=c:\perl\bin\perl.exe "%1" %* pathext=.pl; path=c:\perl\bin\; ppm set repository ROTH http://www.roth.net/perl/packages ppm set save ppm install Win32-AdminMisc Login as administrator control panel, scheduler, runas specific_user at 06:00 /every:Th c:\perl\bin\perl.exe c:\perls\wdf.pl -e -l 25 -r u +ser@host.dom pl2bat wdf.pl =head1 SMTP NOTES telnet mailserver.dom.tld 25 220 mailserver.dom.tld ESMTP helo client.dom.tld 250 OK mail from: user1@dom.tld 250 Sender OK rcpt to: user2@dom.tld 250 Recipient OK testing, testing, 1... 2... 3 . 250 Message accepted for deliver quit 221 mailserver.dom.tld closing connection =head1 TESTED OS Win2kPro sp2 NT4.0 sp6 Perl ActivePerl 5.6.1 Win32::AdminMisc 20000708 POSIX 1.03 Net::SMTP 2.19 File::Spec 0.82 Pod::Usage 1.14 Getopt::Long 2.25 =head1 AUTHOR ybiC =head1 CREDITS Thanks to: thunders for join() tip, Kanji for pointing out 0-bytes-free bug of 'if($total && $free){...} +', fsn for mondo SMTP info/tips/help, Dave Roth for writing Win32 Perl (Scripting|Programming) books. And to some guy named vroom =head1 TODO Confirm NT 'at' entries remain after reboot Debug specified-EventType-ignored, 'none' shown by EventViewer Debug NT4-eventlog-no-line-endings Debug 'fail on Win32::EventLog::Close' Provide Message.dll for message table (Win32::EventLog::Message) use Win32::EventLog::Message; RegisterSource( 'System', 'My Perl Source' ); $Event->Report( { EventID => EVENT_ID, Strings => "Everything is okay.\nReally, it's okay.", EventType => EVENTLOG_SUCCESS_TYPE, }); UnRegisterSource( 'System', 'My Perl Source' ); More informative Net::SMTP errors =head1 UPDATES 2002-07-13 21:50 CDT Initial working code 2002-07-19 10:05 CDT Rework email notify for standard Net::SMTP instead of Mail::Sender Programatically include server name in message Debug email notification (bad sender format) Debug email subject naming smtp host as having low drive space Strip dir path from $0 (down to just wdf.pl) Unshift $alarum into @message before join-ing @message into $messag +e Borrow code from Math::Round for Round() Borrow code from Sys::Hostname for hostName() Getopt::Long and Pod::Usage Debug program continues to run even if required args not provided Eliminate $opt_useMail. Instead, check for @recipient Protect against divide-by-zero from potential drive problem if($total && $free){...} Win32::AdminMisc::GetDrives(DRIVE_FIXED) instead of @arg_drives Win32::AdminMisc::GetComputerName() instead of hostName() Check for $arg_lowFree to be *positive* number Post to PerlMonks Code Catacombs, requesting PERL-ectomy Squash 0-bytes-free bug replace 'if($total && $free){...}' with 'next unless $total;' Intelligent singular/plural on 'less than n% free' message Event Log of program start, message, notify and completion Test from Win2k 'at' and Task Scheduler (success) Unsubify eventLog(), combine all into one message Eliminate 'uninit value' from 'pod2usage(...) unless $arg_lowFree > + 0' Event Log of per-user email success/fail Test on church NT4+Exchange server Test from WinNT4 'at' (success) Getopt argument for nearest SMTP server, default of localhost =cut

Edit by tye to add READMORE

Replies are listed 'Best First'.
Re: Sleep has high cpu
by BrowserUk (Patriarch) on Nov 09, 2002 at 03:35 UTC

    Your problem is that you are never reaching your sleep statement. Your loops is

    while (1) { ....#check drive freespace my $low = @lowDrives > 0 ? join(' and ',lowDrives) : No'; next if ($low eq 'No'); ## <<< PROBLEM HERE! .... sleep 2 *3600; .... }

    Which means that if none of your drives are low, you do next, which goes back and checks again. You never reach the sleep.

    sleep works fine, you're just never actually calling it.


    Nah! You're thinking of Simon Templar, originally played (on UKTV) by Roger Moore and later by Ian Ogilvy
Re: Sleep has high cpu (sleep spins madly behind the scenes)
by ybiC (Prior) on Nov 09, 2002 at 03:37 UTC
    In addition to brothers BUU and BrowserUk's apt wisdom, you may find this node by good monk Albannach to be of interest:

    "while(1){} isn't idle, it's spinning madly behind the scenes, testing 1 as often as possible."


        cheers,
        Don
        striving toward Perl Adept
        (it's pronounced "why-bick")

    Update: PM Search Is Your FriendTM   8^)

      Some time ago I needed to have that kind of spinning (scanning large number of connections on a chat room for activity) but under low load, in the middle of the night, the same code killed the machine.

      I found using Time::HiRes to put a micro sleep inversely proportional to the number of active connections stopped the process from spinning out of control and allowed the OS to pre-empt the loop.

      Thanks

      UnderMine

Re: Sleep has high cpu
by BUU (Prior) on Nov 09, 2002 at 03:27 UTC
    Have you tried just using the windows task scheduler or whatever it's called to run your script every 2 hrs?
Re: Sleep has high cpu
by slojuggler (Beadle) on Nov 09, 2002 at 06:34 UTC
    BUU- Thanks for your comment. I thought of your option initially. However, the program is going to run on both NT4 and Win2k. There have been problems in the past with some workstations running NT4 (a quirky IE version hosed/disabled the scheduler). Many of those workstations are out of my administration, so mucking with the scheduler/browser setup is off limits.

    With this program, all a user/administrator would have to do is add the program to their Startup group.


    BrowserUK- I missed that logic error in my code. I had no idea my sleep line was being overlooked in that particular case. Thanks!


    ybiC - That was a very useful node. Thank you. When I did an initial search with keywords "sleep high cpu", that node didn't turn up for me.


    Fellow monks - The main point of the program would be to pop up a warning to users that their space was dwindling at a predefined threshold on certain drives.

    I honestly had no idea that my infinite loop was causing the high cpu..I thought it was sleep.

    I'm curious though as to why fellow monks have been giving my initial node some - rep.

    I:

    *felt not including the code would make the question more obscure

    *felt the program in question was practical, and hopefully helpful to fellow monks

    *felt that I was following post etiquette


    *did research the question (not knowing that I had a crazy infinite problem rather than the sleep problem I thought I had) If not, let me know what can be improved. And thanks again. --slojuggler

      I didn't vote one way or the other, but a readmore tag would have been helpful to kep the parent node from cluttering up the SOPW page...

      thor

        I will read more about readmore. Thanks!
Re: Sleep has high cpu
by sauoq (Abbot) on Nov 09, 2002 at 22:25 UTC

    Although it looks as though your problem has been solved, I have some unsolicited advice anyway. :-)

    Before assuming that you are seeing a particular problem, it can be helpful to isolate it. That way when you ask questions about it you can be pretty positive that you are asking about a real issue.

    For instance, you might have tried running perl -e "sleep 2 * 3600" and checking your CPU utilization. If it were high you would have been pretty sure that sleep() was indeed the cause of the problem and been able to post a minimal example reproducing the issue. Of course, in this case the utilization would not have been high indicating that the problem was not with sleep() at all. That might have prompted you to check your logic or ask a more appropriate question.

    -sauoq
    "My two cents aren't worth a dime.";
    
Re: Sleep has high cpu
by Jenda (Abbot) on Nov 10, 2002 at 17:00 UTC

    Not really an answer to your question (since I believe sleep() is not the culprit), but ... did you consider making this a service? It really isn't hard. See Win32::Daemon and Win32::Daemon::Simple.

    Jenda

Re: Sleep has high cpu
by Mr. Muskrat (Canon) on Nov 11, 2002 at 16:19 UTC

    In the credits you have Thanks to: and a list of people and how they helped... the last line is:
    And to some guy named vroom

    Thanks for giving me a good laugh this morning!

    Update: It's funny to me because OP includes vroom in the credits but OP doesn't seem to know who vroom is.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://211606]
Approved by ybiC
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (4)
As of 2024-03-28 20:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found