Open Build Service

We truncated the diff of some files because they were too big. If you want to see the full diff for every file, click here.

Changes of Revision 340

_service:tar_scm_kernel_repo:perl-Net-Daemon.spec Changed

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/regexp-threads Deleted

@@ -1,85 +0,0 @@
-#!/usr/bin/perl
-#
-#   To the best of my knowledge, regular expressions aren't thread
-#   safe in Perl. That's why the variable $Net::Daemon::RegExpLock
-#   exists. If you want to check your Perl, try this script.
-#
-#   On my Perl, 5.005_03 (i386-linux-thread) this produces a
-#   Segfault almost reproducible.
-#
-#   Please let me know if you are having better luck.
-#
-#   Jochen Wiedmann, joe@ispsoft.de, 24-Jul-1999
-#
-#
-
-my $this_is_510 = $^V ge v5.10.0;
-
-use Thread ();
-
-if ($this_is_510) {
-    eval {require threads::shared};
-}
-
-my $numChilds;
-if ($this_is_510) {
-    eval { threads::shared::share($numChilds) };
-}
-
-my $regExpLock = @ARGV ? 1 : 0;
-
-# Repeat generating a random number and check if it contains the
-# substring '35'.
-sub Loop {
-    my $myNum = shift;
-    my $num1 = 0;
-    my $num2 = 0;
-    for (my $i = 1;  $i <= 100000;  $i++) {
-  	if (($myNum == 1) and ($i % 10000) == 0) {
-  	    my $lck = lock $numChilds;
-  	    print $i, "\n";
-  	}
-	my $r = int(rand(100000));
-	++$num1 if index($r, '35') >= 0;
-	{
-	    my $lck = lock $regExpLock if $regExpLock;
-	++$num2 if $r =~ /(.*)35(.*)/;
-    }
-    }
-    return ($num1, $num2);
-}
-
-sub Run {
-    my $myNum = shift;
-    {
-	my $lck = lock $numChilds;
-	++$numChilds;
-	print "Thread $myNum starting\n";
-    }
-    my($num1, $num2) = eval { Loop($myNum) };
-    my $err = $@;
-    $num1 ||= 0;
-    $num2 ||= 0;
-    {
-	my $lck = lock $numChilds;
-	--$numChilds;
-	print "Thread $myNum: Fatal error ($@)\n" if $err;
-	print "Thread $myNum, error: index = $num1, regexp = $num2\n"
-	    if $num1 != $num2;
-	print "Thread $myNum leaving\n";
-    }
-    return 1;
-}
-
-
-my @childs;
-for (my $i = 0;  $i < 10;  ++$i) {
-    print "Creating thread $i, TID = ", Thread->self->tid(), "\n";
-    my $tid = Thread->new(\&Run, $i);
-    die "Failed to create thread: $!" unless $tid;
-    push(@childs, $tid);
-}
-
-foreach my $tid (@childs) {
-    $tid->join();
-}

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/t/thread.t Deleted

@@ -1,82 +0,0 @@
-# -*- perl -*-
-#
-#   $Id: thread.t,v 1.2 1999/08/12 14:28:59 joe Exp $
-#
-
-require 5.004;
-use strict;
-
-BEGIN { push(@INC, "C:/temp/Net-Daemon/blib/lib");}
-use IO::Socket ();
-use Config ();
-use Net::Daemon::Test ();
-use Test::More;
-
-my $numTests = 5;
-
-# Check whether threads are available, otherwise skip this test.
-my $version = $^V;
-$version =~ s/v(\d+\.\d+)\.\d+/$1/;
-
-
-if ($version >= 5.10) {
-
-    # The paragraph below is pasted from the perlthrtut, 2010.11.20
-    #
-    # NOTE: There was another older Perl threading flavor called the
-    # 5.005 model that used the Threads class. This old model was
-    # known to have problems, is deprecated, and was removed for
-    # release 5.10. You are strongly encouraged to migrate any
-    # existing 5.005 threads code to the new model as soon as
-    # possible.
-    my $message = "Using Perl version $version\n" .
-                  "\tOld threads style supplanted by ithreads after ".
-                  "Perl version 5.10\n";
-    print STDERR "$message";
-    plan(skip_all => $message);
-    exit;
-}
-
-if (!eval { require Thread; my $t = Thread->new(sub { }) }) {
-    print "1..0\n";
-    exit 0;
-}
-
-my($handle, $port) = Net::Daemon::Test->Child
-    ($numTests, $^X, 't/server', '--timeout', 20, '--mode=threads');
-
-
-print "Making first connection to port $port...\n";
-my $fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-			       'PeerPort' => $port);
-printf("%s 1\n", $fh ? "ok" : "not ok");
-printf("%s 2\n", $fh->close() ? "ok" : "not ok");
-print "Making second connection to port $port...\n";
-$fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-			    'PeerPort' => $port);
-printf("%s 3\n", $fh ? "ok" : "not ok");
-eval {
-    for (my $i = 0;  $i < 20;  $i++) {
-	if (!$fh->print("$i\n")  ||  !$fh->flush()) {
-	    die "Error while writing $i: " . $fh->error() . " ($!)";
-	}
-
-	my $line = $fh->getline();
-	die "Error while reading $i: " . $fh->error() . " ($!)\n"
-	    unless defined($line);
-	die "Result error: Expected " . ($i*2) . ", got $line"
-	    unless ($line =~ /(\d+)/  &&  $1 == $i*2);
-    }
-};
-if ($@) {
-    print STDERR "$@\n";
-    print "not ok 4\n";
-} else {
-    print "ok 4\n";
-}
-printf("%s 5\n", $fh->close() ? "ok" : "not ok");
-
-END {
-    if ($handle) { $handle->Terminate() }
-    if (-f "ndtest.prt") { unlink "ndtest.prt" }
-}

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/t/threadm.t Deleted

@@ -1,121 +0,0 @@
-# -*- perl -*-
-#
-#   $Id: threadm.t,v 1.3 2007/05/16 13:58 mhn $
-#
-
-require 5.004;
-use strict;
-
-use IO::Socket ();
-use Config ();
-use Net::Daemon::Test ();
-use Fcntl ();
-use Config ();
-
-
-$| = 1;
-$^W = 1;
-
-
-if (!$Config::Config{'usethreads'}  ||
-    $Config::Config{'usethreads'} ne 'define'  ||
-    !eval { require Thread }) {
-    print "1..0\n";
-    exit 0;
-}
-
-
-my($handle, $port);
-if (@ARGV) {
-    $port = shift @ARGV;
-} else {
-    ($handle, $port) = Net::Daemon::Test->Child
-	(10, $^X, '-Iblib/lib', '-Iblib/arch', 't/server',
-	 '--mode=threads', 'logfile=stderr', 'debug');
-}
-
-
-my $regexpLock = 1;
-sub IsNum {
-    #
-    # Regular expressions aren't thread safe, as of 5.00502 :-(
-    #
-    my $lock = lock($regexpLock);
-    my $str = shift;
-    (defined($str)  &&  $str =~ /(\d+)/) ? $1 : undef;
-}
-
-
-sub ReadWrite {
-    my $fh = shift; my $i = shift; my $j = shift;
-    die "Child $i: Error while writing $j: $!"
-	unless $fh->print("$j\n") and $fh->flush();
-    my $line = $fh->getline();
-    die "Child $i: Error while reading: " . $fh->error() . " ($!)"
-	unless defined($line);
-    my $num = IsNum($line);
-    die "Child $i: Cannot parse result: $line"
-	unless defined($num);
-    die "Child $i: Expected " . ($j*2) . ", got $num"
-	unless ($num == $j*2);
-}
-
-
-sub MyChild {
-    my $i = shift;
-
-    eval {
-	my $fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-				       'PeerPort' => $port);
-	die "Cannot connect: $!" unless defined($fh);
-	for (my $j = 0;  $j < 1000;  $j++) {
-	    ReadWrite($fh, $i, $j);
-	}
-    };
-    if ($@) {
-	print STDERR $@;
-	return 0;
-    }
-    return 1;
-}
-
-my @threads = ();
-
-if (!$Config::Config{'usethreads'}  ||
-    $Config::Config{'usethreads'} ne 'define') {
-
-    for (my $i = 0;  $i < 10;  $i++) {
-        #print "Spawning child $i.\n";
-        my $tid = Thread->new(\&MyChild, $i);
-        if (!$tid) {
-            print STDERR "Failed to create new thread: $!\n";
-            exit 1;
-        }
-        push(@threads, $tid);
-    }
-
-}
-eval { alarm 1; alarm 0 };
-alarm 120 unless $@;
-for (my $i = 1;  $i <= 10;  $i++) {
-    if (@threads) {
-        my $tid = shift @threads;
-        if ($tid->join()) {
-            print "ok $i\n";
-        } else {
-            print "not ok $i\n";
-        }
-    } else {
-        print "ok $i\n"; # Fake output for Windows when
-                         # Perl -V reveals usethreads
-    }
-}
-
-END {
-    if ($handle) {
-	print "Terminating server.\n";
-	$handle->Terminate();
-	undef $handle;
-    }
-    unlink "ndtest.prt";
-}

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/ChangeLog -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/ChangeLog Changed

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/MANIFEST -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/MANIFEST Changed

@@ -6,18 +6,16 @@
 lib/Net/Daemon.pm	Net::Daemon module
 lib/Net/Daemon/Log.pm	Support class for logging
 lib/Net/Daemon/Test.pm	Support class for writing tests
-regexp-threads		Test for the safety of regular expressions in threads
 t/base.t		Base test
 t/config.t		Test of config file handling and access control
 t/fork.t		Test of a forking server
 t/forkm.t		Test of a forking server with multiple clients
-t/ithread.t		Test of a multithreaded server (ithreads)
-t/ithreadm.t		Test of a multithreaded server with multiple clients
+t/ithread.t		Test of a multithreaded server (ithreads)
+t/ithreadm.t		Test of a multithreaded server with multiple clients
 t/loop.t		Test the loop-timeout option
 t/loop-child.t		Same with loop-child set
 t/server		Script used by the server tests
 t/single.t		Test of a single-mode server
-t/thread.t		Test of a multithreaded server
-t/threadm.t		Test of a multithreaded server with multiple clients
 t/unix.t		Test for Unix sockets
-META.yml                                 Module meta-data (added by MakeMaker)
+META.yml                                 Module YAML meta-data (added by MakeMaker)
+META.json                                Module JSON meta-data (added by MakeMaker)

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/MANIFEST.SKIP -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/MANIFEST.SKIP Changed

_service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/META.json Added

