view release on metacpan or  search on metacpan

lib/Algorithm/Classifier/IsolationForest/App/Command/streamd.pm  view on Meta::CPAN

			$SAVE_NOW  = 0;
			$next_save = time + $OPT{'save_interval'};
		}
	} ## end while ($RUN)

	# --- shutdown ------------------------------------------------------------
	_log('shutting down');
	_save_model('shutdown') if $DIRTY;
	for my $c ( values %CONN ) {
		close $c->{sock};
	}
	%CONN = ();
	close $listener;
	unlink $OPT{'socket'};
	unlink $OPT{'pid'};
	_log('bye');

	return 1;
} ## end sub execute

#-------------------------------------------------------------------------------
# startup helpers
#-------------------------------------------------------------------------------

# Make sure a directory the daemon needs exists and is writable, creating
# it when it does not.  Run before daemonizing so a permissions problem is
# reported to the terminal that started the daemon rather than buried in a
# log the user has not found yet.
#
# Args:
#   $dir :: the directory to create or check.
#   $flag :: the option that asked for it, e.g. '--model-dir'.  Only used
#            to name the fix in the error message.
#
# Returns: 1 when the directory exists and is writable.  Dies otherwise,
# telling the user to create it, fix its permissions, or point $flag
# somewhere else.
#
# Example:
#   _ensure_dir( $OPT{'model_dir'}, '--model-dir' );
sub _ensure_dir {
	my ( $dir, $flag ) = @_;
	if ( !-d $dir ) {
		my $err;
		make_path( $dir, { mode => oct('0755'), error => \$err } );
		die(      'could not create "'
				. $dir
				. '" (needed for '
				. $flag
				. '); create it, fix permissions, or point '
				. $flag
				. ' somewhere writable'
				. "\n" )
			if !-d $dir;
	} ## end if ( !-d $dir )
	die( '"' . $dir . '" (needed for ' . $flag . ') is not writable; fix permissions or override ' . $flag . "\n" )
		unless -w $dir;
	return 1;
} ## end sub _ensure_dir

# Classic double-fork daemonization.  The parents leave via POSIX::_exit
# so no END blocks (Inline's, App::Cmd's) run twice.  The second fork is
# what guarantees the daemon can never reacquire a controlling terminal.
#
# Args: none.  Reads nothing and takes nothing -- the caller decides
# whether to daemonize at all (-f keeps the process in the foreground).
#
# Returns: 1, in the grandchild only.  The two parents never return: they
# _exit(0) immediately, so the caller either continues as the daemon or
# does not continue.  Dies on a failed fork, setsid, chdir or STDIN
# reopen.
#
# Example:
#   _daemonize() unless $OPT{'f'};
#   # from here on we are the daemon
sub _daemonize {
	defined( my $pid = fork() ) or die( 'fork failed: ' . $! . "\n" );
	POSIX::_exit(0) if $pid;
	setsid()                 or die( 'setsid failed: ' . $! . "\n" );
	defined( $pid = fork() ) or die( 'second fork failed: ' . $! . "\n" );
	POSIX::_exit(0) if $pid;
	chdir '/'                       or die( 'chdir / failed: ' . $! . "\n" );
	open( STDIN, '<', '/dev/null' ) or die( 'reopen STDIN failed: ' . $! . "\n" );
	return 1;
} ## end sub _daemonize

# Point the daemon's logging at wherever --log said, falling back to
# STDERR.  When daemonized, STDOUT and STDERR are reopened onto the log
# too, so a warn from anywhere in the process still lands somewhere the
# operator can read.  Everything is unbuffered: a daemon's log is useless
# if the interesting line is still sitting in a buffer when it wedges.
#
# Args: none.  Reads $OPT{'log'} and $OPT{'f'}.
#
# Returns: 1.  Sets the package's $LOG_FH as its whole purpose.  Dies when
# the log file cannot be opened.
#
# Example:
#   _open_log();
#   _log('listening');
sub _open_log {
	if ( defined $OPT{'log'} ) {
		open( my $fh, '>>', $OPT{'log'} ) or die( 'failed to open log "' . $OPT{'log'} . '": ' . $! . "\n" );
		$fh->autoflush(1);
		$LOG_FH = $fh;
		if ( !$OPT{'f'} ) {
			open( STDOUT, '>>', $OPT{'log'} ) or die( 'reopen STDOUT failed: ' . $! . "\n" );
			open( STDERR, '>>', $OPT{'log'} ) or die( 'reopen STDERR failed: ' . $! . "\n" );
			STDOUT->autoflush(1);
			STDERR->autoflush(1);
		}
	} else {
		$LOG_FH = \*STDERR;
	}
	return 1;
} ## end sub _open_log

# Write one timestamped, pid-stamped line to the log.  The pid matters
# because several named instances (--set) can share one log file.
#
# Args:
#   $msg :: the message, without a trailing newline -- one is added.
#
# Returns: 1.
#
# Example:
#   _log( 'saved ' . $name . ' (' . $why . ')' );
#   # 2026-08-08T14:02:11 [4821] saved oiforest-20260808-140211.json (interval)