1 # TextServerClient.pm

     2 # 

     3 # Copyright (c) 2010 Accenture. All rights reserved.

     4 # This component and the accompanying materials are made available

     5 # under the terms of the "Eclipse Public License v1.0"

     6 # which accompanies this distribution, and is available

     7 # at the URL "http://www.eclipse.org/legal/epl-v10.html".

     8 # 

     9 # Initial Contributors:

    10 # Accenture - Initial contribution

    11 #

    12 package FShell::TextServerClient;

    13 

    14 use strict;

    15 use Carp;

    16 use Pcons;

    17 

    18 sub new {

    19         my $proto = shift;

    20         my $class = ref($proto) || $proto;

    21 	my $self = {

    22 		PCONS_NAME	=> undef,

    23 		SERVER_PROCESS	=> undef,

    24 		SERVER_PROMPT	=> 'ok',

    25 		PCONS_READER	=> undef,

    26 		PCONS_WRITER	=> undef,

    27 	};

    28 	bless ($self, $class);

    29 	return $self;

    30 }

    31 

    32 sub Connected {

    33 	my ($self) = @_;

    34 	return (defined $self->{PCONS_READER}) && (defined $self->{PCONS_WRITER});

    35 }

    36 

    37 sub PconsName {

    38 	my ($self, $name) = @_;

    39 	if (defined $name) {

    40 		croak "Cannot change pcons name while connected" if ($self->Connected());

    41 		$self->{PCONS_NAME} = $name;

    42 	}

    43 	return $self->{PCONS_NAME};

    44 }

    45 

    46 sub ServerProcess {

    47 	my ($self, $proc) = @_;

    48 	if (defined $proc) {

    49 		croak "Cannot set server process while connected" if ($self->Connected());

    50 		$self->{SERVER_PROCESS} = $proc;

    51 	}

    52 	return $self->{SERVER_PROCESS};

    53 }

    54 

    55 sub Disconnect {

    56 	my ($self) = @_;

    57 	undef $self->{PCONS_READER};

    58 	undef $self->{PCONS_WRITER};

    59 }

    60 

    61 sub Connect {

    62 	my ($self) = @_;

    63 	croak "Cannot connect to server before process has been set" if (!defined $self->ServerProcess());

    64 	croak "Cannot connect to server becore persisten console name has been set" if (!defined $self->PconsName());

    65 	return if (Connected());

    66 

    67 	my $reader = Pcons::OpenReader($self->{PCONS_NAME});

    68 	if (!defined $reader) {

    69 		$self->{SERVER_PROCESS} =~ s|^\s*||;

    70 		my ($procName, @procArgs) = split(/\s/, $self->{SERVER_PROCESS});

    71 		Pcons::Create($self->{PCONS_NAME}, $procName, join(' ', @procArgs)) or croak "Cannot create persistent console $self->{PCONS_NAME} with process $procName: $!";

    72 		$reader = Pcons::OpenReader($self->{PCONS_NAME}) or croak ("Cannot open pcons reader to '$self->{PCONS_NAME}': $!");

    73 		$self->WaitPrompt($reader) or croak ("Prompt $self->{SERVER_PROMPT} not received from server");

    74 	}

    75 	my $writer = Pcons::OpenWriter($self->{PCONS_NAME});

    76 	croak ("Cannot open pcons writer to '$self->{PCONS_NAME}': $!") unless defined $writer;

    77 	$self->{PCONS_WRITER} = $writer;

    78 	$self->{PCONS_READER} = $reader;

    79 	return 1;

    80 }

    81 

    82 sub WaitPrompt {

    83 	my ($self, $reader) = @_;

    84 	my @lines;

    85 	$reader = $self->{PCONS_READER} unless defined $reader;

    86 	while (my $line = <$reader>) {

    87 		chomp $line;

    88 		return \@lines if ($line eq $self->{SERVER_PROMPT});

    89 		push @lines, $line;

    90 	}

    91 	return undef;

    92 }

    93 

    94 sub Execute {

    95 	my ($self, $command) = @_;

    96 	croak "Not connected to server" unless $self->Connected();

    97 	croak "No command specified" unless (defined $command);

    98 	my $writer = $self->{PCONS_WRITER};

    99 	print $writer "$command\n";

   100 	return $self->WaitPrompt();

   101 }

   102 

   103 1;

   104 

   105 __END__

   106 

   107 =head1 NAME

   108 

   109 FShell::TextServerClient - perl interface to Fshell server commands

   110 

   111 =head1 SYNOPSIS

   112 

   113 	use FShell::TextServerClient;

   114 

   115 	my $client = new Fshell::TextServerClient;

   116 	$client->PconsName('server_console');

   117 	$client->ServerProcess('server_executable --arguments');

   118 	$client->Connect();

   119 

   120 	my $output = $client->Execute('command');

   121 	foreach (@$output) {

   122 		process_line($_);

   123 	}

   124 

   125 =head1 DESCRIPTION

   126 

   127 This module provides a perl interface to FShell command servers, i.e. those FShell commands the derive from

   128 class C<CServerCommandBase>. This module is analgous to the C++ class C<CClientBase>, providing similar

   129 functionality in perl.

   130 

   131 =head1 COPYRIGHT

   132 

   133 Copyright (c) 2009-2010 Accenture. All rights reserved.

   134 

   135 =head1 VERSION

   136 

   137 Version 0.01 (April 1st, 2009)

   138 

   139 =head1 SEE ALSO

   140 

   141 perl(1)

   142 Pcons

   143 

   144 =cut