Aufgabe

RDW #02/05 - Raetsel Nummer 02 / 2005

Regeln: 
        * Bitte nicht vor Ablauf der ersten 72 Stunden ( = drei Tage ) nach
~~~~~~~   Veroeffentlichung Hinweise (Spoiler) oder Loesungen veroeffent-
          lichen!

        * Wenn diese Zeit abgelaufen ist, werde ich einen Thread mit passen-
          dem Titel erstellen, in dem die Loesungen gepostet werden und dis-
          kutiert werden koennen.

        * Die Loesungen sollten nicht nur gepostet, sondern auch an mich ge-
          mailt werden, damit ich sie testen, "bewerten"  und zusammenfassen
          kann. Die Adrese dafuer lautet:

          rambo <---AT---> perl <---MINUS---> community <---DOT---> de

          Im Betreff sollte 'RDW' und die Nummer des Raetsels stehen. Hilf-
          reich waere neben dem Quellcode der Username im Forum sowie Perl-
          und OS-Version, falls Du diese kennst.

        * Verstaendnisfragen duerfen in diesem Thread gestellt werden, aber
          Tipps und (Teil-) Loesungen sind hier unerwuenscht.

        * Ich werde die eingeschickten Programme im Netz zur Verfuegung
          stellen, so dass gerade lange Quellcodes nicht (komplett)
          gepostet werden muessen.

        * Zur Verwendung von Modulen: Sind erlaubt

Aufgabe:
schreibe ein Skript welches dir den verlauf und die Dauer deines
Skriptes in punkten und Sekunden anzeigt (Statusanzeige, Verlaufsanzeige):

Beispiel:
Starte Script .......
Wartezeit war 7 sec.

Lösungsvorschläge

Lösungsvorschlag als Modul waitproc.pm von ptk

# -*- perl -*-

#
# $Id: RaetseL200502.txt,v 1.3 2009/04/15 13:42:32 HaraldBongartz Exp $
# Author: Slaven Rezic
#
# Copyright (C) 1999,2004 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: slaven@rezic.de
# WWW:  http://bbbike.sourceforge.net
#

=head1 NAME

Waitproc - a wait process

=head1 SYNOPSIS

    use Waitproc;
    waitproc();      # start rotor
    sleep 10;        # do something ...
    stop_waitproc(); # stop rotor

=cut

package Waitproc;
require Exporter;
@ISA = qw(Exporter);
@EXPORT    = qw(waitproc stop_waitproc);
@EXPORT_OK = qw(progress);

use strict;
use vars qw($waitproc_pid $rotor $rotor_delay_time);

=head1 FUNCTIONS

=head2 waitproc()

Start a wait processs. The wait process will display a rotating line.

=cut

$rotor            = '\|/-' unless defined $rotor;
$rotor_delay_time = 0.07   unless defined $rotor_delay_time;

sub waitproc {
    eval {
   $waitproc_pid = fork;
   if ($waitproc_pid == 0) {
       my $rotor_i = 0;
       my $check_counter = 0;
       $| = 1;
       while (1) {
      print substr($rotor, $rotor_i, 1) . "\r";
      if (++$rotor_i >= length($rotor)) {
          $rotor_i = 0;
      }
      select(undef, undef, undef, $rotor_delay_time);
      if ($rotor_delay_time &&
          ++$check_counter > 1/$rotor_delay_time) {
          $check_counter=0;
          if (!kill 0 => getppid()) {
         warn "Parent process stopped, quiting waitprocess\n";
         CORE::exit();
          }
      }
       }
       CORE::exit();
   }
   $waitproc_pid;
    };
}

=head2 stop_waitproc

Stop the wait process. It is strongly advised to put the code between
the waitproc/stop_waitproc pair in a eval block. Otherwise, if an
exception occurs in the code between, the parent process will stop but
the wait process will continue.

=cut

sub stop_waitproc {
    if (defined $waitproc_pid) {
   kill 9 => $waitproc_pid;
   undef $waitproc_pid;
    }
}

=head2 progress

Usage:

    use Waitproc;
    $from = 0;
    $to = 10000;
    $i = Waitproc::progress($from, $to);
    for ($$i = $from; $$i < $to; $$i++) { ... }
    # for $$i ($from .. $to) does not work here...

Es gibt noch Bugs, z.B. werden Shared Memory und Semaphoren nicht
richtig gelöscht und verhindern so einen erneuten Start. (Ich glaube nur bei
Abbruch mit Signalen).

=cut

