view release on metacpan or  search on metacpan

lib/Bio/Das/ProServer.pm  view on Meta::CPAN

            );

  my $maxmsg = (sort { $a <=> $b } map { length $_ } @msg)[-1];

  print  q(#)x($maxmsg+6), "\n" or croak $OS_ERROR;
  for my $m (@msg) {
    printf qq(#  %-${maxmsg}s  #\n), $m or croak $OS_ERROR;
  }
  print  q(#)x($maxmsg+6), "\n\n" or croak $OS_ERROR;

  @ARGV = @saveargv; ## no critic

  if($opts->{'help'}) {
    print <<'EOT' or croak $ERRNO;
 -debug           # Enable extra debugging
 -port   <9000>   # Listen on this port (overrides configuration file)
 -hostname <*>    # Listen on this interface x (overrides configuration file)
 -pidfile <*>     # Use this process ID file (overides configuration file)
 -logfile <*>     # Use this log file (overides configuration file)
 -help            # This help
 -config          # Use this configuration file
 -x               # Development mode - disables server forking
 
 To stop the server:
   kill -TERM `cat eg/proserver.myhostname.pid`

 To restart the server:
   kill -USR1 `cat eg/proserver.myhostname.pid`
EOT
    return;
  }

  if(!$opts->{'inifile'}) {
    $opts->{'inifile'} = File::Spec->catfile('eg', 'proserver.ini');
    $class->log(qq(Using default '$opts->{'inifile'}' file.));
  }

  if(!-e $opts->{'inifile'}) {
    $class->log(qq(Invalid configuration file: $opts->{'inifile'}. Stopping.));
    return;
  }

  # backwards-compatibility switch
  $opts->{'interface'} = $opts->{'hostname'};
  delete $opts->{'hostname'};

  my $config = Bio::Das::ProServer::Config->new($opts);
  $self->{'config'} = $config;

  # Load in the co-ordinates file
  my $coord_dir  = $config->{'coordshome'};
  my %all_coords = ();

  for my $coordfile ( glob File::Spec->catfile($coord_dir, '*.xml') ) {
    open my $fh_coord, q(<), $coordfile or croak "Unable to open coordinates file $coordfile";
    my @coordfull;
    while (my $blk = <$fh_coord>) {
      $blk =~ s{^\s*(<\?xml.*?>)?(\s*</?DASCOORDINATESYSTEM>\s*)?}{}mixs;
      $blk =~ s/\s*$//mxs;
      push @coordfull, grep { $_ }
                       split m{</COORDINATES>}mxs, $blk;
    }
    close $fh_coord or croak "Unable to close coordinates file $coordfile";

    my %coords;
    for (@coordfull) {
      my ($uri) = m/uri\s*=\s*"(.*?)"/mxs;
      my ($des) = m/>(.*)$/mxs;
      $coords{lc $des} = $coords{lc $uri} = {
        'uri'         => $uri,
        'description' => $des,
        'source'      => my ($t)  = m/source\s*=\s*"(.*?)"/mxs,
        'authority'   => my ($au) = m/authority\s*=\s*"(.*?)"/mxs,
        'version'     => my ($v)  = m/version\s*=\s*"(.*?)"/mxs,
        'taxid'       => my ($s)  = m/taxid\s*=\s*"(.*?)"/mxs,
      };
    }

    $class->log(q(Loaded ).((scalar keys %coords)/2)." co-ordinate systems from $coordfile");
    %all_coords = (%all_coords, %coords);
  }
  $COORDINATES = \%all_coords;

  if($opts->{'X'}) {
    $config->maxclients(0);
  } else {
    if (fork) {
      $class->log(qq(Parent process $PID detached...));
      return;
    } else {
      $class->log(qq(Child process $PID continuing...));
      if (POE::Kernel->can('has_forked')) {
        $poe_kernel->has_forked();
      }
    }
  }

  setsid() or croak 'Cannot setsid';

  my $pidfile = $opts->{'pidfile'} || $config->pidfile() || sprintf '%s.%s.pid', $PROGRAM_NAME||'proserver', hostname() || 'localhost';
  $self->make_pidfile($pidfile);

  my $logfile = $opts->{'logfile'} || $config->logfile();
  if (!defined $logfile) {
    my ($vol, $path) = File::Spec->splitpath($pidfile);

    if(!$path) {
      ($vol, $path) = File::Spec->splitpath($opts->{'inifile'});
    }

    $logfile = File::Spec->catpath($vol, $path, sprintf 'proserver.%s.log', hostname() );
  }

  open STDIN, '<', File::Spec->devnull or croak "Can't open STDIN from the null device: [$ERRNO]";
  if(!$opts->{'X'}) {
    my $errlog = $logfile;
    $errlog    =~ s/\.log$/.err/mxs;
    $class->log(qq(Logging STDOUT to $logfile and STDERR to $errlog));
    open STDOUT, '>>', $logfile or croak "Can't open STDOUT to $logfile: [$ERRNO]";
    open STDERR, '>>', $errlog  or croak "Can't open STDERR to STDOUT: [$ERRNO]";
  }