@@ -0,0 +1,53 @@
+{
+   "abstract" : "Perl extension for portable daemons",
+   "author" : [
+      "Jochen Wiedmann <joe@ispsoft.de>"
+   ],
+   "dynamic_config" : 1,
+   "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010",
+   "license" : [
+      "unknown"
+   ],
+   "meta-spec" : {
+      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+      "version" : 2
+   },
+   "name" : "Net-Daemon",
+   "no_index" : {
+      "directory" : [
+         "t",
+         "inc"
+      ]
+   },
+   "prereqs" : {
+      "build" : {
+         "requires" : {
+            "ExtUtils::MakeMaker" : "0"
+         }
+      },
+      "configure" : {
+         "requires" : {
+            "ExtUtils::MakeMaker" : "0"
+         }
+      },
+      "runtime" : {
+         "requires" : {
+            "Sys::Syslog" : "0.29"
+         }
+      }
+   },
+   "release_status" : "stable",
+   "resources" : {
+      "bugtracker" : {
+         "web" : "https://github.com/toddr/Net-Daemon/issues"
+      },
+      "license" : [
+         "http://dev.perl.org/licenses/"
+      ],
+      "repository" : {
+         "url" : "https://github.com/toddr/Net-Daemon"
+      }
+   },
+   "version" : "0.49",
+   "x_serialization_backend" : "JSON::PP version 4.02"
+}

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/META.yml -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/META.yml Changed

@@ -1,21 +1,27 @@
---- #YAML:1.0
-name:               Net-Daemon
-version:            0.48
-abstract:           Perl extension for portable daemons
-author:
-    - Jochen Wiedmann (joe@ispsoft.de)
-license:            unknown
-distribution_type:  module
-configure_requires:
-    ExtUtils::MakeMaker:  0
-build_requires:
-    ExtUtils::MakeMaker:  0
-requires:  {}
-no_index:
-    directory:
-        - t
-        - inc
-generated_by:       ExtUtils::MakeMaker version 6.56
-meta-spec:
-    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
-    version:  1.4
+---
+abstract: 'Perl extension for portable daemons'
+author:
+  - 'Jochen Wiedmann <joe@ispsoft.de>'
+build_requires:
+  ExtUtils::MakeMaker: '0'
+configure_requires:
+  ExtUtils::MakeMaker: '0'
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010'
+license: unknown
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: '1.4'
+name: Net-Daemon
+no_index:
+  directory:
+    - t
+    - inc
+requires:
+  Sys::Syslog: '0.29'
+resources:
+  bugtracker: https://github.com/toddr/Net-Daemon/issues
+  license: http://dev.perl.org/licenses/
+  repository: https://github.com/toddr/Net-Daemon
+version: '0.49'
+x_serialization_backend: 'CPAN::Meta::YAML version 0.018'

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/Makefile.PL -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/Makefile.PL Changed

@@ -1,42 +1,29 @@
-# -*- perl -*-
-#
-# $Id: Makefile.PL,v 1.2 1999/08/12 14:28:53 joe Exp $
-#
+use strict;
+use warnings;
 
 use ExtUtils::MakeMaker;
 
 my %opts = (
-    'NAME'	=> 'Net::Daemon',
-    'VERSION_FROM' => 'lib/Net/Daemon.pm', # finds $VERSION
-    'dist' => { 'DIST_DEFAULT' => q[all tardist],
-	        'COMPRESS' => q[gzip -9vf],
-	        'SUFFIX' => q[.gz]
-	    },
-    'realclean' => { 'FILES' => 't/config ndtest.prt' }
+    'NAME'          => 'Net::Daemon',
+    'ABSTRACT_FROM' => 'lib/Net/Daemon.pm',
+    'AUTHOR'        => 'Jochen Wiedmann <joe@ispsoft.de>',
+    'VERSION_FROM'  => 'lib/Net/Daemon.pm',                  # finds $VERSION
+    'PREREQ_PM'     => {
+        'Sys::Syslog' => '0.29',
+    },
+    'dist' => {
+        'DIST_DEFAULT' => q[all tardist],
+        'COMPRESS'     => q[gzip -9vf],
+        'SUFFIX'       => q[.gz]
+    },
+    'realclean' => { 'FILES' => 't/config ndtest.prt' },
+    'META_MERGE' => {
+        'resources' => {
+            license    => 'http://dev.perl.org/licenses/',
+            bugtracker => 'https://github.com/toddr/Net-Daemon/issues',
+            repository => 'https://github.com/toddr/Net-Daemon',
+        },
+    },
 );
 
-if ($ExtUtils::MakeMaker::VERSION >= 5.43) {
-    $opts{ABSTRACT_FROM} = 'lib/Net/Daemon.pm';
-    $opts{AUTHOR} = 'Jochen Wiedmann (joe@ispsoft.de)';
-}
-
 WriteMakefile(%opts);
-
-
-package MY;
-
-sub libscan {
-    my ($self, $path) = @_;
-    ($path =~ /\~$/) ? undef : $path;
-}
-
-sub postamble {
-    qq{
-
-pm_to_blib: README
-
-README: lib/Net/Daemon.pm
-\tpod2text lib/Net/Daemon.pm >README
-
-}
-}

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/README -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/README Changed

@@ -1,477 +1,473 @@
-NAME
-    Net::Daemon - Perl extension for portable daemons
-
-SYNOPSIS
-      # Create a subclass of Net::Daemon
-      require Net::Daemon;
-      package MyDaemon;
-      @MyDaemon::ISA = qw(Net::Daemon);
-
-      sub Run ($) {
-        # This function does the real work; it is invoked whenever a
-        # new connection is made.
-      }
-
-DESCRIPTION
-    Net::Daemon is an abstract base class for implementing portable server
-    applications in a very simple way. The module is designed for Perl 5.005
-    and threads, but can work with fork() and Perl 5.004.
-
-    The Net::Daemon class offers methods for the most common tasks a daemon
-    needs: Starting up, logging, accepting clients, authorization,
-    restricting its own environment for security and doing the true work.
-    You only have to override those methods that aren't appropriate for you,
-    but typically inheriting will safe you a lot of work anyways.
-
-  Constructors
-      $server = Net::Daemon->new($attr, $options);
-
-      $connection = $server->Clone($socket);
-
-    Two constructors are available: The new method is called upon startup
-    and creates an object that will basically act as an anchor over the
-    complete program. It supports command line parsing via "Getopt::Long
-    (3)".
-
-    Arguments of new are *$attr*, an hash ref of attributes (see below) and
-    *$options* an array ref of options, typically command line arguments
-    (for example \@ARGV) that will be passed to Getopt::Long::GetOptions.
-
-    The second constructor is Clone: It is called whenever a client
-    connects. It receives the main server object as input and returns a new
-    object. This new object will be passed to the methods that finally do
-    the true work of communicating with the client. Communication occurs
-    over the socket $socket, Clone's argument.
-
-    Possible object attributes and the corresponding command line arguments
-    are:
-
-    *catchint* (--nocatchint)
-        On some systems, in particular Solaris, the functions accept(),
-        read() and so on are not safe against interrupts by signals. For
-        example, if the user raises a USR1 signal (as typically used to
-        reread config files), then the function returns an error EINTR. If
-        the *catchint* option is on (by default it is, use --nocatchint to
-        turn this off), then the package will ignore EINTR errors whereever
-        possible.
-
-    *chroot* (--chroot=dir)
-        (UNIX only) After doing a bind(), change root directory to the given
-        directory by doing a chroot(). This is usefull for security
-        operations, but it restricts programming a lot. For example, you
-        typically have to load external Perl extensions before doing a
-        chroot(), or you need to create hard links to Unix sockets. This is
-        typically done in the config file, see the --configfile option. See
-        also the --group and --user options.
-
-        If you don't know chroot(), think of an FTP server where you can see
-        a certain directory tree only after logging in.
-
-    *clients*
-        An array ref with a list of clients. Clients are hash refs, the
-        attributes *accept* (0 for denying access and 1 for permitting) and
-        *mask*, a Perl regular expression for the clients IP number or its
-        host name. See "Access control" below.
-
-    *configfile* (--configfile=file)
-        Net::Daemon supports the use of config files. These files are
-        assumed to contain a single hash ref that overrides the arguments of
-        the new method. However, command line arguments in turn take
-        precedence over the config file. See the "Config File" section below
-        for details on the config file.
-
-    *debug* (--debug)
-        Turn debugging mode on. Mainly this asserts that logging messages of
-        level "debug" are created.
-
-    *facility* (--facility=mode)
-        (UNIX only) Facility to use for "Sys::Syslog (3)". The default is
-        daemon.
-
-    *group* (--group=gid)
-        After doing a bind(), change the real and effective GID to the
-        given. This is usefull, if you want your server to bind to a
-        privileged port (<1024), but don't want the server to execute as
-        root. See also the --user option.
-
-        GID's can be passed as group names or numeric values.
-
-    *localaddr* (--localaddr=ip)
-        By default a daemon is listening to any IP number that a machine
-        has. This attribute allows to restrict the server to the given IP
-        number.
-
-    *localpath* (--localpath=path)
-        If you want to restrict your server to local services only, you'll
-        prefer using Unix sockets, if available. In that case you can use
-        this option for setting the path of the Unix socket being created.
-        This option implies --proto=unix.
-
-    *localport* (--localport=port)
-        This attribute sets the port on which the daemon is listening. It
-        must be given somehow, as there's no default.
-
-    *logfile* (--logfile=file)
-        By default logging messages will be written to the syslog (Unix) or
-        to the event log (Windows NT). On other operating systems you need
-        to specify a log file. The special value "STDERR" forces logging to
-        stderr.
-
-    *loop-child* (--loop-child)
-        This option forces creation of a new child for loops. (See the
-        *loop-timeout* option.) By default the loops are serialized.
-
-    *loop-timeout* (--loop-timeout=secs)
-        Some servers need to take an action from time to time. For example
-        the Net::Daemon::Spooler attempts to empty its spooling queue every
-        5 minutes. If this option is set to a positive value (zero being the
-        default), then the server will call its Loop method every
-        "loop-timeout" seconds.
-
-        Don't trust too much on the precision of the interval: It depends on
-        a number of factors, in particular the execution time of the Loop()
-        method. The loop is implemented by using the *select* function. If
-        you need an exact interval, you should better try to use the alarm()
-        function and a signal handler. (And don't forget to look at the
-        *catchint* option!)
-
-        It is recommended to use the *loop-child* option in conjunction with
-        *loop-timeout*.
-
-    *mode* (--mode=modename)
-        The Net::Daemon server can run in three different modes, depending
-        on the environment.
-
-        If you are running Perl 5.005 and did compile it for threads, then
-        the server will create a new thread for each connection. The thread
-        will execute the server's Run() method and then terminate. This mode
-        is the default, you can force it with "--mode=ithreads" or
-        "--mode=threads".
-
-        If threads are not available, but you have a working fork(), then
-        the server will behave similar by creating a new process for each
-        connection. This mode will be used automatically in the absence of
-        threads or if you use the "--mode=fork" option.
-
-        Finally there's a single-connection mode: If the server has accepted
-        a connection, he will enter the Run() method. No other connections
-        are accepted until the Run() method returns. This operation mode is
-        useful if you have neither threads nor fork(), for example on the
-        Macintosh. For debugging purposes you can force this mode with
-        "--mode=single".
-
-        When running in mode single, you can still handle multiple clients
-        at a time by preforking multiple child processes. The number of
-        childs is configured with the option "--childs".
-
-    *childs*
-        Use this parameter to let Net::Daemon run in prefork mode, which
-        means it forks the number of childs processes you give with this
-        parameter, and all child handle connections concurrently. The
-        difference to fork mode is, that the child processes continue to run
-        after a connection has terminated and are able to accept a new
-        connection. This is useful for caching inside the childs process
-        (e.g. DBI::ProxyServer connect_cached attribute)
-
-    *options*
-        Array ref of Command line options that have been passed to the
-        server object via the new method.
-
-    *parent*
-        When creating an object with Clone the original object becomes the
-        parent of the new object. Objects created with new usually don't
-        have a parent, thus this attribute is not set.
-
-    *pidfile* (--pidfile=file)
-        (UNIX only) If this option is present, a PID file will be created at
-        the given location.
-
-    *proto* (--proto=proto)
-        The transport layer to use, by default *tcp* or *unix* for a Unix
-        socket. It is not yet possible to combine both.
-
-    *socket*
-        The socket that is connected to the client; passed as $client
-        argument to the Clone method. If the server object was created with
-        new, this attribute can be undef, as long as the Bind method isn't
-        called. Sockets are assumed to be IO::Socket objects.
-
-    *user* (--user=uid)

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/lib/Net/Daemon.pm -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/lib/Net/Daemon.pm Changed

