view release on metacpan or  search on metacpan

lib/UR/Context/Process.pm  view on Meta::CPAN

=item support_email

  $support_email = UR::Context::Process->support_email;
  UR::Context::Process->support_email($support_email);

This method is used to access and set the email address to which the
user should go for support.  This information is used in the output of
the C<usage> method (see L<App::Getopt/"usage">).  If given an
argument, this method sets the support email address and returns that
email address or C<undef> if unsuccessful.  Without an argument, the
current email address is returned.

=back

=cut

# set/return author email address
our $support_email;
sub support_email
{
    my $class = shift;
    my ($email) = @_;

    if (@_)
    {
    $support_email = $email;
    }
    return $support_email;
}

=pod

=over

=item real_user_name

  $login = UR::Context::Process->real_user_name;

This method is used to get the login name of the effective user id of
the running script.

=back

=cut

# return the name of the user running the program
our $real_user_name;
sub real_user_name
{
    my $class = shift;

    if (!$real_user_name)
    {
        if ($^O eq 'MSWin32' || $^O eq 'cygwin')
        {
            $real_user_name = 'WindowsUser';
        }
        else
        {
            $real_user_name = getpwuid($<) || getlogin || 'unknown';
        }
    }
    return $real_user_name;
}

=pod 

=over

=item fork
    $pid = UR::Context::Process->fork;

Safe fork() wrapper.

Handles properly disconnecting database handles if necessary so that data sources in children
are still valid.  Also ensures that the active UR::Context::process has the child's PID 
recorded within.

=back

=cut

sub fork 
{
    my $class = shift;

    my @ds = UR::DataSource->is_loaded();

    for (grep {defined $_} @ds) {
        $_->prepare_for_fork;
    }

    my $pid = fork();

    unless(defined $pid) {
        Carp::confess('Failed to fork process. ' . $!);
    }

    if (!$pid) {
        $UR::Context::process = undef;
        $UR::Context::process = $class->_create_for_current_process;
        for (grep {defined $_} @ds) {
            $_->do_after_fork_in_child;
        }
    }

    for (grep {defined $_} @ds) {
        $_->finish_up_after_fork;
    }

    return $pid;
}

=pod

=over

=item effective_user_name

  $login = UR::Context::Process->effective_user_name;

This method is used to get the login name of the effective user id of
the running script.

=back

=cut

# return the name of the user running the program
our $effective_user_name;
sub effective_user_name
{
    my $class = shift;

    if (!$effective_user_name)
    {
    $effective_user_name = getpwuid($>) || 'unknown';
    }
    return $effective_user_name;
}

=pod

=over

=item original_program_path

 $path = UR::Context::Process->original_program_path;

This method is used to (try to) get the original program path of the running script.
This will not change even if the current working directory is changed.
(In truth it will find the path at the time UR::Context::Process was used.  So, a chdir
before that happens will cause incorrect results; in that case, undef will be returned.

=back

=cut

our ($original_program_name, $original_program_dir);
eval '
use FindBin;
$original_program_dir=$FindBin::Bin;
$original_program_name=__PACKAGE__->base_name;
';

sub original_program_path {
    my $class=shift;

    my $original_program_dir=$class->original_program_dir;
    return unless($original_program_dir);

    my $original_program_name=$class->original_program_name;
    return unless($original_program_name);

    return $original_program_dir.q(/).$original_program_name;
}

sub original_program_dir {
    return unless($original_program_dir);
    return $original_program_dir;
}

sub original_program_name {
    return unless($original_program_name);
    return $original_program_name;
}


1;

__END__

=pod

=head1 SEE ALSO

L<UR::Context>