File indexing completed on 2024-04-21 11:41:09

0001 #!/usr/bin/perl
0002 
0003 #---------------------------------------------------------------
0004 # Kmuddy scripting - variable support
0005 # 
0006 # require() this file in a Perl script, if you want to use
0007 # variables in that script
0008 #---------------------------------------------------------------
0009 
0010 # Public interface
0011 #
0012 # ** Call this at the beginning of your script
0013 # initVariableSocket();
0014 #
0015 # ** Call this at the end of your script
0016 # closeVariableSocket();
0017 #
0018 # ** Reads variable value and returns it
0019 # $var = getVariable("myvarname");
0020 #
0021 # ** Sets variable value
0022 # setVariable("myvarname","myvarvalue");
0023 #
0024 # ** Unsets a variable
0025 # unsetVariable("myvarname");
0026 #
0027 # ** Sends a command to the MUD
0028 # sendCommand("say hello");
0029 
0030 
0031 #---------------------------------------------------------------
0032 # Implementation details follow
0033 #---------------------------------------------------------------
0034 
0035 use Socket;
0036 
0037 local $socket_filevar = "";
0038 my $line;
0039 
0040 
0041 #---------------------------------------------------------------
0042 # Connect to kmuddy variable server
0043 #---------------------------------------------------------------
0044 
0045 sub initVariableSocket
0046 {
0047    my $socket_name = $ENV{"KMUDDY_SOCKET"};
0048    
0049    if ($socket_name eq "")
0050    {
0051       die("Variable KMUDDY_SOCKET is not set - variable support won't work!\n");
0052    } # endif unknown value of kmuddy socket environment variable
0053    
0054    if (!socket(SOCK,PF_UNIX,SOCK_STREAM,0))
0055    {
0056       die("Could not reserve a socket to connect to Kmuddy\n");
0057    } # endif can't get a socket
0058 
0059    if (!connect(SOCK,sockaddr_un($socket_name)))
0060    {
0061       close(SOCK);
0062       die("Could not connect to Kmuddy\n");
0063    } # endif can't connect to kmuddy
0064 
0065    # Now we're connected, do some housekeeping
0066 
0067    # Turn off output buffering
0068    select(SOCK);
0069    $| = 1;
0070    select(STDOUT);
0071 
0072    # Remember socket filehandle
0073    $socket_filevar = \*SOCK;
0074    
0075 } # initVariableSocket
0076 
0077 
0078 
0079 #---------------------------------------------------------------
0080 # Close connection to kmuddy variable server
0081 #---------------------------------------------------------------
0082 
0083 sub closeVariableSocket
0084 {
0085    close($socket_filevar);
0086 } # closeVariableSocket
0087 
0088 
0089 
0090 #---------------------------------------------------------------
0091 # Get a variable's value from the kmuddy variable server
0092 #---------------------------------------------------------------
0093 
0094 sub getVariable
0095 {
0096    my($name) = @_;
0097    my($result);
0098    
0099    print $socket_filevar ("get $name\n");
0100  
0101    $result = <$socket_filevar>;
0102    chomp($result);
0103    
0104    return $result;
0105 
0106 } # getVariable
0107 
0108 
0109 
0110 #---------------------------------------------------------------
0111 # Set a variable on the kmuddy variable server
0112 #---------------------------------------------------------------
0113 
0114 sub setVariable
0115 {
0116    my($name,
0117       $value) = @_;
0118    
0119    my($reply);
0120    
0121    print $socket_filevar ("set $name $value\n");
0122    
0123    $reply = <$socket_filevar>;
0124    
0125 } # setVariable
0126 
0127 
0128 
0129 #---------------------------------------------------------------
0130 # Remove a variable from the kmuddy variable server
0131 #---------------------------------------------------------------
0132 
0133 sub unsetVariable
0134 {
0135    my($name) = @_;
0136    
0137    my($reply);
0138    
0139    print $socket_filevar ("unset $name\n");
0140    
0141    $reply = <$socket_filevar>;
0142 
0143 } # unsetVariable
0144 
0145 
0146 
0147 #---------------------------------------------------------------
0148 # Send a command to the MUD
0149 #---------------------------------------------------------------
0150 
0151 sub sendCommand
0152 {
0153    my($command) = @_;
0154    my($result);
0155    
0156    print $socket_filevar ("send $command\n");
0157    
0158    $result = <$socket_filevar>;
0159    chomp($result);
0160    
0161    return $result;
0162    
0163 } # sendCommand
0164 
0165 1;