@@ -1,6 +1,4 @@
-# -*- perl -*-
-#
-#   $Id: Daemon.pm,v 1.3 1999/09/26 14:50:12 joe Exp $
+############################################################################
 #
 #   Net::Daemon - Base class for implementing TCP/IP daemons
 #
@@ -20,40 +18,36 @@
 #
 ############################################################################
 
-require 5.004;
+package Net::Daemon;
+
 use strict;
+use warnings;
 
-use Getopt::Long ();
-use Symbol ();
-use IO::Socket ();
-use Config ();
-use Net::Daemon::Log ();
-use POSIX ();
+use Config;
 
+use Getopt::Long     ();
+use Symbol           ();
+use IO::Socket       ();
+use Net::Daemon::Log ();
+use POSIX            ();
+use File::Spec       ();
 
-package Net::Daemon;
+our $VERSION = '0.49';
+our @ISA = qw(Net::Daemon::Log);
 
-$Net::Daemon::VERSION = '0.48';
+our $RegExpLock = 1;
 
 # Dummy share() in case we're >= 5.10. If we are, require/import of
 # threads::shared will replace it appropriately.
-my $this_is_510 = $^V ge v5.10.0;
-if ($this_is_510) {
+# But ONLY if we are built with threads and forks has not already been loaded.
+my $use_ithreads = ( $^V ge v5.10.0 && $Config{'useithreads'} && !$INC{'forks.pm'} ) ? 1 : 0;
+if ($use_ithreads) {
     eval { require threads; };
     eval { require threads::shared; };
+    threads::shared::share( $RegExpLock ) if $forks::threads; # Assuming this isn't threads masquerading as forks.
 }
 
-
-@Net::Daemon::ISA = qw(Net::Daemon::Log);
-
-#
-#   Regexps aren't thread safe, as of 5.00502 :-( (See the test script
-#   regexp-threads.)
-#
-$Net::Daemon::RegExpLock = 1;
-threads::shared::share(\$Net::Daemon::RegExpLock) if $this_is_510;
-
-use vars qw($exit);
+our $exit;
 
 ############################################################################
 #
@@ -71,69 +65,86 @@
 ############################################################################
 
 sub Options ($) {
-    { 'catchint' => { 'template' => 'catchint!',
-		      'description' => '--nocatchint            '
-		          . "Try to catch interrupts when calling system\n"
-		          . '                        '
-		          . 'functions like bind(), recv()), ...'
-		    },
-      'childs' => { 'template' => 'childs=i',
-		    'description' =>  '--childs <num>          '
-			. 'Set number of preforked childs, implies mode=single.' },
-      'chroot' => { 'template' => 'chroot=s',
-		    'description' =>  '--chroot <dir>          '
-			. 'Change rootdir to given after binding to port.' },
-      'configfile' => { 'template' => 'configfile=s',
-			'description' =>  '--configfile <file>     '
-			    . 'Read options from config file <file>.' },
-      'debug' => { 'template' => 'debug',
-		   'description' =>  '--debug                 '
-		       . 'Turn debugging mode on'},
-      'facility' => { 'template' => 'facility=s',
-		      'description' => '--facility <facility>   '
-			  . 'Syslog facility; defaults to \'daemon\'' },
-      'group' => { 'template' => 'group=s',
-		   'description' => '--group <gid>           '
-		       . 'Change gid to given group after binding to port.' },
-      'help' => { 'template' => 'help',
-		  'description' => '--help                  '
-		      . 'Print this help message' },
-      'localaddr' => { 'template' => 'localaddr=s',
-		       'description' => '--localaddr <ip>        '
-			   . 'IP number to bind to; defaults to INADDR_ANY' },
-      'localpath' => { 'template' => 'localpath=s',
-		       'description' => '--localpath <path>      '
-		           . 'UNIX socket domain path to bind to' },
-      'localport' => { 'template' => 'localport=s',
-		       'description' => '--localport <port>      '
-			   . 'Port number to bind to' },
-      'logfile' => { 'template' => 'logfile=s',
-		     'description' => '--logfile <file>        '
-		         . 'Force logging to <file>' },
-      'loop-child' => { 'template' => 'loop-child',
-		       'description' => '--loop-child            '
-			      . 'Create a child process for loops' },
-      'loop-timeout' => { 'template' => 'loop-timeout=f',
-		       'description' => '--loop-timeout <secs>   '
-			      . 'Looping mode, <secs> seconds per loop' },
-      'mode' => { 'template' => 'mode=s',
-		  'description' => '--mode <mode>           '
-		      . 'Operation mode (threads, fork or single)' },
-      'pidfile' => { 'template' => 'pidfile=s',
-		     'description' => '--pidfile <file>        '
-			 . 'Use <file> as PID file' },
-      'proto' => { 'template' => 'proto=s',
-		   'description' => '--proto <protocol>        '
-		   . 'transport layer protocol: tcp (default) or unix' },
-      'user' => { 'template' => 'user=s',
-		  'description' => '--user <user>           '
-		      . 'Change uid to given user after binding to port.' },
-      'version' => { 'template' => 'version',
-		     'description' => '--version               '
-			 . 'Print version number and exit' } }
+    {
+        'catchint' => {
+            'template'    => 'catchint!',
+            'description' => '--nocatchint            ' . "Try to catch interrupts when calling system\n" . '                        ' . 'functions like bind(), recv()), ...'
+        },
+        'childs' => {
+            'template'    => 'childs=i',
+            'description' => '--childs <num>          ' . 'Set number of preforked childs, implies mode=single.'
+        },
+        'chroot' => {
+            'template'    => 'chroot=s',
+            'description' => '--chroot <dir>          ' . 'Change rootdir to given after binding to port.'
+        },
+        'configfile' => {
+            'template'    => 'configfile=s',
+            'description' => '--configfile <file>     ' . 'Read options from config file <file>.'
+        },
+        'debug' => {
+            'template'    => 'debug',
+            'description' => '--debug                 ' . 'Turn debugging mode on'
+        },
+        'facility' => {
+            'template'    => 'facility=s',
+            'description' => '--facility <facility>   ' . 'Syslog facility; defaults to \'daemon\''
+        },
+        'group' => {
+            'template'    => 'group=s',
+            'description' => '--group <gid>           ' . 'Change gid to given group after binding to port.'
+        },
+        'help' => {
+            'template'    => 'help',
+            'description' => '--help                  ' . 'Print this help message'
+        },
+        'localaddr' => {
+            'template'    => 'localaddr=s',
+            'description' => '--localaddr <ip>        ' . 'IP number to bind to; defaults to INADDR_ANY'
+        },
+        'localpath' => {
+            'template'    => 'localpath=s',
+            'description' => '--localpath <path>      ' . 'UNIX socket domain path to bind to'
+        },
+        'localport' => {
+            'template'    => 'localport=s',
+            'description' => '--localport <port>      ' . 'Port number to bind to'
+        },
+        'logfile' => {
+            'template'    => 'logfile=s',
+            'description' => '--logfile <file>        ' . 'Force logging to <file>'
+        },
+        'loop-child' => {
+            'template'    => 'loop-child',
+            'description' => '--loop-child            ' . 'Create a child process for loops'
+        },
+        'loop-timeout' => {
+            'template'    => 'loop-timeout=f',
+            'description' => '--loop-timeout <secs>   ' . 'Looping mode, <secs> seconds per loop'
+        },
+        'mode' => {
+            'template'    => 'mode=s',
+            'description' => '--mode <mode>           ' . 'Operation mode (threads, fork or single)'
+        },
+        'pidfile' => {
+            'template'    => 'pidfile=s',
+            'description' => '--pidfile <file>        ' . 'Use <file> as PID file'
+        },
+        'proto' => {
+            'template'    => 'proto=s',
+            'description' => '--proto <protocol>        ' . 'transport layer protocol: tcp (default) or unix'
+        },

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/lib/Net/Daemon/Log.pm -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/lib/Net/Daemon/Log.pm Changed

@@ -1,8 +1,6 @@
-# -*- perl -*-
-#
-#   $Id: Log.pm,v 1.3 1999/09/26 14:50:13 joe Exp $
+############################################################################
 #
-#   Net::Daemon - Base class for implementing TCP/IP daemons
+#   Net::Daemon::Log
 #
 #   Copyright (C) 1998, Jochen Wiedmann
 #                       Am Eisteich 9
@@ -20,14 +18,14 @@
 #
 ############################################################################
 
-require 5.004;
 use strict;
-
+use warnings;
 
 package Net::Daemon::Log;
 
-$Net::Daemon::Log::VERSION = '0.01';
+our $VERSION = '0.49';
 
+use Config;
 
 ############################################################################
 #
@@ -42,103 +40,109 @@
 #
 ############################################################################
 
-
 sub OpenLog($) {
     my $self = shift;
     return 1 unless ref($self);
-    return $self->{'logfile'} if defined($self->{'logfile'});
-    if ($Config::Config{'archname'} =~ /win32/i) {
-	require Win32::EventLog;
-	$self->{'eventLog'} = Win32::EventLog->new(ref($self), '')
-	    or die "Cannot open EventLog:" . &Win32::GetLastError();
-	$self->{'$eventId'} = 0;
-    } else {
-	eval { require Sys::Syslog };
-	if ($@) {
-	    die "Cannot open Syslog: $@";
-	}
-	if ($^O ne 'solaris'  &&  $^O ne 'freebsd'  &&
-	    defined(&Sys::Syslog::setlogsock)  &&
-	    eval { &Sys::Syslog::_PATH_LOG() }) {
-	    &Sys::Syslog::setlogsock('unix');
-	}
-	&Sys::Syslog::openlog($self->{'logname'} || ref($self), 'pid',
-			      $self->{'facility'} || 'daemon');
+    return $self->{'logfile'} if defined( $self->{'logfile'} );
+    if ( $Config::Config{'archname'} =~ /win32/i ) {
+        require Win32::EventLog;
+        $self->{'eventLog'} = Win32::EventLog->new( ref($self), '' )
+          or die "Cannot open EventLog:" . Win32::GetLastError();
+        $self->{'$eventId'} = 0;
+    }
+    else {
+        eval { require Sys::Syslog };
+        if ($@) {
+            die "Cannot open Syslog: $@";
+        }
+        if (   $^O ne 'solaris'
+            && $^O ne 'freebsd'
+            && eval { Sys::Syslog::_PATH_LOG() } ) {
+            Sys::Syslog::setlogsock('unix');
+        }
+        Sys::Syslog::openlog(
+            $self->{'logname'} || ref($self), 'pid',
+            $self->{'facility'} || 'daemon'
+        );
     }
     $self->{'logfile'} = 0;
 }
 
 sub Log ($$$;@) {
-    my($self, $level, $format, @args) = @_;
+    my ( $self, $level, $format, @args ) = @_;
     my $logfile = !ref($self) || $self->OpenLog();
 
     my $tid = '';
-    if (ref($self)  &&  $self->{'mode'}) {
-	if ($self->{'mode'} eq 'ithreads') {
-	    if (my $sthread = threads->self()) {
-		$tid = $sthread->tid() . ", ";
-	    }
-	} elsif ($self->{'mode'} eq 'threads') {
-      if (my $sthread = Thread->self()) {
-	  $tid = $sthread->tid() . ", ";
-      }
+    if ( ref($self) && $self->{'mode'} ) {
+        if ( $self->{'mode'} eq 'ithreads' ) {
+            if ( my $sthread = threads->self() ) {
+                $tid = $sthread->tid() . ", ";
+            }
+        }
     }
-    }
     if ($logfile) {
-	my $logtime = $self->LogTime();
-	if (ref($logfile)) {
-	    $logfile->print(sprintf("$logtime $level, $tid$format\n", @args));
-	} else {
-	    printf STDERR ("$logtime $level, $tid$format\n", @args);
-	}
-    } elsif (my $eventLog = $self->{'eventLog'}) {
-	my($type, $category);
-	if ($level eq 'debug') {
-	    $type = Win32::EventLog::EVENTLOG_INFORMATION_TYPE();
-	    $category = 10;
-	} elsif ($level eq 'notice') {
-	    $type = Win32::EventLog::EVENTLOG_INFORMATION_TYPE();
-	    $category = 20;
-	} else {
-	    $type = Win32::EventLog::EVENTLOG_ERROR_TYPE();
-	    $category = 50;
-	}
-	$eventLog->Report({
-	    'Category' => $category,
-	    'EventType' => $type,
-	    'EventID' => ++$self->{'eventId'},
-	    'Strings' => sprintf($format, @args),
-	    'Data' => $tid
-	    });
-    } else {
-	&Sys::Syslog::syslog($level, "$tid$format", @args);
+        my $logtime = $self->LogTime();
+        if ( ref($logfile) ) {
+            $logfile->print( sprintf( "$logtime $level, $tid$format\n", @args ) );
+        }
+        else {
+            printf STDERR ( "$logtime $level, $tid$format\n", @args );
+        }
+    }
+    elsif ( my $eventLog = $self->{'eventLog'} ) {
+        my ( $type, $category );
+        if ( $level eq 'debug' ) {
+            $type     = Win32::EventLog::EVENTLOG_INFORMATION_TYPE();
+            $category = 10;
+        }
+        elsif ( $level eq 'notice' ) {
+            $type     = Win32::EventLog::EVENTLOG_INFORMATION_TYPE();
+            $category = 20;
+        }
+        else {
+            $type     = Win32::EventLog::EVENTLOG_ERROR_TYPE();
+            $category = 50;
+        }
+        $eventLog->Report(
+            {
+                'Category'  => $category,
+                'EventType' => $type,
+                'EventID'   => ++$self->{'eventId'},
+                'Strings'   => sprintf( $format, @args ),
+                'Data'      => $tid
+            }
+        );
+    }
+    else {
+        Sys::Syslog::syslog( $level, "$tid$format", @args );
     }
 }
 
 sub Debug ($$;@) {
     my $self = shift;
-    if (!ref($self)  ||  $self->{'debug'}) {
-	my $fmt = shift;
-	$self->Log('debug', $fmt, @_);
+    if ( !ref($self) || $self->{'debug'} ) {
+        my $fmt = shift;
+        $self->Log( 'debug', $fmt, @_ );
     }
 }
 
 sub Error ($$;@) {
-    my $self = shift; my $fmt = shift;
-    $self->Log('err', $fmt, @_);
+    my $self = shift;
+    my $fmt  = shift;
+    $self->Log( 'err', $fmt, @_ );
 }
 
 sub Fatal ($$;@) {
-    my $self = shift; my $fmt = shift;
-    my $msg = sprintf($fmt, @_);
-    $self->Log('err', $msg);
-    my($package, $filename, $line) = caller();
+    my $self = shift;
+    my $fmt  = shift;
+    my $msg  = sprintf( $fmt, @_ );
+    $self->Log( 'err', $msg );
+    my ( $package, $filename, $line ) = caller();
     die "$msg at $filename line $line.";
 }

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/lib/Net/Daemon/Test.pm -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/lib/Net/Daemon/Test.pm Changed

@@ -1,8 +1,6 @@
-# -*- perl -*-
-#
-#   $Id: Test.pm,v 1.2 1999/08/12 14:28:57 joe Exp $
+############################################################################
 #
-#   Net::Daemon - Base class for implementing TCP/IP daemons
+#   Net::Daemon::Test
 #
 #   Copyright (C) 1998, Jochen Wiedmann
 #                       Am Eisteich 9
@@ -32,16 +30,14 @@
 package Net::Daemon::Test;
 
 use strict;
-require 5.004;
+use warnings;
 
-use Net::Daemon ();
-use Symbol ();
+use Net::Daemon    ();
+use Symbol         ();
 use File::Basename ();
 
-
-$Net::Daemon::Test::VERSION = '0.03';
-@Net::Daemon::Test::ISA = qw(Net::Daemon);
-
+our $VERSION = '0.49';
+our @ISA     = qw(Net::Daemon);
 
 =head1 NAME
 
@@ -56,7 +52,7 @@
     # a subclass of Net::Daemon
     use Net::Daemon::Test ();
     package MyDaemon;
-    @MyDaemon::ISA = qw(Net::Daemon::Test);
+    our @ISA = qw(Net::Daemon::Test);
 
     sub Run {
 	# Overwrite this and other methods, as you like.
@@ -134,18 +130,15 @@
 =cut
 
 sub Options ($) {
-    my $self = shift;
+    my $self    = shift;
     my $options = $self->SUPER::Options();
     $options->{'timeout'} = {
-	'template' => 'timeout=i',
-	'description' => '--timeout <secs>        '
-	    . "The server will die if the test takes longer\n"
-	    . '                        than this number of seconds.'
-	};
+        'template'    => 'timeout=i',
+        'description' => '--timeout <secs>        ' . "The server will die if the test takes longer\n" . '                        than this number of seconds.'
+    };
     $options;
 }
 
-
 =pod
 
 =item Bind
@@ -159,58 +152,66 @@
 =cut
 
 sub Bind ($) {
+
     # First try: Pass unmodified options to Net::Daemon::Bind
     my $self = shift;
-    my($port, $socket);
+    my ( $port, $socket );
     $self->{'proto'} ||= $self->{'localpath'} ? 'unix' : 'tcp';
-    if ($self->{'proto'} eq 'unix') {
-        $port = $self->{'localpath'} || die "Missing option: localpath";
+    if ( $self->{'proto'} eq 'unix' ) {
+        $port   = $self->{'localpath'} || die "Missing option: localpath";
         $socket = eval {
-            IO::Socket::UNIX->new('Local' => $port,
-                                  'Listen' => $self->{'listen'} || 10);
+            IO::Socket::UNIX->new(
+                'Local'  => $port,
+                'Listen' => $self->{'listen'} || 10
+            );
         }
-    } else {
-        my @socket_args =
-	    ( 'LocalAddr' => $self->{'localaddr'},
-	      'LocalPort' => $self->{'localport'},
-	      'Proto' => $self->{'proto'} || 'tcp',
-	      'Listen' => $self->{'listen'} || 10,
-	      'Reuse' => 1
-	    );
+    }
+    else {
+        my @socket_args = (
+            'LocalAddr' => $self->{'localaddr'},
+            'LocalPort' => $self->{'localport'},
+            'Proto'     => $self->{'proto'} || 'tcp',
+            'Listen'    => $self->{'listen'} || 10,
+            'Reuse'     => 1
+        );
         $socket = eval { IO::Socket::INET->new(@socket_args) };
         if ($socket) {
-	    $port = $socket->sockport();
-        } else {
+            $port = $socket->sockport();
+        }
+        else {
             $port = 30049;
-            while (!$socket  &&  $port++ < 30060) {
-	        $socket = eval { IO::Socket::INET->new(@socket_args,
-	       			                       'LocalPort' => $port) };
+            while ( !$socket && $port++ < 30060 ) {
+                $socket = eval {
+                    IO::Socket::INET->new(
+                        @socket_args,
+                        'LocalPort' => $port
+                    );
+                };
             }
         }
     }
-    if (!$socket) {
-	die "Cannot create socket: " . ($@ || $!);
+    if ( !$socket ) {
+        die "Cannot create socket: " . ( $@ || $! );
     }
 
     # Create the "ndtest.prt" file so that the child knows to what
     # port it may connect.
     my $fh = Symbol::gensym();
-    if (!open($fh, ">ndtest.prt")  ||
-	!(print $fh $port)  ||
-	!close($fh)) {
-	die "Error while creating 'ndtest.prt': $!";
+    if (   !open( $fh, ">ndtest.prt" )
+        || !( print $fh $port )
+        || !close($fh) ) {
+        die "Error while creating 'ndtest.prt': $!";
     }
     $self->Debug("Created ndtest.prt with port $port\n");
     $self->{'socket'} = $socket;
 
-    if (my $timeout = $self->{'timeout'}) {
-	eval { alarm $timeout };
+    if ( my $timeout = $self->{'timeout'} ) {
+        eval { alarm $timeout };
     }
 
     $self->SUPER::Bind();
 }
 
-
 =pod
 
 =item Run
@@ -243,97 +244,106 @@
 =cut
 
 sub Child ($$@) {
-    my $self = shift;  my $numTests = shift;
-    my($handle, $pid);
+    my $self     = shift;
+    my $numTests = shift;
+    my ( $handle, $pid );
 
-    my $args = join(" ", @_);
+    my $args = join( " ", @_ );
     print "Starting server: $args\n";
 
     unlink 'ndtest.prt';
 
-    if ($args =~ /\-\-mode=(?:ithread|thread|single)/  &&  $^O =~ /mswin32/i) {
-	require Win32;
-	require Win32::Process;
-	my $proc = $_[0];
-
-	# Win32::Process seems to require an absolute path; this includes
-	# a program extension like ".exe"
-	my $path;
-	my @pdirs;
-
-	File::Basename::fileparse_set_fstype("MSWin32");
-	if (File::Basename::basename($proc) !~ /\./) {
-	    $proc .= ".exe";
-	}
-	if ($proc !~ /^\w\:\\/  &&  $proc !~ /^\\/) {
-	    # Doesn't look like an absolute path
-	    foreach my $dir (@pdirs = split(/;/, $ENV{'PATH'})) {
-		if (-x "$dir/$proc") {
-		    $path = "$dir/$proc";
-		    last;
-		}
-	    }
-	    if (!$path) {
-		print STDERR ("Cannot find $proc in the following"
-			      , " directories:\n");

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/t/base.t -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/t/base.t Changed

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/t/config.t -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/t/config.t Changed

@@ -5,92 +5,109 @@
 require 5.004;
 use strict;
 
-use IO::Socket ();
-use Config ();
+use IO::Socket        ();
+use Config            ();
 use Net::Daemon::Test ();
-use Socket ();
-
+use Socket            ();
 
 my $CONFIG_FILE = "t/config";
-my $numTests = 5;
-
+my $numTests    = 5;
 
 sub RunTest ($$) {
-    my $config = shift;  my $numTests = shift;
+    my $config   = shift;
+    my $numTests = shift;
 
-    if (!open(CF, ">$CONFIG_FILE")  ||  !(print CF $config)  ||  !close(CF)) {
-	die "Error while creating config file $CONFIG_FILE: $!";
+    if ( !open( CF, ">$CONFIG_FILE" ) || !( print CF $config ) || !close(CF) ) {
+        die "Error while creating config file $CONFIG_FILE: $!";
     }
 
-    my($handle, $port) = Net::Daemon::Test->Child
-	($numTests, $^X, '-Iblib/lib', '-Iblib/arch', 't/server', '--debug',
-	 '--mode=single', '--configfile', $CONFIG_FILE);
-    my $fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-				   'PeerPort' => $port);
+    my ( $handle, $port ) = Net::Daemon::Test->Child(
+        $numTests,       $^X,            '-Iblib/lib', '-Iblib/arch', 't/server', '--debug',
+        '--mode=single', '--configfile', $CONFIG_FILE
+    );
+    my $fh = IO::Socket::INET->new(
+        'PeerAddr' => '127.0.0.1',
+        'PeerPort' => $port
+    );
     my $result;
-    my $success = $fh && $fh->print("1\n")  &&
-	defined($result = $fh->getline())  &&  $result =~ /2/;
+    my $success =
+         $fh
+      && $fh->print("1\n")
+      && defined( $result = $fh->getline() )
+      && $result =~ /2/;
     $handle->Terminate();
     $success ? "" : "not ";
 }
 
-
 print "Testing config file with open client list.\n";
-my $ok = RunTest(q/{'mode' => 'single', 'timeout' => 60}/,
-		$numTests);
+my $ok = RunTest(
+    q/{'mode' => 'single', 'timeout' => 60}/,
+    $numTests
+);
 print "${ok}ok 1\n";
 
 print "Testing config file with client 127.0.0.1.\n";
-$ok = RunTest(q/
+$ok = RunTest(
+    q/
     { 'mode' => 'single',
       'timeout' => 60,
       'clients' => [ { 'mask' => '^127\.0\.0\.1$', 'accept' => 1 },
                      { 'mask' => '.*', 'accept' => 0 }
                    ]
-    }/, undef);
+    }/, undef
+);
 print "${ok}ok 2\n";
 
 print "Testing config file with client !127.0.0.1.\n";
-$ok = RunTest(q/
+$ok = RunTest(
+    q/
     { 'mode' => 'single',
       'timeout' => 60,
       'clients' => [ { 'mask' => '^127\.0\.0\.1$', 'accept' => 0 },
                      { 'mask' => '.*', 'accept' => 1 }
                    ]
-    }/, undef);
-print(($ok ? "" : "not "), "ok 3\n");
-
-my $hostname = gethostbyaddr(Socket::inet_aton("127.0.0.1"),
-			   Socket::AF_INET());
+    }/, undef
+);
+print( ( $ok ? "" : "not " ), "ok 3\n" );
+
+my $hostname = gethostbyaddr(
+    Socket::inet_aton("127.0.0.1"),
+    Socket::AF_INET()
+);
 if ($hostname) {
     my $regexp = $hostname;
     $regexp =~ s/\./\\\./g;
     print "Testing config file with client $hostname.\n";
-    $ok = RunTest(q/
+    $ok = RunTest(
+        q/
     { 'mode' => 'single',
       'timeout' => 60,
       'clients' => [ { 'mask' => '^/
- . $regexp . q/$', 'accept' => 1 },
+          . $regexp . q/$', 'accept' => 1 },
                      { 'mask' => '.*', 'accept' => 0 }
                    ]
-    }/, undef);
+    }/, undef
+    );
     print "${ok}ok 4\n";
 
     print "Testing config file with client !$hostname\n";
-    $ok = RunTest(q/
+    $ok = RunTest(
+        q/
     { 'mode' => 'single',
       'timeout' => 60,
       'clients' => [ { 'mask' => '^/
- . $regexp . q/$', 'accept' => 0 },
+          . $regexp . q/$', 'accept' => 0 },
                      { 'mask' => '.*', 'accept' => 1 }
                    ]
-    }/, undef);
-    print(($ok ? "" : "not "), "ok 5\n");    
-} else {
+    }/, undef
+    );
+    print( ( $ok ? "" : "not " ), "ok 5\n" );
+}
+else {
     print "ok 4 # skip\n";
     print "ok 5 # skip\n";
 }
 
 END {
-    if (-f "ndtest.prt") { unlink "ndtest.prt" }
+    if ( -f "ndtest.prt" ) { unlink "ndtest.prt" }
 }

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/t/fork.t -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/t/fork.t Changed

@@ -5,77 +5,81 @@
 
 require 5.004;
 use strict;
-use IO::Socket ();
-use Config ();
+use IO::Socket        ();
+use Config            ();
 use Net::Daemon::Test ();
 
 my $ok;
 eval {
-  if ($^O ne "MSWin32") {
-    my $pid = fork();
-    if (defined($pid)) {
-      if (!$pid) { exit 0; } # Child
+    if ( $^O ne "MSWin32" ) {
+        my $pid = fork();
+        if ( defined($pid) ) {
+            if ( !$pid ) { exit 0; }    # Child
+        }
+        $ok = 1;
     }
-    $ok = 1;
-  }
 };
-if (!$ok) {
-  print "1..0\n";
-  exit 0;
+if ( !$ok ) {
+    print "1..0 # SKIP This test requires a system with working forks.\n";
+    exit;
 }
 
-
 my $numTests = 5;
 
-
-my($handle, $port);
+my ( $handle, $port );
 if (@ARGV) {
     $port = shift @ARGV;
-} else {
-    ($handle, $port) = Net::Daemon::Test->Child($numTests,
-						$^X, '-Iblib/lib',
-						'-Iblib/arch',
-						't/server', '--mode=fork',
-						'--debug', '--timeout', 60);
+}
+else {
+    ( $handle, $port ) = Net::Daemon::Test->Child(
+        $numTests,
+        $^X, '-Iblib/lib',
+        '-Iblib/arch',
+        't/server', '--mode=fork',
+        '--debug', '--timeout', 60
+    );
 }
 
 print "Making first connection to port $port...\n";
-my $fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-			       'PeerPort' => $port);
-printf("%s 1\n", $fh ? "ok" : "not ok");
-printf("%s 2\n", $fh->close() ? "ok" : "not ok");
+my $fh = IO::Socket::INET->new(
+    'PeerAddr' => '127.0.0.1',
+    'PeerPort' => $port
+);
+printf( "%s 1\n", $fh          ? "ok" : "not ok" );
+printf( "%s 2\n", $fh->close() ? "ok" : "not ok" );
 print "Making second connection to port $port...\n";
-$fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-			    'PeerPort' => $port);
-printf("%s 3\n", $fh ? "ok" : "not ok");
+$fh = IO::Socket::INET->new(
+    'PeerAddr' => '127.0.0.1',
+    'PeerPort' => $port
+);
+printf( "%s 3\n", $fh ? "ok" : "not ok" );
 eval {
-    for (my $i = 0;  $i < 20;  $i++) {
-	print "Writing number: $i\n";
-	if (!$fh->print("$i\n")  ||  !$fh->flush()) {
-	    die "Client: Error while writing number $i: " . $fh->error()
-		. " ($!)";
-	}
-	print "Written.\n";
-	my($line) = $fh->getline();
-	if (!defined($line)) {
-	    die "Client: Error while reading number $i: " . $fh->error()
-		. " ($!)";
-	}
-	if ($line !~ /(\d+)/  ||  $1 != $i*2) {
-	    die "Wrong response, exptected " . ($i*2) . ", got $line";
-	}
+    for ( my $i = 0; $i < 20; $i++ ) {
+        print "Writing number: $i\n";
+        if ( !$fh->print("$i\n") || !$fh->flush() ) {
+            die "Client: Error while writing number $i: " . $fh->error() . " ($!)";
+        }
+        print "Written.\n";
+        my ($line) = $fh->getline();
+        if ( !defined($line) ) {
+            die "Client: Error while reading number $i: " . $fh->error() . " ($!)";
+        }
+        if ( $line !~ /(\d+)/ || $1 != $i * 2 ) {
+            die "Wrong response, exptected " . ( $i * 2 ) . ", got $line";
+        }
     }
 };
 if ($@) {
     print STDERR "$@\n";
     print "not ok 4\n";
-} else {
+}
+else {
     print "ok 4\n";
 }
-printf("%s 5\n", $fh->close() ? "ok" : "not ok");
+printf( "%s 5\n", $fh->close() ? "ok" : "not ok" );
 
 END {
-    if ($handle) { $handle->Terminate() }
-    if (-f "ndtest.prt") { unlink "ndtest.prt" }
+    if ($handle)           { $handle->Terminate() }
+    if ( -f "ndtest.prt" ) { unlink "ndtest.prt" }
     exit 0;
 }

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/t/forkm.t -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/t/forkm.t Changed

@@ -3,198 +3,205 @@
 
 require 5.004;
 use strict;
-use IO::Socket ();
-use Config ();
+use IO::Socket        ();
+use Config            ();
 use Net::Daemon::Test ();
-use Fcntl ();
-use Config ();
+use Fcntl             ();
+use Config            ();
 use POSIX qw/WNOHANG/;
 
 my $debug = 0;
 my $dh;
 if ($debug) {
     $dh = Symbol::gensym();
-    open($dh, ">", "forkm.log") or die "Failed to open forkm.log: $!";
+    open( $dh, ">", "forkm.log" ) or die "Failed to open forkm.log: $!";
 }
 
-sub log($) {
+sub DEBUG {
     my $msg = shift;
     print $dh "$$: $msg\n" if $dh;
 }
 
-&log("Start");
+DEBUG("Start");
 my $ok;
 eval {
-  if ($^O ne "MSWin32") {
-    my $pid = fork();
-    if (defined($pid)) {
-      if (!$pid) { exit 0; } # Child
-    }
-    wait;
-    $ok = 1;
-  }
+    if ( $^O ne "MSWin32" ) {
+        my $pid = fork();
+        if ( defined($pid) ) {
+            if ( !$pid ) { exit 0; }    # Child
+        }
+        wait;
+        $ok = 1;
+    }
 };
-if (!$ok) {
-  &log("!ok");
-  print "1..0\n";
-  exit;
+if ( !$ok ) {
+    DEBUG("!ok");
+    print "1..0 # SKIP This test requires a system with working forks.\n";
+    exit;
 }
 
-
-$| = 1;
+$|  = 1;
 $^W = 1;
 
-
-my($handle, $port);
+my ( $handle, $port );
 if (@ARGV) {
     $port = shift @ARGV;
-} else {
-    ($handle, $port) = Net::Daemon::Test->Child
-	(10, $^X, '-Iblib/lib', '-Iblib/arch', 't/server',
-	 '--mode=fork', 'logfile=stderr', 'debug');
 }
-
+else {
+    ( $handle, $port ) = Net::Daemon::Test->Child(
+        10,            $^X,              '-Iblib/lib', '-Iblib/arch', 't/server',
+        '--mode=fork', 'logfile=stderr', 'debug'
+    );
+}
 
 sub IsNum {
     my $str = shift;
-    (defined($str)  &&  $str =~ /(\d+)/) ? $1 : undef;
+    ( defined($str) && $str =~ /(\d+)/ ) ? $1 : undef;
 }
 
-
 sub ReadWrite {
-    my $fh = shift; my $i = shift; my $j = shift;
-    &log("ReadWrite: -> fh=$fh, i=$i, j=$j");
-    if (!$fh->print("$j\n")  ||  !$fh->flush()) {
-	die "Child $i: Error while writing $j: " . $fh->error() . " ($!)";
+    my $fh = shift;
+    my $i  = shift;
+    my $j  = shift;
+    DEBUG("ReadWrite: -> fh=$fh, i=$i, j=$j");
+    if ( !$fh->print("$j\n") || !$fh->flush() ) {
+        die "Child $i: Error while writing $j: " . $fh->error() . " ($!)";
     }
     my $line = $fh->getline();
-    &log("ReadWrite: line=$line");
+    DEBUG("ReadWrite: line=$line");
     die "Child $i: Error while reading: " . $fh->error() . " ($!)"
-	unless defined($line);
+      unless defined($line);
     my $num;
     die "Child $i: Cannot parse result: $line"
-	unless defined($num = IsNum($line));
-    die "Child $i: Expected " . ($j*2) . ", got $num"
-	unless $j*2 == $num;
-    &log("ReadWrite: <-");
+      unless defined( $num = IsNum($line) );
+    die "Child $i: Expected " . ( $j * 2 ) . ", got $num"
+      unless $j * 2 == $num;
+    DEBUG("ReadWrite: <-");
 }
 
-
 sub MyChild {
     my $i = shift;
 
-    &log("MyChild: -> $i");
+    DEBUG("MyChild: -> $i");
 
     eval {
-	my $fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-				       'PeerPort' => $port);
-	if (!$fh) {
-	    &log("MyChild: Cannot connect: $!");
-	    die "Cannot connect: $!";
-	}
-	for (my $j = 0;  $j < 1000;  $j++) {
-	    ReadWrite($fh, $i, $j);
-	}
+        my $fh = IO::Socket::INET->new(
+            'PeerAddr' => '127.0.0.1',
+            'PeerPort' => $port
+        );
+        if ( !$fh ) {
+            DEBUG("MyChild: Cannot connect: $!");
+            die "Cannot connect: $!";
+        }
+        for ( my $j = 0; $j < 1000; $j++ ) {
+            ReadWrite( $fh, $i, $j );
+        }
     };
     if ($@) {
-	print STDERR "Client: Error $@\n";
-	&log("MyChild: Client: Error $@");
-	return 0;
+        print STDERR "Client: Error $@\n";
+        DEBUG("MyChild: Client: Error $@");
+        return 0;
     }
-    &log("MyChild: <-");
+    DEBUG("MyChild: <-");
     return 1;
 }
 
-
 sub ShowResults {
-    &log("ShowResults: ->");
+    DEBUG("ShowResults: ->");
     my @results;
-    for (my $i = 1;  $i <= 10;  $i++) {
-	$results[$i-1] = "not ok $i\n";
+    for ( my $i = 1; $i <= 10; $i++ ) {
+        $results[ $i - 1 ] = "not ok $i\n";
     }
-    if (open(LOG, "<log")) {
-	while (defined(my $line = <LOG>)) {
-	    if ($line =~ /(\d+)/) {
-		$results[$1-1] = $line;
-	    }
-	}
+    if ( open( LOG, "<log" ) ) {
+        while ( defined( my $line = <LOG> ) ) {
+            if ( $line =~ /(\d+)/ ) {
+                $results[ $1 - 1 ] = $line;
+            }
+        }
     }
-    for (my $i = 1;  $i <= 10;  $i++) {
-	print $results[$i-1];
+    for ( my $i = 1; $i <= 10; $i++ ) {
+        print $results[ $i - 1 ];
     }
-    &log("ShowResults: <-");
+    DEBUG("ShowResults: <-");
     exit 0;
 }
 
 my %childs;
+
 sub CatchChild {
-    &log("CatchChild: ->");
-    for(;;) {

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/t/ithread.t -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/t/ithread.t Changed

@@ -1,59 +1,62 @@
-# -*- perl -*-
-#
-#   $Id: thread.t,v 1.2 1999/08/12 14:28:59 joe Exp $
-#
-
-require 5.004;
-use strict;
-
-use IO::Socket ();
-use Config ();
-use Net::Daemon::Test ();
-
-my $numTests = 5;
-
-
-# Check whether threads are available, otherwise skip this test.
-
-if (!eval { require threads; my $t = threads->new(sub { }) }) {
-    print "1..0\n";
-    exit 0;
-}
-
-my($handle, $port) = Net::Daemon::Test->Child
-    ($numTests, $^X, 't/server', '--timeout', 20, '--mode=ithreads');
-
-
-print "Making first connection to port $port...\n";
-my $fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-			       'PeerPort' => $port);
-printf("%s 1\n", $fh ? "ok" : "not ok");
-printf("%s 2\n", $fh->close() ? "ok" : "not ok");
-print "Making second connection to port $port...\n";
-$fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-			    'PeerPort' => $port);
-printf("%s 3\n", $fh ? "ok" : "not ok");
-eval {
-    for (my $i = 0;  $i < 20;  $i++) {
-	if (!$fh->print("$i\n")  ||  !$fh->flush()) {
-	    die "Error while writing $i: " . $fh->error() . " ($!)";
-	}
-	my $line = $fh->getline();
-	die "Error while reading $i: " . $fh->error() . " ($!)"
-	    unless defined($line);
-	die "Result error: Expected " . ($i*2) . ", got $line"
-	    unless ($line =~ /(\d+)/  &&  $1 == $i*2);
-    }
-};
-if ($@) {
-    print STDERR "$@\n";
-    print "not ok 4\n";
-} else {
-    print "ok 4\n";
-}
-printf("%s 5\n", $fh->close() ? "ok" : "not ok");
-
-END {
-    if ($handle) { $handle->Terminate() }
-    if (-f "ndtest.prt") { unlink "ndtest.prt" }
-}
+# -*- perl -*-
+#
+#   $Id: thread.t,v 1.2 1999/08/12 14:28:59 joe Exp $
+#
+
+require 5.004;
+use strict;
+
+use Config;
+use IO::Socket        ();
+use Net::Daemon::Test ();
+
+my $numTests = 5;
+
+# Check whether threads are available, otherwise skip this test.
+
+if ( !$Config{useithreads} ) {
+    print "1..0 # SKIP This test requires a perl with working ithreads.\n";
+    exit 0;
+}
+require threads;
+
+my ( $handle, $port ) = Net::Daemon::Test->Child( $numTests, $^X, 't/server', '--timeout', 20, '--mode=ithreads' );
+
+print "Making first connection to port $port...\n";
+my $fh = IO::Socket::INET->new(
+    'PeerAddr' => '127.0.0.1',
+    'PeerPort' => $port
+);
+printf( "%s 1\n", $fh          ? "ok" : "not ok" );
+printf( "%s 2\n", $fh->close() ? "ok" : "not ok" );
+print "Making second connection to port $port...\n";
+$fh = IO::Socket::INET->new(
+    'PeerAddr' => '127.0.0.1',
+    'PeerPort' => $port
+);
+printf( "%s 3\n", $fh ? "ok" : "not ok" );
+eval {
+    for ( my $i = 0; $i < 20; $i++ ) {
+        if ( !$fh->print("$i\n") || !$fh->flush() ) {
+            die "Error while writing $i: " . $fh->error() . " ($!)";
+        }
+        my $line = $fh->getline();
+        die "Error while reading $i: " . $fh->error() . " ($!)"
+          unless defined($line);
+        die "Result error: Expected " . ( $i * 2 ) . ", got $line"
+          unless ( $line =~ /(\d+)/ && $1 == $i * 2 );
+    }
+};
+if ($@) {
+    print STDERR "$@\n";
+    print "not ok 4\n";
+}
+else {
+    print "ok 4\n";
+}
+printf( "%s 5\n", $fh->close() ? "ok" : "not ok" );
+
+END {
+    if ($handle)           { $handle->Terminate() }
+    if ( -f "ndtest.prt" ) { unlink "ndtest.prt" }
+}

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/t/ithreadm.t -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/t/ithreadm.t Changed

@@ -1,104 +1,111 @@
-# -*- perl -*-
-#
-#   $Id: threadm.t,v 1.2 1999/08/12 14:28:59 joe Exp $
-#
-
-require 5.004;
-use strict;
-
-use IO::Socket ();
-use Config ();
-use Net::Daemon::Test ();
-use Fcntl ();
-use Config ();
-
-
-$| = 1;
-$^W = 1;
-
-
-if (!eval { require threads }) {
-    print "1..0\n";
-    exit 0;
-}
-
-
-my($handle, $port);
-if (@ARGV) {
-    $port = shift @ARGV;
-} else {
-    ($handle, $port) = Net::Daemon::Test->Child
-	(10, $^X, '-Iblib/lib', '-Iblib/arch', 't/server',
-	 '--mode=ithreads', 'logfile=stderr', 'debug');
-}
-
-
-sub IsNum {
-    my $str = shift;
-    (defined($str)  &&  $str =~ /(\d+)/) ? $1 : undef;
-}
-
-
-sub ReadWrite {
-    my $fh = shift; my $i = shift; my $j = shift;
-    die "Child $i: Error while writing $j: $!"
-	unless $fh->print("$j\n") and $fh->flush();
-    my $line = $fh->getline();
-    die "Child $i: Error while reading: " . $fh->error() . " ($!)"
-	unless defined($line);
-    my $num = IsNum($line);
-    die "Child $i: Cannot parse result: $line"
-	unless defined($num);
-    die "Child $i: Expected " . ($j*2) . ", got $num"
-	unless ($num == $j*2);
-}
-
-
-sub MyChild {
-    my $i = shift;
-
-    eval {
-	my $fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-				       'PeerPort' => $port);
-	die "Cannot connect: $!" unless defined($fh);
-	for (my $j = 0;  $j < 1000;  $j++) {
-	    ReadWrite($fh, $i, $j);
-	}
-    };
-    if ($@) {
-	print STDERR $@;
-	return 0;
-    }
-    return 1;
-}
-
-
-my @threads;
-for (my $i = 0;  $i < 10;  $i++) {
-    #print "Spawning child $i.\n";
-    my $tid = threads->new(\&MyChild, $i);
-    if (!$tid) {
-	print STDERR "Failed to create new thread: $!\n";
-	exit 1;
-    }
-    push(@threads, $tid);
-}
-eval { alarm 1; alarm 0 };
-alarm 120 unless $@;
-for (my $i = 1;  $i <= 10;  $i++) {
-    my $tid = shift @threads;
-    if ($tid->join()) {
-	print "ok $i\n";
-    } else {
-	print "not ok $i\n";
-    }
-}
-
-END {
-    if ($handle) {
-	print "Terminating server.\n";
-	$handle->Terminate();
-	undef $handle;
-    }
-    unlink "ndtest.prt";
-}
+#!perl
+
+use strict;
+use warnings;
+
+use IO::Socket        ();
+use Config            ();
+use Net::Daemon::Test ();
+use Fcntl             ();
+
+use Config;
+
+$|  = 1;
+$^W = 1;
+
+if ( !$Config{useithreads} ) {
+    print "1..0 # SKIP This test requires a perl with working ithreads.\n";
+    exit 0;
+}
+
+if ( $^O eq "MSWin32" ) {
+   print  "1..0 # SKIP This test is failing on windows I think due to Win32-Process but it needs help right now.\n";
+   exit 0;
+}
+
+require threads;
+
+my ( $handle, $port );
+if (@ARGV) {
+    $port = shift @ARGV;
+}
+else {
+    ( $handle, $port ) = Net::Daemon::Test->Child(
+        10,                $^X,              '-Iblib/lib', '-Iblib/arch', 't/server',
+        '--mode=ithreads', 'logfile=stderr', 'debug'
+    );
+}
+
+sub IsNum {
+    my $str = shift;
+    ( defined($str) && $str =~ /(\d+)/ ) ? $1 : undef;
+}
+
+sub ReadWrite {
+    my $fh = shift;
+    my $i  = shift;
+    my $j  = shift;
+    die "Child $i: Error while writing $j: $!"
+      unless $fh->print("$j\n")
+      and $fh->flush();
+    my $line = $fh->getline();
+    die "Child $i: Error while reading: " . $fh->error() . " ($!)"
+      unless defined($line);
+    my $num = IsNum($line);
+    die "Child $i: Cannot parse result: $line"
+      unless defined($num);
+    die "Child $i: Expected " . ( $j * 2 ) . ", got $num"
+      unless ( $num == $j * 2 );
+}
+
+sub MyChild {
+    my $i = shift;
+
+    eval {
+        my $fh = IO::Socket::INET->new(
+            'PeerAddr' => '127.0.0.1',
+            'PeerPort' => $port
+        );
+        die "Cannot connect: $!" unless defined($fh);
+        for ( my $j = 0; $j < 1000; $j++ ) {
+            ReadWrite( $fh, $i, $j );
+        }
+    };
+    if ($@) {
+        print STDERR $@;
+        return 0;
+    }
+    return 1;
+}
+
+my @threads;
+for ( my $i = 0; $i < 10; $i++ ) {
+
+    #print "Spawning child $i.\n";
+    my $tid = threads->new( \&MyChild, $i );
+    if ( !$tid ) {
+        print STDERR "Failed to create new thread: $!\n";
+        exit 1;
+    }
+    push( @threads, $tid );
+}
+eval { alarm 1; alarm 0 };
+alarm 120 unless $@;
+for ( my $i = 1; $i <= 10; $i++ ) {
+    my $tid = shift @threads;

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/t/loop-child.t -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/t/loop-child.t Changed

@@ -6,59 +6,64 @@
 require 5.004;
 use strict;
 
-use IO::Socket ();
-use Config ();
+use IO::Socket        ();
+use Config            ();
 use Net::Daemon::Test ();
 
 my $numTests = 6;
 
-
-my($handle, $port);
+my ( $handle, $port );
 if (@ARGV) {
     $port = shift;
-} else {
-    ($handle, $port) =
-	Net::Daemon::Test->Child($numTests,
-				 $^X, '-Iblib/lib', '-Iblib/arch',
-				 't/server', '--mode=single',
-				 '--loop-timeout=2', '--loop-child',
-				 '--debug', '--timeout', 60);    
+}
+else {
+    ( $handle, $port ) = Net::Daemon::Test->Child(
+        $numTests,
+        $^X,                '-Iblib/lib', '-Iblib/arch',
+        't/server',         '--mode=single',
+        '--loop-timeout=2', '--loop-child',
+        '--debug',          '--timeout',  60
+    );
 }
 
 print "Making first connection to port $port...\n";
-my $fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-			       'PeerPort' => $port);
-printf("%s 1\n", $fh ? "ok" : "not ok");
-printf("%s 2\n", $fh->close() ? "ok" : "not ok");
+my $fh = IO::Socket::INET->new(
+    'PeerAddr' => '127.0.0.1',
+    'PeerPort' => $port
+);
+printf( "%s 1\n", $fh          ? "ok" : "not ok" );
+printf( "%s 2\n", $fh->close() ? "ok" : "not ok" );
 print "Making second connection to port $port...\n";
-$fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-			    'PeerPort' => $port);
-printf("%s 3\n", $fh ? "ok" : "not ok");
-my($ok) = $fh ? 1 : 0;
-for (my $i = 0;  $ok  &&  $i < 20;  $i++) {
+$fh = IO::Socket::INET->new(
+    'PeerAddr' => '127.0.0.1',
+    'PeerPort' => $port
+);
+printf( "%s 3\n", $fh ? "ok" : "not ok" );
+my ($ok) = $fh ? 1 : 0;
+for ( my $i = 0; $ok && $i < 20; $i++ ) {
     print "Writing number: $i\n";
-    if (!$fh->print("$i\n")  ||  !$fh->flush()) { $ok = 0; last; }
+    if ( !$fh->print("$i\n") || !$fh->flush() ) { $ok = 0; last; }
     print "Written.\n";
-    my($line) = $fh->getline();
-    print "line = ", (defined($line) ? $line : "undef"), "\n";
-    if (!defined($line)) { $ok = 0;  last; }
-    if ($line !~ /(\d+)/  ||  $1 != $i*2) { $ok = 0;  last; }
+    my ($line) = $fh->getline();
+    print "line = ", ( defined($line) ? $line : "undef" ), "\n";
+    if ( !defined($line) ) { $ok = 0; last; }
+    if ( $line !~ /(\d+)/ || $1 != $i * 2 ) { $ok = 0; last; }
 }
-printf("%s 4\n", $ok ? "ok" : "not ok");
-printf("%s 5\n", $fh->close() ? "ok" : "not ok");
+printf( "%s 4\n", $ok          ? "ok" : "not ok" );
+printf( "%s 5\n", $fh->close() ? "ok" : "not ok" );
 
 $ok = 0;
-for (my $i = 0;  $i < 30;  $i++) {
+for ( my $i = 0; $i < 30; $i++ ) {
     my $num;
-    if (open(CNT, "<ndtest.cnt") and
-	defined($num = <CNT>)  and
-	$num eq "10\n") {
-	$ok = 1;
-	last;
+    if (    open( CNT, "<ndtest.cnt" )
+        and defined( $num = <CNT> )
+        and $num eq "10\n" ) {
+        $ok = 1;
+        last;
     }
     sleep 1;
 }
-printf("%s 6\n", $ok ? "ok" : "not ok");
+printf( "%s 6\n", $ok ? "ok" : "not ok" );
 
 END {
     if ($handle) { $handle->Terminate() }

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/t/loop.t -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/t/loop.t Changed

@@ -6,53 +6,58 @@
 require 5.004;
 use strict;
 
-use IO::Socket ();
-use Config ();
+use IO::Socket        ();
+use Config            ();
 use Net::Daemon::Test ();
 
 my $numTests = 6;
 
-
-my($handle, $port) = Net::Daemon::Test->Child($numTests,
-					      $^X, '-Iblib/lib', '-Iblib/arch',
-					      't/server', '--mode=single',
-					      '--loop-timeout=2',
-					      '--timeout', 60);
+my ( $handle, $port ) = Net::Daemon::Test->Child(
+    $numTests,
+    $^X,        '-Iblib/lib', '-Iblib/arch',
+    't/server', '--mode=single',
+    '--loop-timeout=2',
+    '--timeout', 60
+);
 
 print "Making first connection to port $port...\n";
-my $fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-			       'PeerPort' => $port);
-printf("%s 1\n", $fh ? "ok" : "not ok");
-printf("%s 2\n", $fh->close() ? "ok" : "not ok");
+my $fh = IO::Socket::INET->new(
+    'PeerAddr' => '127.0.0.1',
+    'PeerPort' => $port
+);
+printf( "%s 1\n", $fh          ? "ok" : "not ok" );
+printf( "%s 2\n", $fh->close() ? "ok" : "not ok" );
 print "Making second connection to port $port...\n";
-$fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-			    'PeerPort' => $port);
-printf("%s 3\n", $fh ? "ok" : "not ok");
-my($ok) = $fh ? 1 : 0;
-for (my $i = 0;  $ok  &&  $i < 20;  $i++) {
+$fh = IO::Socket::INET->new(
+    'PeerAddr' => '127.0.0.1',
+    'PeerPort' => $port
+);
+printf( "%s 3\n", $fh ? "ok" : "not ok" );
+my ($ok) = $fh ? 1 : 0;
+for ( my $i = 0; $ok && $i < 20; $i++ ) {
     print "Writing number: $i\n";
-    if (!$fh->print("$i\n")  ||  !$fh->flush()) { $ok = 0; last; }
+    if ( !$fh->print("$i\n") || !$fh->flush() ) { $ok = 0; last; }
     print "Written.\n";
-    my($line) = $fh->getline();
-    print "line = ", (defined($line) ? $line : "undef"), "\n";
-    if (!defined($line)) { $ok = 0;  last; }
-    if ($line !~ /(\d+)/  ||  $1 != $i*2) { $ok = 0;  last; }
+    my ($line) = $fh->getline();
+    print "line = ", ( defined($line) ? $line : "undef" ), "\n";
+    if ( !defined($line) ) { $ok = 0; last; }
+    if ( $line !~ /(\d+)/ || $1 != $i * 2 ) { $ok = 0; last; }
 }
-printf("%s 4\n", $ok ? "ok" : "not ok");
-printf("%s 5\n", $fh->close() ? "ok" : "not ok");
+printf( "%s 4\n", $ok          ? "ok" : "not ok" );
+printf( "%s 5\n", $fh->close() ? "ok" : "not ok" );
 
 $ok = 0;
-for (my $i = 0;  $i < 30;  $i++) {
+for ( my $i = 0; $i < 30; $i++ ) {
     my $num;
-    if (open(CNT, "<ndtest.cnt") and
-	defined($num = <CNT>)  and
-	$num eq "10\n") {
-	$ok = 1;
-	last;
+    if (    open( CNT, "<ndtest.cnt" )
+        and defined( $num = <CNT> )
+        and $num eq "10\n" ) {
+        $ok = 1;
+        last;
     }
     sleep 1;
 }
-printf("%s 6\n", $ok ? "ok" : "not ok");
+printf( "%s 6\n", $ok ? "ok" : "not ok" );
 
 END {
     if ($handle) { $handle->Terminate() }

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/t/server -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/t/server Changed

@@ -12,19 +12,15 @@
 
 use lib qw(blib/arch blib/lib);
 
-
 $| = 1;
 
 use Net::Daemon::Test ();
-use IO::Socket ();
+use IO::Socket        ();
 
 package Multiplier;
 
-use vars qw($VERSION @ISA);
-
-$VERSION = '0.01';
-@ISA = qw(Net::Daemon::Test);
-
+our $VERSION = '0.01';
+our @ISA     = qw(Net::Daemon::Test);
 
 sub Version ($) {
     return "Multiplier - A simple network calculator; 1998, Jochen Wiedmann";
@@ -42,65 +38,64 @@
 
 sub Loop {
     my $self = shift;
-    if ($self->{'loop-timeout'}) {
-	my $count = $self->{'loop-count'} || 0;
-	if (($self->{'loop-count'} = ++$count) == 10) {
-	    $self->Done();
-	    open(COUNT, ">ndtest.cnt");
-	    print COUNT "10\n";
-	    close(COUNT);
-	}
+    if ( $self->{'loop-timeout'} ) {
+        my $count = $self->{'loop-count'} || 0;
+        if ( ( $self->{'loop-count'} = ++$count ) == 10 ) {
+            $self->Done();
+            open( COUNT, ">ndtest.cnt" );
+            print COUNT "10\n";
+            close(COUNT);
+        }
     }
 }
 
 sub Run ($) {
     my $self = shift;
     sleep 1 if $self->{'mode'} eq "fork";
-      # Waiting one second sometimes helps the parent to catch
-      # children nicely, if they die immediately
-    my($line, $sock);
+
+    # Waiting one second sometimes helps the parent to catch
+    # children nicely, if they die immediately
+    my ( $line, $sock );
     $sock = $self->{'socket'};
     eval {
-	while (1) {
-	    if (!defined($line = GetLine($sock))) {
-		if ($sock->error()) {
-		    die "Client connection error " . $sock->error() . " ($!)";
-		}
-		last;
-	    }
-	    my $num;
-	    {
-		my $lock = lock($Net::Daemon::RegExpLock)
-		    if ($self->{'mode'} eq 'threads');
-		if ($line =~ /(\d+)/) {
-		    $num = $1;
-		}
-	    }
-	    if (defined($num)) {
-		if (!Print($sock, $num*2, "\n")) {
-		    die "Client connection error " . $sock->error() .
-			" ($!) while writing.";
-		}
-	    } else {
-		die "Server cannot parse input: $line";
-	    }
-	}
+        while (1) {
+            if ( !defined( $line = GetLine($sock) ) ) {
+                if ( $sock->error() ) {
+                    die "Client connection error " . $sock->error() . " ($!)";
+                }
+                last;
+            }
+            my $num;
+            {
+                my $lock = lock($Net::Daemon::RegExpLock)
+                  if ( $self->{'mode'} eq 'threads' );
+                if ( $line =~ /(\d+)/ ) {
+                    $num = $1;
+                }
+            }
+            if ( defined($num) ) {
+                if ( !Print( $sock, $num * 2, "\n" ) ) {
+                    die "Client connection error " . $sock->error() . " ($!) while writing.";
+                }
+            }
+            else {
+                die "Server cannot parse input: $line";
+            }
+        }
     };
     if ($@) {
-	print STDERR "$@\n";
-	$self->Error($@);
+        print STDERR "$@\n";
+        $self->Error($@);
     }
     $sock->close();
 }
 
-
 package main;
 
-my $server = Multiplier->new({ 'pidfile' => 'none'
-			       }, \@ARGV);
+my $server = Multiplier->new( { 'pidfile' => 'none' }, \@ARGV );
 
 eval { $server->Bind() };
 print STDERR "Unexpected return from Bind().\n"
-    if (!$server->Done());
+  if ( !$server->Done() );
 
 print STDERR "Server died: $@\n" if $@;

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/t/single.t -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/t/single.t Changed

@@ -6,47 +6,52 @@
 require 5.004;
 use strict;
 
-use IO::Socket ();
-use Config ();
+use IO::Socket        ();
+use Config            ();
 use Net::Daemon::Test ();
 
 my $numTests = 5;
 
-
-my($handle, $port);
+my ( $handle, $port );
 if (@ARGV) {
     $port = shift @ARGV;
-} else {
-    ($handle, $port) =
-	Net::Daemon::Test->Child($numTests,
-					      $^X, '-Iblib/lib', '-Iblib/arch',
-					      't/server', '--mode=single',
-					      '--timeout', 60);
+}
+else {
+    ( $handle, $port ) = Net::Daemon::Test->Child(
+        $numTests,
+        $^X,         '-Iblib/lib', '-Iblib/arch',
+        't/server',  '--mode=single',
+        '--timeout', 60
+    );
 }
 
 print "Making first connection to port $port...\n";
-my $fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-			       'PeerPort' => $port);
-printf("%s 1\n", $fh ? "ok" : "not ok");
-printf("%s 2\n", $fh->close() ? "ok" : "not ok");
+my $fh = IO::Socket::INET->new(
+    'PeerAddr' => '127.0.0.1',
+    'PeerPort' => $port
+);
+printf( "%s 1\n", $fh          ? "ok" : "not ok" );
+printf( "%s 2\n", $fh->close() ? "ok" : "not ok" );
 print "Making second connection to port $port...\n";
-$fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
-			    'PeerPort' => $port);
-printf("%s 3\n", $fh ? "ok" : "not ok");
-my($ok) = $fh ? 1 : 0;
-for (my $i = 0;  $ok  &&  $i < 20;  $i++) {
+$fh = IO::Socket::INET->new(
+    'PeerAddr' => '127.0.0.1',
+    'PeerPort' => $port
+);
+printf( "%s 3\n", $fh ? "ok" : "not ok" );
+my ($ok) = $fh ? 1 : 0;
+for ( my $i = 0; $ok && $i < 20; $i++ ) {
     print "Writing number: $i\n";
-    if (!$fh->print("$i\n")  ||  !$fh->flush()) { $ok = 0; last; }
+    if ( !$fh->print("$i\n") || !$fh->flush() ) { $ok = 0; last; }
     print "Written.\n";
-    my($line) = $fh->getline();
-    print "line = ", (defined($line) ? $line : "undef"), "\n";
-    if (!defined($line)) { $ok = 0;  last; }
-    if ($line !~ /(\d+)/  ||  $1 != $i*2) { $ok = 0;  last; }
+    my ($line) = $fh->getline();
+    print "line = ", ( defined($line) ? $line : "undef" ), "\n";
+    if ( !defined($line) ) { $ok = 0; last; }
+    if ( $line !~ /(\d+)/ || $1 != $i * 2 ) { $ok = 0; last; }
 }
-printf("%s 4\n", $ok ? "ok" : "not ok");
-printf("%s 5\n", $fh->close() ? "ok" : "not ok");
+printf( "%s 4\n", $ok          ? "ok" : "not ok" );
+printf( "%s 5\n", $fh->close() ? "ok" : "not ok" );
 
 END {
-    if ($handle) { $handle->Terminate() }
-    if (-f "ndtest.prt") { unlink "ndtest.prt" }
+    if ($handle)           { $handle->Terminate() }
+    if ( -f "ndtest.prt" ) { unlink "ndtest.prt" }
 }

_service:tar_scm_kernel_repo:Net-Daemon-0.48.tar.gz/t/unix.t -> _service:tar_scm_kernel_repo:Net-Daemon-0.49.tar.gz/t/unix.t Changed

@@ -6,66 +6,66 @@
 require 5.004;
 use strict;
 
-use IO::Socket ();
-use Config ();
+use IO::Socket        ();
+use Config            ();
 use Net::Daemon::Test ();
 
-if ($^O eq "MSWin32") {
-  print "1..0\n";
-  exit 0;
+if ( $^O eq "MSWin32" ) {
+    print "1..0\n";
+    exit 0;
 }
 
 my $numTests = 5;
 
-
-my($handle, $port) = Net::Daemon::Test->Child($numTests,
-					      $^X, '-Iblib/lib', '-Iblib/arch',
-					      't/server', '--localpath=mysock',
-					      '--mode=fork',
-					      '--timeout', 60);
+my ( $handle, $port ) = Net::Daemon::Test->Child(
+    $numTests,
+    $^X,        '-Iblib/lib', '-Iblib/arch',
+    't/server', '--localpath=mysock',
+    '--mode=fork',
+    '--timeout', 60
+);
 
 print "Making first connection to port $port...\n";
-my $fh = IO::Socket::UNIX->new('Peer' => $port);
-if (!$fh) {
-    print "Failed to connect: " . ($@ || $!) . "\n";
+my $fh = IO::Socket::UNIX->new( 'Peer' => $port );
+if ( !$fh ) {
+    print "Failed to connect: " . ( $@ || $! ) . "\n";
 }
-printf("%s 1\n", $fh ? "ok" : "not ok");
-printf("%s 2\n", $fh->close() ? "ok" : "not ok");
+printf( "%s 1\n", $fh          ? "ok" : "not ok" );
+printf( "%s 2\n", $fh->close() ? "ok" : "not ok" );
 print "Making second connection to port $port...\n";
-$fh = IO::Socket::UNIX->new('Peer' => $port);
-if (!$fh) {
-    print "Failed to connect: " . ($@ || $!) . "\n";
+$fh = IO::Socket::UNIX->new( 'Peer' => $port );
+if ( !$fh ) {
+    print "Failed to connect: " . ( $@ || $! ) . "\n";
 }
-printf("%s 3\n", $fh ? "ok" : "not ok");
+printf( "%s 3\n", $fh ? "ok" : "not ok" );
 eval {
-    for (my $i = 0;  $i < 20;  $i++) {
-	print "Writing number: $i\n";
-	if (!$fh->print("$i\n")  ||  !$fh->flush()) {
-	    die "Client: Error while writing number $i: " . $fh->error()
-		. " ($!)";
-	}
-	print "Written.\n";
-	my($line) = $fh->getline();
-	if (!defined($line)) {
-	    die "Client: Error while reading number $i: " . $fh->error()
-		. " ($!)";
-	}
-	if ($line !~ /(\d+)/  ||  $1 != $i*2) {
-	    die "Wrong response, exptected " . ($i*2) . ", got $line";
-	}
+    for ( my $i = 0; $i < 20; $i++ ) {
+        print "Writing number: $i\n";
+        if ( !$fh->print("$i\n") || !$fh->flush() ) {
+            die "Client: Error while writing number $i: " . $fh->error() . " ($!)";
+        }
+        print "Written.\n";
+        my ($line) = $fh->getline();
+        if ( !defined($line) ) {
+            die "Client: Error while reading number $i: " . $fh->error() . " ($!)";
+        }
+        if ( $line !~ /(\d+)/ || $1 != $i * 2 ) {
+            die "Wrong response, exptected " . ( $i * 2 ) . ", got $line";
+        }
     }
 };
 if ($@) {
     print STDERR "$@\n";
     print "not ok 4\n";
-} else {
+}
+else {
     print "ok 4\n";
 }
-printf("%s 5\n", $fh->close() ? "ok" : "not ok");
+printf( "%s 5\n", $fh->close() ? "ok" : "not ok" );
 
 END {
     if ($handle) { $handle->Terminate() }
     unlink "ndtest.prt" if -e "ndtest.prt";
-    unlink "mysock" if -e "mysock";
+    unlink "mysock"     if -e "mysock";
     exit 0;
 }