view release on metacpan or  search on metacpan

script/padre-client  view on Meta::CPAN

#!/usr/bin/perl

=pod

=head1 NAME

padre-client - Client for Padre

=cut

use 5.008005;
use strict;
use warnings;
use Getopt::Long    ();
use Carp            ();
use Padre::Constant ();
use Padre::Startup  ();

our $VERSION = '1.01';





#####################################################################
# Client Startup Procedure

# Runs the (as light as possible) startup process for Padre.
# XXX Mostly cut-n-pasted from Padre::Startup, except for the socket command handling
sub connect_to_server {
	my (%options) = @_;
	# Start with the default settings
	my %setting = (
		main_singleinstance      => Padre::Constant::DEFAULT_SINGLEINSTANCE(),
		main_singleinstance_port => Padre::Constant::DEFAULT_SINGLEINSTANCE_PORT(),
		startup_splash           => 1,
	);

	# Load and overlay the startup.yml file
	if ( -f Padre::Constant::CONFIG_STARTUP ) {
		require YAML::Tiny;
		my $yaml = YAML::Tiny::LoadFile(
			Padre::Constant::CONFIG_STARTUP
		);
		foreach ( sort keys %setting ) {
			next unless exists $yaml->{$_};
			$setting{$_} = $yaml->{$_};
		}
	}

	# Attempt to connect to the single instance server
	if ( $setting{main_singleinstance} ) {
		# This blocks for about 1 second
		require IO::Socket;
		my $socket = IO::Socket::INET->new(
			PeerAddr => ($options{ host } || '127.0.0.1'),
			PeerPort => ($options{ port } || $setting{main_singleinstance_port}),
			Proto    => 'tcp',
			Type     => IO::Socket::SOCK_STREAM(),
		);
		if ( $socket ) {
			my $pid = '';
			my $read = $socket->sysread( $pid, 10 );
			if ( defined $read and $read == 10 ) {
				# Got the single instance PID
				$pid =~ s/\s+\s//;
				if ( Padre::Constant::WIN32 ) {
					require Padre::Util::Win32;
					Padre::Util::Win32::AllowSetForeground($pid);
				}
			};
			binmode $socket;
			return $socket
		} else {
			# Main Padre instance unreachable or does not exist
		}
	}

	# Show the splash image now we are starting a new instance
	# Shows Padre's splash screen if this is the first time
	# It is saved as BMP as it seems (from wxWidgets documentation)
	# that it is the most portable format (and we don't need to
	# call Wx::InitAllImageHeaders() or whatever)
	if ( $setting{startup_splash} ) {
		# Don't show the splash screen during testing otherwise
		# it will spoil the flashy surprise when they upgrade.
		unless ( $ENV{HARNESS_ACTIVE} or $ENV{PADRE_NOSPLASH} ) {
			require File::Spec;

			# Find the base share directory
			my $share = undef;
			if ( $ENV{PADRE_DEV} ) {
				require FindBin;
				$share = File::Spec->catdir(
					$FindBin::Bin,
					File::Spec->updir,
					'share',
				);
			} else {