view release on metacpan or  search on metacpan

script/satpass  view on Meta::CPAN

		"Error - '~user' does not work under $^O.\n" :
		"Error - No such user as '$1'.\n";
	    $info[7]
	} :
	$^O eq 'VMS' ? '/sys$login' : ($ENV{HOME} || $ENV{LOGDIR} ||
	    $ENV{USERPROFILE})%e;
    $rslt
}

#	$time = _time ()

#	The first time this is called, it attempts to load Time::HiRes.
#	If it succeeds it redefines itself to Time::HiRes::time if that
#	exists. Otherwise it redefines itself to CORE::time. Either
#	way it then transfers control to its redefined self.

sub _time () {
    eval "use Time::HiRes";
    no warnings qw{redefine};
    if (my $code = Time::HiRes->can ('time')) {
	*_time = $code;
	*_time_trim = sub {sprintf '%.3f', $_[0]};
    } else {
	*_time = \&CORE::time;
	*_time_trim = sub {$_[0]};
    }
    goto &_time;
}

{
    my @times;

    BEGIN {
	@times = map { greg_time_gm( @{ $_ } ) }
	[ 59, 59, 23, 31, 11, 2000 ],
	[ 59, 59, 11, 31, 11, 2000 ],
	;
    }

    sub _time_len {
	return max( map { length( gm_strftime( $parm{time_format}, $_ )
		) } @times );
    }
}

########################################################################

package IO::Clipboard;

use Carp;
use Config;
use Symbol;

my ($clip, $clipout, $memio);
our @ISA;

BEGIN {

$IO::Clipboard::clipboard_unavailable = '';

eval "use Scalar::Util qw{weaken}; 1"
    or $IO::Clipboard::clipboard_unavailable = <<eod;
Error - Clipboard unavailable. Unable to load Scalar::Util weaken.
eod

sub _win32 {
eval "use Win32::Clipboard" ?
    sub {(my $s = $_[0]) =~ s/\n/\r\n/mg;
	Win32::Clipboard->new ()->Set ($s)} : undef
}

sub _xclip {
no warnings;
`xclip -o`;
use warnings;
$? ? undef : sub {
    my $hdl;
    open ($hdl, '|xclip') or croak <<eod;
Error - Failed to open handle to xclip.
        $!
eod
    print $hdl $_[0];
    };
}

sub _pb {
    my $code;
    $code = eval {
	require Mac::Pasteboard;
	sub {Mac::Pasteboard::pbcopy($_[0])};
    } and return $code;
### no warnings;
system('pbcopy -help >/dev/null 2>&1');
### use warnings;
$? ? undef : sub {
    my $hdl;
    open ($hdl, '|pbcopy') or croak <<eod;
Error - Failed to open handle to pbcopy.
        $!
eod
    print $hdl $_[0];
    };
}

sub _flunk {
$IO::Clipboard::clipboard_unavailable = shift;
}

my $err = "Can not open handle to clipboard.";

$clipout = eval {$^O eq 'MSWin32' ? _win32 || _flunk (<<eod) :
Error - Clipboard unavailable. Can not load Win32::Clipboard.
eod
    $^O eq 'cygwin' ? _win32 || _xclip || _flunk (<<eod) :
Error - Clipboard unavailable. Can not load Win32::Clipboard
        and xclip has not been installed. For xclip, see
        http://freshmeat.net/projects/xclip
eod
    $^O eq 'darwin' ? _pb || _flunk (<<eod) :
Error - Clipboard unavailable. Can not load Mac::Pasteboard, and
        can not find pbcopy. The latter is supposed to come with
        Mac OS X.
eod
    $^O eq 'MacOS' ? _flunk (<<eod) :
Error - Clipboard unavailable. Mac OS 9 and below not supported.
eod
    _xclip || _flunk (<<eod)};
Error - Clipboard unavailable. Can not find xclip. For xclip,
        see http://freshmeat.net/projects/xclip
eod

$memio = $] >= 5.008 && $Config{useperlio} ?
    sub {my $fh = gensym; open ($fh, $_[0], $_[1]); $fh} :
    do {
	eval "use IO::String";
	$@ or push @ISA, 'IO::String';
        $@ ? sub {croak "$err IO::String not available"} :
	    sub {new IO::String ($_[1])};
	};

*_memio = \&$memio;
}

sub new {
return $clip if $clip;
croak $IO::Clipboard::clipboard_unavailable
    if $IO::Clipboard::clipboard_unavailable;
my $class = shift;
my $data = '';
my $clip = _memio ('>', \$data);
*$clip->{__PACKAGE__}{data} = \$data;
bless $clip, $class;
my $self = $clip;
weaken ($clip);	# So we destroy the held copy when we need to.
$self;
}

sub DESTROY {
my $self = shift;
my $data = *$self->{__PACKAGE__}{data};
$clipout->($$data);
}

########################################################################

#	Test hook.

package Astro::satpass::Test;

use Astro::Coord::ECI::Utils qw{ :ref };
use Carp;
use Config;

our @ISA;

our $noios;

unless ($] >= 5.008 && $Config{useperlio}) {
    eval "use IO::String";
    if ($@) {
	$noios = $@;
	}
    else {
	push @ISA, 'IO::String';
	}
    }

our $Hook;	# Code reference that we use to get data from.
our $Handle;	# First argument to pass to hook when called.
our $Exception;

sub new {
my $class = shift;
confess <<eod if $noios;
Programming error - You are trying to use the test hook under
        a version of Perl prior to v5.8 and you do not have
	the IO::String package available.
eod
confess <<eod unless CODE_REF eq ref $Hook;
Programming error - Should not instantiate a @{[__PACKAGE__]} object
        unless \$@{[__PACKAGE__]}::Hook has been set to a code
	reference.
eod
my $data = '';
my $hook = IO::Clipboard::_memio ('+<', \$data);
*$hook->{__PACKAGE__} = {
	data => \$data,
	loc => 0,
	last_line => undef,
	};
bless $hook, $class;
$hook;
}