view release on metacpan or  search on metacpan

lib/App/Basis.pm  view on Meta::CPAN

    _output( 'STDERR', $msg ) if ($msg) ;
    _exit_or_die($state) ;
}

# -----------------------------------------------------------------------------


sub daemonise
{
    my $rootdir = shift ;

    if ($rootdir) {
        chroot($rootdir)
            or die
            "Could not chroot to $rootdir, only the root user can do this." ;
    }

    # fork once and let the parent exit
    my $pid = fork() ;

    # exit if $pid ;
    # parent to return 0, as it is logical
    if ($pid) {
        return 0 ;
    }
    die "Couldn't fork: $!" unless defined $pid ;

    # disassociate from controlling terminal, leave the
    # process group behind

    POSIX::setsid() or die "Can't start a new session" ;

    # show that we have started a daemon process
    return 1 ;
}

# ----------------------------------------------------------------------------


sub execute_cmd
{
    my %args = @_ ;

    my $command = $args{command} or die "command required" ;
    # pass everything thought encode incase there is utf8 there
    utf8::encode($command) ;

    my $r = IPC::Cmd::run_forked( $command, \%args ) ;

    return $r ;
}

# ----------------------------------------------------------------------------


sub run_cmd
{
    my ( $cmd, $timeout ) = @_ ;

    # use our local version of path so that it can pass taint checks
    local $ENV{PATH} = $ENV{PATH} ;

    # pass everything thought encode incase there is utf8 there
    utf8::encode($cmd) ;

    my %data = ( command => $cmd ) ;
    $data{timeout} = $timeout if ($timeout) ;
    my ( $ret, $err, $full_buff, $stdout_buff, $stderr_buff ) = run(%data) ;

    my $stdout = join( "\n", @{$stdout_buff} ) ;
    my $stderr = join( "\n", @{$stderr_buff} ) ;

    return ( !$ret, $stdout, $stderr ) ;
}

# -----------------------------------------------------------------------------


sub fix_filename
{
    my $file = shift ;
    return if ( !$file ) ;

    my $home = File::HomeDir->my_home ;
    $file =~ s/^~/$home/ ;
    if ( $file =~ m|^\.\./| ) {
        my $parent = path( Path::Tiny->cwd )->dirname ;
        $file =~ s|^(\.{2})/|$parent/| ;
    }
    if ( $file =~ m|^\./| || $file eq '.' ) {
        my $cwd = Path::Tiny->cwd ;
        $file =~ s|^(\.)/?|$cwd| ;
    }

    # replace multiple separators
    $file =~ s|//|/|g ;

    # get the OS specific path
    return path($file)->canonpath ;
}

# ----------------------------------------------------------------------------
# Returns a hash containing a formatted name for each option. For example:
# ( 'help|h|?' ) -> { 'help|h|?' => '-h, -?, --help' }
sub _desc_names
{
    my %descs ;
    foreach my $o (@_) {
        $_ = $o ;    # Keep a copy of key in $o.
        s/=.*$// ;

        # Sort by length so single letter options are shown first.
        my @parts = sort { length $a <=> length $b } split /\|/ ;

        # Single chars get - prefix, names get -- prefix.
        my $s = join ", ", map { ( length > 1 ? '--' : '-' ) . $_ } @parts ;

        $descs{$o} = $s ;
    }
    return %descs ;