sub progress {
    my($from, $to) = @_;
    my $iter;
    eval {
   require IPC::Shareable;

   $waitproc_pid = fork;

   if ($waitproc_pid) { # Server
       my %options = (
            'key' => 'paint',
            'create' => 'yes',
            'exclusive' => 'no',
            'mode' => 0644,
            'destroy' => 'yes',
           );
       tie $iter, 'IPC::Shareable', 'prgrs', \%options;
       $iter = $from;

   } else {

       my %options = (
         'key' => 'paint',
         'create' => 'no',
         'exclusive' => 'no',
         'mode' => 0644,
         'destroy' => 'no',
             );

       my $i;
       tie $i, "IPC::Shareable", 'prgrs', \%options;

       $| = 1;
       while (1) {
      printf "%d%% ...   \r", 100*($i-$from)/($to-$from);
      select(undef, undef, undef, 0.1);
      last if ($i >= $to);
       }
       CORE::exit();
   }
    };
    \$iter;
}

=head2 set([$rotor],[$rotor_delay])

Set the rotor string and/or the rotor delay time (currently 0.07
seconss). The default rotor string is '\|/-', but you can change it
to, say, '.oOo'.

=cut

sub set {
    my($in_rotor, $in_rotor_delay_time) = @_;
    if (defined $in_rotor) {
   $rotor = $in_rotor;
    }
    if (defined $in_rotor_delay_time) {
   $rotor_delay_time = $in_rotor_delay_time;
    }
}

1;

__END__

Lösungsvorschlag als script von Rambo

################################################################################
#                                                                              
# AUTHOR           : Rambo
# CREATION DATE    : 05 June 2005                                         
#                                                                             
# SHORT DESCRIPTION: RDW 02/05 
#                                                                             
# (c) R.H. 2004 - 2005                        
#                                                                             
# -----------------------------------------------------------------------------
# File name        : RDW_02_05_RH.PL
# Location         : FRA
# Last edited by   : R.H.
# Last Checkin     : 05.06.2005
# Revision         : 0.1
# -----------------------------------------------------------------------------
# RDW_02_05_RH.PL, global file description
# -----------------------------------------------------------------------------
# History:
# 05.06.2005  first version
# -----------------------------------------------------------------------------
#
# Last change: 05.06.2005 R.H.
#
################################################################################
#
#
# ------------------------------------------------------------------
# Loaded Modules
# ------------------------------------------------------------------
use strict;
use warnings;
use threads;
use threads::shared;
#
#
# ------------------------------------------------------------------
# $StopDotPrintFlag controls dot printing 
# $StopDotPrintFlag=1 print dots
# $StopDotPrintFlag=2 stop printing dots and end
# ------------------------------------------------------------------
my $StopDotPrintFlag : shared;
$StopDotPrintFlag=0;
#
#
# ------------------------------------------------------------------
# specifies sleep intervall between dot prints
# ------------------------------------------------------------------
my $Interval=1;
#
#
# ------------------------------------------------------------------
# Initialize thread to print dots
# ------------------------------------------------------------------
my $DotPrintThread=threads->new(\&DotPrintThread, $Interval);
#
#
# ------------------------------------------------------------------
# Do the work - here waiting for something to be entered
# ------------------------------------------------------------------
WaitForSomethingEntered();
#
#
# ------------------------------------------------------------------
# stop printing dots
# ------------------------------------------------------------------
$StopDotPrintFlag=2;
#
#
# ------------------------------------------------------------------
# Wait for thread to print dots
# ------------------------------------------------------------------
my $NumberOfPrintedDots=$DotPrintThread->join;
print "Waiting time was ".$NumberOfPrintedDots*$Interval." seconds\n";
#
#
# ------------------------------------------------------------------
# sub for wait
# ------------------------------------------------------------------
sub WaitForSomethingEntered
   {
    print "Wait for input:";
    $StopDotPrintFlag=1;
    my $Input=<>;
   }
#
#
# ------------------------------------------------------------------
# sub for print
# ------------------------------------------------------------------
sub DotPrintThread 
   {
    my ($Interval, @Trash)=@_;
#
#    
# ------------------------------------------------------------------
# STDOUT output is buffered, means printed only after carriage return.
# To see the dot right after each print autoflush for STDOUT has to be set to 1
# ------------------------------------------------------------------
    use IO::Handle;
    autoflush STDOUT 1;

    my $IntervalCount=0; # counts the number of loops
    while ($StopDotPrintFlag != 2) 
        { # stop thread when $StopDotPrintFlag=2
          if ($StopDotPrintFlag == 1)
            { # only print dots when $StopDotPrintFlag=1
             print STDOUT ".";
            }
             $IntervalCount++;
             sleep $Interval;
         }
     return $IntervalCount; # return number of intervals
   }
#
#
__END__   

normale Lösungen

Ergänzungen, Kommentare

---### -- Main.RemoHehlert - 06 Jun 2005

• Waitproc.pm: Loesung von ptk

• RDW_02_05_RH.PL.txt: Loesung von Rambo