view release on metacpan or  search on metacpan

lib/Net/Daemon.pm  view on Meta::CPAN

#
#   Purpose: Reads the config file.
#
#   Inputs:  $self - Instance
#            $file - config file name
#            $options - Hash of command line options; these are not
#                really for being processed by this method. We pass
#                it just in case. The new() method will process them
#                at a later time.
#            $args - Array ref of other command line options.
#
############################################################################

sub ReadConfigFile {
    my ( $self, $file, $options, $args ) = @_;
    if ( !-f $file ) {
        $self->Fatal("No such config file: $file");
    }
    $@ = '';
    my $copts = do File::Spec->rel2abs($file);
    if ($@) {
        $self->Fatal("Error while processing config file $file: $@");
    }
    if ( !defined($copts) && $! ) {
        $self->Fatal("Cannot read config file $file: $!");
    }
    if ( !$copts || ref($copts) ne 'HASH' ) {
        $self->Fatal("Config file $file did not return a hash ref.");
    }

    # Override current configuration with config file options.
    while ( my ( $var, $val ) = each %$copts ) {
        $self->{$var} = $val;
    }
}

############################################################################
#
#   Name:    new (Class method)
#
#   Purpose: Constructor
#
#   Inputs:  $class - This class
#            $attr - Hash ref of attributes
#            $args - Array ref of command line arguments
#
#   Result:  Server object for success, error message otherwise
#
############################################################################

sub new ($$;$) {
    my ( $class, $attr, $args ) = @_;
    my ($self) = $attr ? \%$attr : {};
    bless( $self, ( ref($class) || $class ) );

    my $options = ( $self->{'options'} ||= {} );
    $self->{'args'} ||= [];
    if ($args) {
        my @optList = map { $_->{'template'} } values( %{ $class->Options() } );

        local @ARGV = @$args;
        if ( !Getopt::Long::GetOptions( $options, @optList ) ) {
            $self->Usage();
        }
        @{ $self->{'args'} } = @ARGV;

        if ( $options->{'help'} ) {
            $self->Usage();
        }
        if ( $options->{'version'} ) {
            print STDERR $self->Version(), "\n";
            exit 1;
        }
    }

    my $file = $options->{'configfile'} || $self->{'configfile'};
    if ($file) {
        $self->ReadConfigFile( $file, $options, $args );
    }
    while ( my ( $var, $val ) = each %$options ) {
        $self->{$var} = $val;
    }

    if ( $self->{'childs'} ) {
        $self->{'mode'} = 'single';
    }
    elsif ( !defined( $self->{'mode'} ) ) {
        if ( $^O ne 'MSWin32' && $^V ge v5.10.0 && eval { require threads } ) {
            $self->{'mode'} = 'ithreads';
        }
        else {
            my $fork = 0;
            if ( $^O ne "MSWin32" ) {
                my $pid = eval { fork() };
                if ( defined($pid) ) {
                    if ( !$pid ) { exit; }    # Child
                    $fork = 1;
                    wait;
                }
            }
            if ($fork) {
                $self->{'mode'} = 'fork';
            }
            else {
                $self->{'mode'} = 'single';
            }
        }
    }

    if ( $self->{'mode'} eq 'ithreads' ) {
        no warnings 'redefine';
        require threads;
        use warnings 'redefine';
    }
    elsif ( $self->{'mode'} eq 'fork' ) {

        # Initialize forking mode ...
    }
    elsif ( $self->{'mode'} eq 'single' ) {

        # Initialize single mode ...

lib/Net/Daemon.pm  view on Meta::CPAN

			     'description' => '--base                  '
				    . 'dec (default), hex or oct'
			      };
      $options;
  }

  # Treat command line option in the constructor
  sub new ($$;$) {
      my($class, $attr, $args) = @_;
      my($self) = $class->SUPER::new($attr, $args);
      if ($self->{'options'}  &&  $self->{'options'}->{'base'}) {
	  $self->{'base'} = $self->{'options'}->{'base'}
      }
      if (!$self->{'base'}) {
	  $self->{'base'} = 'dec';
      }
      $self;
  }

  # Initialize per-connection state after Clone()
  sub post_clone ($) {
      my($self) = @_;
      $self->{'base'} = $self->{'parent'}->{'base'};
  }

  sub Run ($) {
      my($self) = @_;
      my($line, $sock);
      $sock = $self->{'socket'};
      while (1) {
	  if (!defined($line = $sock->getline())) {
	      if ($sock->error()) {
		  $self->Error("Client connection error %s",
			       $sock->error());
	      }
	      $sock->close();
	      return;
	  }
	  $line =~ s/\s+$//; # Remove CRLF
	  my($result) = eval $line;
	  my($rc);
	  if ($self->{'base'} eq 'hex') {
	      $rc = printf $sock ("%x\n", $result);
	  } elsif ($self->{'base'} eq 'oct') {
	      $rc = printf $sock ("%o\n", $result);
	  } else {
	      $rc = printf $sock ("%d\n", $result);
	  }
	  if (!$rc) {
	      $self->Error("Client connection error %s",
			   $sock->error());
	      $sock->close();
	      return;
	  }
      }
  }

  package main;

  my $server = Calculator->new({'pidfile' => 'none',
				'localport' => 2000}, \@ARGV);
  $server->Bind();


=head1 KNOWN PROBLEMS

Most, or even any, known problems are related to the Sys::Syslog module
which is by default used for logging events under Unix. I'll quote some
examples:

=over

=item Usage: Sys::Syslog::_PATH_LOG at ...

This problem is treated in perl bug 20000712.003. A workaround is
changing line 277 of Syslog.pm to

  my $syslog = &_PATH_LOG() || croak "_PATH_LOG not found in syslog.ph";

=back


=head1 AUTHOR AND COPYRIGHT

  Net::Daemon is Copyright (C) 1998, Jochen Wiedmann
                                     Am Eisteich 9
                                     72555 Metzingen
                                     Germany

                                     Phone: +49 7123 14887
                                     Email: joe@ispsoft.de

  All rights reserved.

  You may distribute this package under the terms of either the GNU
  General Public License or the Artistic License, as specified in the
  Perl README file.


=head1 SEE ALSO

L<RPC::pServer(3)>, L<Netserver::Generic(3)>, L<Net::Daemon::Log(3)>,
L<Net::Daemon::Test(3)>

=cut