Bayonne-Libexec

 view release on metacpan or  search on metacpan

lib/Bayonne/Libexec.pm  view on Meta::CPAN

		$value =~ s/\s+$//;
		$self->{args}{$keyword}=$value;
	}
	
	bless $self, ref $class || $class;
	return $self;
};

# hangup

sub hangup($) {
	my($self) = @_;
	my($tsid) = $self->{'tsession'};
	if($tsid) {
		print STDOUT "$tsid hangup\n";
		$self->{'tsession'} = undef;
	}
}

# disconnect (server resumes...)

sub detach($$) {
	my($self,$code) = @_;
	my($tsid) = $self->{'tsession'};

	if($tsid) {
		print STDOUT "$tsid exit $code\n";
		$self->{'tsession'} = undef;	
	}
}

sub error($$) {
	my($self,$msg) = @_;
	my($tsid) = $self->{'tsession'};

	if($tsid) {
		print STDOUT "$tsid error $msg\n";
		$self->{'tsession'} = undef;
	}
}

sub post($$$) {
	my($self, $id, $value) = @_;
	my $sid = $self->{head}{'SESSION'};
	print STDOUT "$sid POST $id $value\n";
}

sub pathname($$) {
	my($self,$file) = @_;
	my $prefix = $self->{head}{'PREFIX'};
	my $var = $ENV{'SERVER_PREFIX'};
	my $ram = $ENV{'SERVER_TMPFS'};
	my $tmp = $ENV{'SERVER_TMP'};
	my $ext = $self->{head}{'EXTENSION'};

	if(!$file) {
		return undef;
	}

lib/Bayonne/Libexec.pm  view on Meta::CPAN

		if(!$prefix or $prefix == "") {
			return undef;
		}
		return "$var/$prefix/$file";
	}
	return "$var/$file";
}

# check file validity for write/modify

sub filename($$) {
	my($self,$file) = @_;
	my $prefix = $self->{head}{'PREFIX'};

	if(!$file) {
		return undef;
	}

	if(substr($file, 0, 4) eq "tmp:") {
		return $file;
	}

lib/Bayonne/Libexec.pm  view on Meta::CPAN

	if($count == 0) {
		return "$prefix/$file";
	}

	return "$file";
}

# move files

sub move($$$) {
	my ($self,$file1,$file2) = @_;
	$file1 = $self->pathname($file1);
	$file2 = $self->pathname($file2);
	if(!$file1 || !$file2) {
		$self->{'result'} = 254;
		return 254;
	}
	rename($file1, $file2);
	$self->{'result'} = 0;
	return 0;
}	

# erase file

sub erase($$) {
	my ($self,$file) = @_;
	$file = $self->pathname($file);
	if(!$file) {
		$self->{'result'} = 254;
		return 254;
	}
	remove("$file");
	$self->{'result'} = 0;
	return 0;
}

lib/Bayonne/Libexec.pm  view on Meta::CPAN

# set voice to use, undef to reset...

sub voice {
	my $self = shift;
	my $voice = shift;

	$self->{'voice'} = $voice;
}

sub level($$) {
	my($self, $level) = @_;
	$self->{'level'} = $level;
}

# process input line

sub input($$$) {
	my ($self, $count, $timeout) = @_;

	if(!$count) {
		$count = 1;
	}

	if(!$timeout) {
		$timeout = 0;
	}

	my $result = $self->command("READ $timeout $count");
	if($result != 0) {
		return "";
	}

	return $self->{'digits'};
}

# clear pending input

sub clear($) {
	my($self) = @_;
	return $self->command("FLUSH");
}

# wait for a key event

sub wait($$) {
	my ($self, $timeout) = @_;

	if(!$timeout) {
		$timeout = 0;
	}
	my $result = $self->command("WAIT $timeout");
	if($result == 3) {
		return 1;
	}
	return 0;
}

# process single key input

sub inkey($$) {
	my ($self, $timeout) = @_;

	if(!$timeout) {
		$timeout = 0;
	}

	my $result = $self->command("READ $timeout");
	if($result != 0) {
		return "";
	}
	return substr($self->{'digits'}, 0, 1);
}

# send results back to server.

sub result($$) {
	my($self, $buf) = @_;
	$buf =~ s/\%/\%\%/g;
        $buf =~ s/(.)/ord $1 < 32 ?
                sprintf "%%%s", chr(ord($1) + 64) : sprintf "%s",$1/eg; 

	return $self->command("result $buf");
}

# transfer extension

sub transfer($$) {
	my($self, $dest) = @_;
	return $self->command("xfer $dest");
}

# get symbol value

sub get($$) {
	my($self, $buf) = @_;
	$self->command("get $buf");
	return $self->{'query'};
}

# set symbol value

sub set($$$) {
	my($self, $id, $value) = @_;
	return $self->command("set $id $value");
}

sub add($$$) {
        my($self, $id, $value) = @_;
        return $self->command("add $id $value");
} 

# size a symbol

sub size($$$) {
	my($self, $id, $buf) = @_;
	my($size) = $buf - 0;
	return $self->command("new $id $size");
}
	
# build prompt

sub speak($$) {
        my($self, $buf) = @_;
	my($voice) = $self->{'voice'};

	if(!$voice) {
		$voice = "prompt";
	}

	if($voice eq "") {
		$voice = "prompt";
	}

        return $self->command("$voice $buf");
}

# issue a libexec command and parse the transaction results.

sub command($$) {
	my($self,$buf) = @_;
        my($hid) = 0;
        my($result) = 255;      # no result value   
	my($tsession) = $self->{'tsession'};
	my($exitcode) = $self->{'exitcode'};
	my($buffer);
	my($num);

	if(!$tsession || $exitcode > 0) {
		return -$exitcode;

lib/Bayonne/Libexec.pm  view on Meta::CPAN

		if($keyword eq "result") {
			$result = $value - 0;
		}
		$self->{$keyword}=$value;
	}
	return $result;  
}	

# generic print function, works whether in TGI or direct execute mode

sub print($$) {
	my($self,$buf) = @_;
  	$buf =~ s/\%/\%\%/g; 
  	$buf =~ s/(.)/ord $1 < 32 ? 
		sprintf "%%%s", chr(ord($1) + 64) : sprintf "%s",$1/eg; 
	if($self->{'tsession'}) {
		print STDERR $buf;
	} else {
		print STDOUT $buf;
	}
}