viernes, 21 de abril de 2017

Introducción a la mensajería JMS

Introducción a la mensajería JMS

La especificación de mensajería JMS nos permite construir sistemas de mensajería asíncronos con un alto grado de robustez y sencillez. Además, hoy en día existen en el mercado soluciones JMS de código abierto que proporcionan un grado de madurez suficiente como para ser utilizados en aplicaciones corporativas.

La mensajería JMS

Comunicaciones asíncronas

Como es sabido, la comunicación asíncrona, también llamada "no bloqueante", es aquella en la que el emisor envía un mensaje y continúa con su funcionamiento normal sin esperar a que el receptor lo procese. El caso contrario es la comunicación síncrona en la que el emisor envía el mensaje y espera (se bloquea) hasta que recibe la respuesta o transcurre el tiempo de espera.

Los sistemas de mensajería (MOM, Message Oriented Middleware) se encargan de proporcionar este tipo de comunicación entre aplicaciones corporativas de una forma sencilla, robusta y fiable. Son mucho más ampliamente escalables que aquellos basados en conexiones directas o a través de llamadas a procedimientos remotos (RPC), y uno de los campos en los que son más utilizados es en el control de flujo (workflow) de información de sistemas.

En sistemas MOM los participantes de la comunicación no tienen que preocuparse de esperar una respuesta del recipiente, ni siquiera de dónde se encuentra éste, ya que pueden confiar en la infraestructura de mensajería que se encarga de asegurar su entrega.

JMS o Java Message Service, es la única API de mensajería soportada por J2EE.
Los sistemas de mensajería han ido evolucionando desde simple colas asíncronas hasta sistemas elaborados con publicadores, suscriptores, distribuidores, formateo de mensajes, capacidades de proporcionar calidad de servicio, etc.

Dentro de estos sistemas se conoce a los clientes de mensajería en JMS como clientes JMS, al propio sistema como proveedor JMS, y a la aplicación JMS como al conjunto de clientes y proveedores (normalmente uno) que forman el sistema.

El cliente JMS que produce el mensaje es conocido como productor y el que recibe se conoce como consumidor, aunque un mismo cliente JMS puede actuar a la vez de los dos modos.

Modelos estándar de mensajería

JMS nos proporciona dos modelos distintos de mensajería, publicación/subscripción y comunicación punto a punto mediante colas. Se suelen abreviar con "pub/sub" para el primer modelo y "p2p" para el segundo.

A grandes rasgos, el modelo publicación/subscripción está pensado para una comunicación "uno a muchos" mientras que el modelo punto a punto lo está para comunicaciones "uno a uno".
Podemos sugerir para el modelo pub/sub el servicio de subscripciones de una revista. Pensemos en que los lectores se apuntan a una lista mediante una subscripción y los responsables les envían su ejemplar cada mes. Todos y cada uno de ellos reciben una "copia" de la revista, y no es necesario que los lectores se conozcan entre sí.

Figura 1. Modelo pub/sub
Figura 1. Modelo pub/sub de mensajería JMS
Para el segundo modelo, podemos pensar en un sistema de colas típico, como puede ser las colas en las cajas de un supermercado. En este caso, los clientes buscan una sola de las cajas disponibles, hacen cola hasta que llega su turno y son atendidos por el/la cajero/a.

Figura 2. Modelo p2p
Figura 2
En las figuras 1 y 2 podemos apreciar el esquema de ambos modelos. En el modelo pub/sub un productor envía un mensaje a un canal virtual llamado tópico. Los consumidores pueden subscribirse a dicho tópico, con lo que recibirían una copia del mensaje; todos los mensajes enviados a un tópico son entregados a todos los receptores. En este modelo se conoce al productor como publicador y al consumidor como subscriptor. Un aspecto importante en este modelo es que el publicador no conoce nada acerca de los subscriptores, no sabe donde se encuentran, ni cuantos hay ni lo que hacen con los mensajes. Asímismo, los receptores no pueden examinar los mensajes pendientes, y tienen que consumirlo tal cual les llegan.

Los aspectos importantes de este modelo son los siguientes:
  1. No existe acoplamiento entre productores y consumidores, pueden ser añadidos dinámicamente.
  2. Cada subscriptor recibe su propia copia del mensaje
  3. Los subscriptores reciben el mensaje sin tener que solicitarlo. Los mensajes publicados en un tópico son automáticamente entregados a los subscriptores.

El modelo punto a punto se basa en otro esquema. Los clientes JMS envían mensajes a través de canales virtuales llamados colas. Aquí se conoce a los productores como emisores y a los consumidores como receptores. Se trata de un modelo en el cual los receptores chequean la cola para ver si han recibido algún mensaje, contrariamente a lo que sucedía en el anterior modelo (aunque es el comportamiento por defecto, se puede aproximar al modelo anterior mediante configuración).

En una cola puede haber más de un receptor esperando mensajes, aunque solamente uno de ellos va a consumir cada mensaje. Como observamos en la figura 2, el productor se encarga de generar el mensaje y el sistema JMS entrega el mensaje a uno y sólo uno de los potenciales receptores.

La especificación no define las reglas que deben seguirse para la distribución de los mensajes entre los receptores, así que cada fabricante realiza su propia implementación. Este modelo ofrece otras herramientas, como el explorador de colas mediante el cual el receptor es capaz de examinar los mensajes pendientes antes de consumirlos, de forma que puede descartar alguno de ellos. Esta es una característica diferenciadora del anterior modelo, además de las que explicamos a continuación:
  1. Los mensajes se intercambian a través de colas
  2. Cada mensaje se entrega a un solo receptor
  3. Los mensajes llegan ordenados, a medida que se consumen se van eliminando de la cola
  4. No existe acoplamiento entre emisores y receptores, se pueden añadir dinámicamente, ya que esta es una característica general de los sistemas de mensajería

El porqué de la existencia de ambos modelos tiene su explicación en los orígenes de la especificación JMS. Inicialmente se pensó como una solución para sustituir las APIs de los sistemas de mensajería existentes. En el momento del análisis, unos fabricantes de sistemas utilizaban un modelo y el resto el otro modelo. Así pues, JMS tuvo que dar opción a ambos modelos para que la industria lo aceptase. En realidad la especificación no exige que las implementaciones proporcionen los dos, aunque los proveedores de JMS lo ofrecen.

Fundamentalmente, todo lo que se puede hacer con un modelo también se puede hacer con el otro. Podemos establecer una analogía en relación a qué lenguaje de programación preferimos, sea el que sea, seguro que podremos conseguir el mismo resultado. De la misma forma, la elección del modelo pub/sub o p2p se convierte en una cuestión de preferencias.

Ante la existencia de los dos modelos, surge la duda de cuándo elegir uno u otro. La decisión va a depender de los distintos méritos que aporta cada uno. Si se trata de una aplicación en la que nos interesa repartir mensajes a distintos destinatarios sin importarnos si están conectados o no, el modelo pub/sub puede servirnos. Si por el contrario es importante saber que los mensajes llegan, como puede ser el caso de una conversación uno a uno, quizás sea más interesante utilizar el modelo p2p.

La variedad de los datos a transmitir también puede ser un punto a tener en cuenta. Podemos aprovecharnos de la facilidad de tópicos que nos ofrece el modelo pub/sub para segregar los diferentes mensajes entre los potenciales destinatarios.

El modelo p2p es más adecuado cuando se quiere que el receptor procese el mensaje una sola vez. Otra ventaja, mencionada anteriormente, es que disponemos de un explorardor de colas que nos permite echar una ojeada a la cola para ver los mensajes que esperan ser consumidos.

OpenJMS. Instalación y configuración

OpenJMS es una implementación libre de la especificación Java Messages Services API 1.0.2. La pagina del proyecto es: http://openjms.sourceforge.net.

Instalación

La instalación de OpenJMS es muy sencilla, únicamente necesitaremos tener instalado previamente el JRE (en su caso el J2SDK si deseamos modificar el código fuente del proyecto) y seguir unos sencillos pasos.

El archivo de instalación es únicamente una estructura de directorios que contiene todo lo necesario para ejecutar openJMS en nuestra maquina. El primer paso consiste en descomprimir el archivo de instalación que está disponible en formato .zip y .tar.gz. La estructura de directorios generada al descomprimir el archivo debe ser la siguiente:

-bin
-config
+--db
+--examples
-docs
-lib
-src
+--examples

La carpeta bin contiene archivos .sh y .bat para iniciar, detener, y administrar en servidor OpenJMS. La carpeta config contiene el archivo openjms.xml el cual indica la configuración por omisión del servidor OpenJMS. La carpeta config/db contiene scripts SQL para bases de datos OpenJMS.

La carpeta config/examples contiene varios ejemplos de archivos de configuración para otras necesidades de funcionamiento del servidor. La carpeta docs contiene toda la documentación del proyecto, incluyendo información más detallada de esta instalación. La carpeta lib contiene los archivos .jar requeridos para ejecutar el servidor OpenJMS y aquellos requeridos por programas cliente que usan OpenJMS. La carpeta src/examples contiene el código fuente de varios archivos de ejemplo.

Además de esto, hay que crear las siguiente variables de entorno:

JAVA_HOME - El directorio raíz de instalación del JRE.
OPENJMS_HOME - El directorio raíz de instalación de OpenJMS.

Para probar si la instalación se realizó satisfactoriamente iniciamos el servidor, para ello ejecutamos lo siguiente en la línea de comandos:

Para Windows:

cd %OPENJMS_HOME%\bin
startup


Para UNIX:
cd $OPENJMS_HOME/bin
startup.sh

Figura 3. Consola de OpenJMS

Figura 3

Configuración

La configuración de OpenJMS se realiza a través de la modificación del archivo openjms.xml. Simplemente se van agregando los elementos de configuración que necesitemos para el entorno sobre el cual ejecutaremos el servidor; dichos elementos pueden ser para configurar la bases de datos que vamos a utilizar, la seguridad, configuración de tópicos para publicación/suscripción y más opciones. Como ejemplo vemos en el listado 1 el archivo de configuración utilizado para ejecutar el ejemplo que acompaña a este artículo.
Listado 1. Ejemplo de configuración de OpenJMS
<?xml version="1.0"?>
<!--
     NOTA: Esta configuracion muestra los elementos más relevantes cuando se utiliza un conector RMI.
-->
<Configuration>
  <!-- Opcional. Representa la configuracion por omision-->
<ServerConfiguration host="localhost" embeddedJNDI="true" />
  
<!-- Requerido cuando se usa un conector RMI -->
<Connectors>
    <Connector scheme="rmi">
      <ConnectionFactories>
        <QueueConnectionFactory name="JmsQueueConnectionFactory" />
        <TopicConnectionFactory name="JmsTopicConnectionFactory" />
      </ConnectionFactories>
    </Connector>
  </Connectors>
    
  <!-- Requerido -->
  <DatabaseConfiguration>
    <JdbmDatabaseConfiguration name="openjms.db" />
  </DatabaseConfiguration>

  <!-- Requerido -->    
  <AdminConfiguration script="${openjms.home}\bin\startup.bat" />
    
<!-- Opcional. Si no se especifica, no se crearan destinos -->
<AdministeredDestinations>
    <AdministeredTopic name="charla">
      <Subscriber name="sub1" />
      <Subscriber name="sub2" />
</AdministeredTopic>
  
    <AdministeredQueue name="queue1" />
    <AdministeredQueue name="queue2" />
    <AdministeredQueue name="queue3" />
  </AdministeredDestinations>

  <!-- Opcional. Si no se especifica, no se crearan usuarios-->
<Users>
    <User name="admin" password="openjms" /> 
</Users>
</Configuration>


Podemos observar las instrucciones más relevantes para una configuración con un conector RMI, que es la que viene con OpenJMS por omisión al momento de instalarlo. Los posibles elementos de configuración de este archivo se pueden ver a continuación en la siguiente tabla.

Tabla 1. Opciones de configuración del servidor JMS

Tabla_1

ConfiguraciónDescripción
JDBCOpenJMS se puede configurar para usar bases de datos JDBC para implementar persistencia de mensajes.
Conectores OpenJMSOpenJMS proporciona opciones de conectividad sobre varios protocolos, utilizando conectores
JNDIOpenJMS utiliza JNDI para hacer disponibles al cliente: fábricas de conexiones, tópicos, y colas.
Fábricas de conexiónOpenJMS permite configurar la fábrica de conexiones con distintas opciones.
SeguridadOpenJMS proporciona mecanismos para implementar autenticación de conexiones
DestinosLos destinos son registrados con JNDI por el servidor OpenJMS para que estén disponibles a los clientes.
Garbage CollectionOpenJMS permite configurar a detalle la manera en que se ejecutará el recolector de basura.


A continuación se muestran algunos ejemplos de estos elementos de configuración. En el listado 2 se muestra un ejemplo de configuración JDBC:

Listado 2. Ejemplo de Configuración JDBC

  <DatabaseConfiguration>
    <RdbmsDatabaseConfiguration
      driver="oracle.jdbc.driver.OracleDriver"
      url="jdbc:oracle:oci8:@myhost" 
      user="openjms" 
      password="openjms" />
  </DatabaseConfiguration>


Actualmente OpenJMS esta configurado para ser compatible con JDBC 2.0 y varios sistemas de bases de datos. Además de agregar este fragmento de código a nuestro archivo de configuración, es necesario agregar al classpath la ruta de nuestro driver JDBC.

OpenJMS proporciona conectividad a través de varios protocolos utilizando conectores. El listado 3 muestra un ejemplo de configuración para habilitar un conector RMI:

Listado 3. Ejemplo de configuración de un conector RMI
<Connectors>
    <Connector scheme="rmi">
      <ConnectionFactories>
        <QueueConnectionFactory name="QueueConnectionFactory"/>
        <TopicConnectionFactory name="TopicConnectionFactory"/>
      </ConnectionFactories>
    </Connector>
</Connectors>

Los conectores soportados actualmente por OpenJMS son: RMI, TCP, TCPS, HTTP, HTTPS, Embedded.
Una ventaja importante de OpenJMS es que nos permite definir múltiples conectores a nuestro servidor.

OpenJMS proporciona configuraciones para realizar autenticación de conexiones. Para ello se utilizan 2 elementos de configuración <SecurityConfiguration> y <Users>. El listado 4 muestra como utilizar dichos elementos para habilitar la autenticación de conexiones.

Listado 4. Ejemplo de configuración para habilitar autenticación de conexiones.

<SecurityConfiguration securityEnabled="true"/>

<Users>
    <User name="admin" password="openjms"/>
    <User name="user1" password="password1"/>
    <User name="user2" password="password2"/>
</Users>


Como podemos observar, OpenJMS proporciona una amplia gama de características de configuración, lo que lo convierten en un servidor JMS muy versátil. La finalidad de este apartado es mostrarte un panorama general de las opciones de configuración de OpenJMS. Para conocer con mayor detalle la información para la configuración, puedes recurrir a la pagina del proyecto en internet.

Ejemplo con el modelo pub/sub y OpenJMS

Como ejemplo de aplicación JMS ofrecemos el típico chat. Se trata de una sola clase java ClienteJMSChat.java, que actúa tanto como suscriptor como publicador de un tópico de mensajes JMS. Por tanto, se trata de un ejemplo del modelo de publicación/suscripción.

Hay que decir que el ejemplo aquí propuesto es realmente exagerado, el hecho de utilizar un sistema robusto como JMS para una aplicación de chat es quizá excesivo, pero sirva como ilustración.

Los métodos de nuestra clase son los siguientes:
  1. main(). Conocido método principal para hacer que la clase sea ejecutable.
  2. initialize(String, String, String). Método de instancia para la inicialización de la clase como su propio nombre indica. Veremos su contenido a continuación.
  3. show(). Muestra el mensaje recibido desde el sistema JMS
  4. debug(). Método para ver mensajes de depuración. Separado de show() por conveniencia, aunque realmente hacen lo mismo.
  5. chatIt(String). Envia un mensaje al tópico JMS
  6. onMessage(Message). Método que debe implementar la clase para recibir mensajes JMS.
  7. close(). Cierra la conexión JMS abierta.

En la ejecución del ejemplo, el programa nos va a ir sacando trazas por pantalla, que ayudarán a comprenderlo mejor.

La función main()

Pasemos a examinar la función principal main(). En primer lugar observamos que salta una excepción si el número de argumentos pasados es inferior a tres. Los argumentos que hay que pasar son: el primero el tópico al cual queremos conectar, el segundo el nombre de usuario que vamos a utilizar y el tercero la contraseña del usuario (obviamente no se permiten en este caso contraseñas en blanco). Más adelante veremos cómo hay que configurar el servidor JMS para esté disponible el tópico para el cliente.
A continuación instanciamos un objeto de la clase ClienteJMSChat y la inicializamos con los argumentos anteriores. Una vez hecho esto obtenemos el stream de la entrada estándar para poder leer los mensajes que el usuario escribe. Todo texto que escriba el usuario es pasado al objeto instanciado llamando al método chatIt() excepto en el caso de que se corresponda con el comando de salida EXIT_COMMAND (también configurable mediante una variable estática) que hará que el programa termine. Si durante la comunicación ocurre un problema en la capa JMS la capturaremos con la excepción correspondiente.

En el listado 5 podemos observar la parte principal de este método:

Listado 5.

ClienteJMSChat chat = new ClienteJMSChat();
//Argumentos: topic - nombre de usuario - contraseña
chat.initialize(args[0], args[1], args[2]);

//Leer los mensajes desde la consola
BufferedReader consola = new java.io.BufferedReader(
new InputStreamReader(System.in));

//Bucle hasta que se introduzca el comando de finalización
while (true) {
    String s = consola.readLine();
    try {
        if (s.equalsIgnoreCase(EXIT_COMMAND)) {
            chat.close(); //Cerrar la conexión
            break;
        } else {
            chat.chatIt(s);
        }
    } catch (JMSException jmse) {
        chat.debug("Excepcion JMS: " + jmse.getMessage());
        break;
    }
}

Inicialización JMS

Los pasos para inicializar nuestro programa JMS son los siguientes:
  1. Inicializar JNDI
  2. Obtener el objeto Factory JMS
  3. Crear una conexión al servidor JMS mediante el objeto Factory
  4. Obtener dos sesiones JMS, una para publicar y otra para suscribirse al tópico (recordar que nuestro programa actúa con ambos roles)
  5. Obtener el objeto tópico a través de JNDI
  6. Por cada sesión, obtener un objeto publicador y suscriptor respectivamente, que actúan como agentes de comunicación
  7. Registrar en el suscriptor la clase actual para que reciba los mensajes que se publican en el tópico
  8. Por último, realizar la conexión con el servidor

En el listado 6 podemos ver estos pasos. Las variables que no aparecen declaradas son variables de clase, se puede consultar el código completo para ver su declaración. En concreto y para conectar con JMS, los datos que hay que proporcionar son:
  1. CONTEXT_FACTORY = "org.exolab.jms.jndi.InitialContextFactory"
  2. PROVIDER_URL = "rmi://localhost:1099/" (suponiendo que se conecta al host local)
  3. TOPIC_CONNECTION_FACTORY = "JmsTopicConnectionFactory"

Listado 6. Inicialización

//Obtener una conexión JNDI para acceder a los objetos JMS
Properties properties = new Properties();

//Propiedades específicas para conectar con OpenJMS
properties.put(Context.INITIAL_CONTEXT_FACTORY, CONTEXT_FACTORY);
properties.put(Context.PROVIDER_URL, PROVIDER_URL);

try {
    //Obtener contexto inicial JNDI
    InitialContext context = new InitialContext(properties);

    //Obtener la factoría JMS
    TopicConnectionFactory conFactory = (TopicConnectionFactory) context
                    .lookup(TOPIC_CONNECTION_FACTORY);

    //Crear la conexión
    TopicConnection conexion = conFactory.createTopicConnection(
                    usuario, password);

    //Creamos dos sesiones, una para publicación, donde se envian los 
    // mensajes que escribimos, y otra para suscribirnos al tópico, de
    // forma que recibamos los mensajes que allí son enviados.
    TopicSession sesionP = conexion.createTopicSession(false,
                    Session.AUTO_ACKNOWLEDGE);
    TopicSession sesionS = conexion.createTopicSession(false,
                    Session.AUTO_ACKNOWLEDGE);

    //Obtener el tópico JMS
    Topic topicObj = (Topic) context.lookup(topico);

    //Crear un publicador y un suscriptor JMS
    TopicSubscriber suscriptor = sesionS.createSubscriber(topicObj);
    TopicPublisher publicador = sesionP.createPublisher(topicObj);

    //Esta misma clase es la que recibe los mensajes
    suscriptor.setMessageListener(this);

    ...

    //Iniciar la conexion, a partir de aqui los mensajes pueden ser
    // enviados al tópico
    conexion.start();

} catch (NamingException ne) {
    throw new RuntimeException("Error JNDI", ne);

} catch (JMSException jmse) {
    throw new RuntimeException("Error JMS", jmse);
}

Envío y recepción de mensajes

Como nuestra clase implementa el interface javax.jms.MessageListener, debemos crear el método onMessage() que recibe los mensajes que provienen del sistema JMS cuando algún cliente envía un mensaje al tópico. Según vemos en la implementación, el método recibe un mensaje tipo Message, se convierte a un mensaje de tipo texto y obtenemos el texto como cadena para mostrarlo en la consola.

Listado 7.

try {
    TextMessage textMessage = (TextMessage) message;
    String text = textMessage.getText();
    show(text);
} catch (JMSException jmse) {
    jmse.printStackTrace(System.out);
}

Por último examinamos cómo se envian los mensajes al tópico. Simplemente creamos un mensaje tipo texto desde el objeto sesión que corresponde al publicador y establecemos la cadena del mensaje que queremos enviar. A continuación utilizamos el objeto publicador para enviar el mensaje al tópico, como vemos en el listado 8.

Listado 8.

TextMessage message = sesionP.createTextMessage();
message.setText("[" +usuario + "] " + text);
publicador.publish(message);

En el código que acompaña a este artículo podemos observar que en los imports no se hace referencia a ninguna clase específica de JMS, únicamente al obtener el contexto inicial JNDI es donde especificamos datos propios de OpenJMS, pero incluso esto lo hemos aislado en una variable estática, el código fácilmente puede ser adaptado para que lea dichos datos de un archivo .properties externo, por ejemplo.

Figura 4. Ejecución del ejemplo en Eclipse


Figura 4
Para compilar y ejecutar el ejemplo, además del fuente necesitaremos incluir la API JMS y la implementación OpenJMS para el cliente. Los archivos .jar que vamos a necesitar son los siguientes:
  1. jms-1.0.2a.jar. API JMS
  2. openjms-client-0.7.6.1.jar. Implementación para clientes OpenJMS

Ejecutar el ejemplo

Para ejecutar el ejemplo, ofrecemos tres opciones:
  1. Importar el proyecto en el IDE Eclipse
  2. Utilizar Ant para compilar, crear el javadoc y ejecutarlo
  3. Utilizar un script .bat (.sh para Linux) para ejecutarlo
Para importar el proyecto a Eclipse, utilizaremos la opción “Import” del menú “File”, y especificaremos que se trata de un proyecto externo. También podemos copiar el directorio dentro del workspace de Eclipse, y crear un nuevo proyecto Java con el mismo nombre, para que sea reconocido dentro del editor.
Para aquellos lectores familiarizados con Ant (http://ant.apache.org) el ejemplo viene con el script correspondiente con el que podremos compilar, ejecutar el ejemplo e incluso crear el javadoc.
Por último, para hacerlo más sencillo, proporcionamos los scripts para la ejecución del ejemplo desde consola: run.bat (Windows) y run.sh (Linux). Deberemos proporcionar los parámetros necesarios a estos scripts, según se ha explicado.

Conclusiones

Hasta la llegada de JMS, cada proveedor de mensajería definía su propia API. Mientras que cada solución tenía sus propios protocolos, la similitud lógica entre las distintas versiones eran las mismas. Esto hizo posible la existencia de JMS para estandarizar de alguna forma el desarrollo de sistemas de mensajería.

JMS se convierte en una API simple y a la vez robusta, para la implementación en nuestras aplicaciones de este tipo de sistemas, con la ventaja de que existen soluciones Open Source ya maduras como OpenJMS que podemos utilizar de una forma productiva.

PERL

#!\bin\perl\pmw
print"Hola,Mundo!\n";


#!/usr/local/bin/perl
print("Cual es tu nombre?");
$nombre=<STDIN>;
chop($nombre);
print"Hola, $nombre!\n";


#!/usr/bin/perl -w
print ("Hello, world!\n");


#!/usr/bin/perl

use Getopt::Long;
use File::Basename;
use Config;
use strict;

use PPM;

$PPM::VERSION = "2.1.1";

my %help;

# mapping of POD sections to command topics
my %topic = (
    'Error Recovery' => 'genconfig',
    'Installing'     => 'install',
    'Querying'       => 'query',
    'Removing'       => 'remove',
    'Searching'      => 'search',
    'Summarizing'    => 'summary',
    'Verifying'      => 'verify',
    'Synopsis'       => 'usage',
    'Options'        => 'set',
);

$help{'help'} = <<'EOT';
Commands:
    exit              - leave the program.
    help [command]    - prints this screen, or help on 'command'.
    install PACKAGES  - installs specified PACKAGES.
    quit              - leave the program.
    query [options]   - query information about installed packages.
    remove PACKAGES   - removes the specified PACKAGES from the system.
    search [options]  - search information about available packages.
    set [options]     - set/display current options.
    verify [options]  - verifies current install is up to date.
    version           - displays PPM version number

EOT

# Build the rest of the online help from the POD
$/ = "\n=";
while (<DATA>) {
    next unless my ($topic,$text) = /^(?:item|head[12]) ([^\n]+)\n\n(.*)=/s;
    next unless $topic{$topic};
    ($help{$topic{$topic}} = "\n$text"); # =~ s/\n *([^\n])/\n    $1/sg;
}
$/ = "\n";

# Need to do this here, because the user's config file is probably
# hosed.
if ($#ARGV == 0 && $ARGV[0] eq 'genconfig') {
    &genconfig;
    exit 0;
}

my %options = PPM::GetPPMOptions();
my $location;

my $moremsg = "[Press return to continue]";
my $interactive = 0;

my %repositories = PPM::ListOfRepositories();

my $prefix_pattern = $^O eq "MSWin32" ? '(--|-|\+|/)' : '(--|-|\+)';

Getopt::Long::Configure("prefix_pattern=$prefix_pattern");

if ($#ARGV == -1 || ($#ARGV == 0 && $ARGV[0] =~ /^${prefix_pattern}location/)) {
    my $prompt = 'PPM> ';
    $interactive = 1;
    GetOptions("location=s" => \$location);

    print "PPM interactive shell ($PPM::VERSION) - type 'help' for available commands.\n";
    $| = 1;
    while () {
        print $prompt;
        last unless defined ($_ = <> );
        chomp;
        s/^\s+//;
        s/::/-/g;
        @ARGV = split(/\s+/, $_);
        next unless @ARGV;
        # exit/quit
        if (command($ARGV[0], "qu|it") or command($ARGV[0], "|exit")) {
            print "Quit!\n";
            last;
        }
        exec_command();
    }
    exit 0;
}

exit exec_command();

sub exec_command
{
    my $cmd = lc shift @ARGV;

    # help
    if (command($cmd, "|help")) {
        help(@ARGV);
    }
    # query
    elsif (command($cmd, "qu|ery")) {
        GetOptions("case!" => \my $case, "abstract" => \my $abstract, 
        "author" => \my $author );

        my %summary = InstalledPackageProperties();
        if (@ARGV) {
            my $searchtag;
            if ($abstract || $author) {
                $searchtag = ($abstract ? 'ABSTRACT' : 'AUTHOR');
            }
            my $RE = shift @ARGV;
            eval { $RE =~ /$RE/ };
            if ($@) {
                print "'$RE': invalid regular expression.\n";
                return 1;
            } 
            $case = !$options{'IGNORECASE'} unless defined $case;
            $RE = "(?i)$RE" if ($case == 0);
            foreach(keys %summary) {
                if ($searchtag) {
                    delete $summary{$_} unless $summary{$_}{$searchtag} =~ /$RE/;
                }
                else {
                    delete $summary{$_} unless /$RE/;
                }
            }
        }
        print_formatted(1, %summary);
    }
    # install
    elsif (command($cmd, "in|stall")) {
        my $location = $location;
        GetOptions("location=s" => \$location);
        unless (@ARGV) {
            if (!$interactive && -d "blib" && -f "Makefile") {
                return if InstallPackage(location => $location);
                print "Error installing blib: $PPM::PPMERR\n";
                return 1;
            }
            print "Package not specified.\n";
            return 1;
        }
        foreach my $package (@ARGV) {
            $package =~ s/::/-/g;
            if ($interactive && $options{'CONFIRM'}) {
                print "Install package '$package?' (y/N): ";
                next unless <> =~ /^[yY]/;
            }
            print "Retrieving package '$package'...\n";
            if(!InstallPackage("package" => $package, "location" => $location)) {
                print "Error installing package '$package': $PPM::PPMERR\n";
            }
        }
    }
    # remove
    elsif (command($cmd, "|remove")) {
        unless (@ARGV) {
            print "Package not specified.\n";
            return 1;
        }
        foreach my $package (@ARGV) {
            $package =~ s/::/-/g;
            if ($interactive && $options{'CONFIRM'}) {
                print "Remove package '$package?' (y/N): ";
                next unless <> =~ /[yY]/;
            }
            unless (RemovePackage("package" => $package)) {
                print "Error removing $package: $PPM::PPMERR\n";
            }
        }
    }
    # search
    elsif (command($cmd, "se|arch")) {
        my (%summary, $searchtag);
        my $location = $location;
        GetOptions("case!" => \my $case, "location=s" => \$location, 
            "abstract" => \my $abstract, "author" => \my $author );
        my $searchRE = shift @ARGV;
        if (defined $searchRE) {
            eval { $searchRE =~ /$searchRE/ };
            if ($@) {
                print "'$searchRE': invalid regular expression.\n";
                return 1;
            }
        }
        $case = !$options{'IGNORECASE'} unless defined $case;
        if ($abstract || $author) {
            $searchtag = ($abstract ? 'ABSTRACT' : 'AUTHOR');
        }
        %summary = search_PPDs("location" => $location, "ignorecase" => !$case,
            "searchtag" => $searchtag, "searchRE" => $searchRE);
        foreach (keys %summary) {
            print "Packages available from $_:\n";
            print_formatted(2, %{$summary{$_}});
        }
    }
    # set
    elsif (command($cmd, "se|t")) {
        unless (set(@ARGV) || $interactive) {
            PPM::SetPPMOptions("options" => \%options, "save" => 1);
        }
    }
    # verify
    elsif (command($cmd, "ver|ify")) {
        my $location = $location;
        GetOptions("force" => \my $force, "location=s" => \$location, 
            "upgrade" => \my $upgrade);
        if ($interactive && $upgrade && $options{'CONFIRM'}) {
            printf "Upgrade package%s? (y/N): ", @ARGV == 1 ? " '$ARGV[0]'" : "s";
            return unless <> =~ /^[yY]/;
        }
        verify_packages("packages" => \@ARGV, "location" => $location, 
            "upgrade" => $upgrade, "force" => $force);
    }
    elsif (command($cmd, "ver|sion")) {
        print "$PPM::VERSION\n";
    }
    elsif ($cmd eq "purge") {
        my %summary = InstalledPackageProperties();
        foreach(keys %summary) {
            print "Purging $_\n";
            RemovePackage("package" => $_, "force" => 1);
        }
    }
    elsif ($cmd eq 'refresh') {
        my %summary = InstalledPackageProperties();
        foreach(keys %summary) {
            print "Refreshing $_\n";
            InstallPackage("package" => $_);
        }
    }
    else {
        print "Unknown or ambiguous command '$cmd'; type 'help' for commands.\n";
    }
}

sub help {
    my $topic = @_ && $help{lc $_[0]} ? lc $_[0] : 'help';
    my $help = $help{$topic};
    $help =~ s/^(\s*)ppm\s+/$1/mg if $interactive;
    print $help;
}

sub more
{
    my ($lines) = shift @_;
    if (++$$lines >= $options{'MORE'}) {
        print $moremsg;
        $_ = <>;
        $$lines = 1;
    }
}

# This nasty piece of business splits $pattern into a required prefix 
# and a "match any of this substring" suffix.  E.g. "in|stall" will
# match a $cmd of "ins", "inst", ..., "install".
sub command
{
    my ($cmd, $pattern) = @_;
    my @pattern = split(/\|/, $pattern);
    if ($pattern[1]) {
        my @optchars = split(//, $pattern[1]);
        # build up a "foo(b|ba|bar)" string
        $pattern = "$pattern[0](";
        $pattern[1] = shift @optchars;
        $pattern[1] .= "|$pattern[1]$_" foreach @optchars;
        $pattern .= "$pattern[1])";
    }
    return ($cmd =~ /^${pattern}$/i);
}

# This routine prints the output for query and search
# in a nicely formatted way, if $options{'VERBOSE'} is set.
sub print_formatted
{
    my ($lines, %summary) = @_;
    my $package;

    unless ($options{'VERBOSE'}) {
        foreach $package (sort keys %summary) {
            print "$package\n";
            &more(\$lines) if $options{'MORE'};
        }
        return;
    }

    my ($maxname, $maxversion) = (0, 0);
    # find the longest package name and version strings, so we can
    # format them nicely
    $maxname < length($_) and $maxname = length($_) for keys %summary;
    foreach $package (keys %summary) {
        $summary{$package}{'VERSION'} =~ s/(,0)*$//;
        $summary{$package}{'VERSION'} =~ tr/,/./;
        $maxversion = length $summary{$package}{'VERSION'} > $maxversion ? 
            length $summary{$package}{'VERSION'} : $maxversion;
    }
    my $columns = $ENV{COLUMNS} ? $ENV{COLUMNS} : 80;
    my $namefield = "@" . "<" x ($maxname - 1);
    my $versionfield = "@" . "<" x ($maxversion - 1);
    my $abstractfield = "^" . "<" x ($columns - (6 + $maxname + $maxversion));
    my $abstractpad = " " x ($maxname + $maxversion + 3);

    foreach $package (sort keys %summary) {
        eval "format STDOUT = \n"
                   . "$namefield [$versionfield] $abstractfield\n"
                   . '$package, $summary{$package}{VERSION}, $summary{$package}{ABSTRACT}'
                   . "\n"
                   . "$abstractpad $abstractfield~~\n"
                   . '$summary{$package}{ABSTRACT}' 
                   . "\n"
                   . ".\n";

        my $diff = $-;
        write;
        $diff -= $-;
        $lines += ($diff - 1) if $diff > 1;
        &more(\$lines) if $options{'MORE'};
    }
}

sub set
{
    my $option = lc shift @_; 

    unless ($option) {
        print "Commands will " . ($options{'CONFIRM'} ? "" : "not ") . 
            "be confirmed.\n";
        print "Temporary files will " . ($options{'CLEAN'} ? "" : "not ") .
            "be deleted.\n";
        print "Case-" . ($options{'IGNORECASE'} ? "in" : "") . 
            "sensitive searches will be performed.\n";
        print "Package installations will " . 
            ($options{'FORCE_INSTALL'} ? "" : "not ") .
               "continue if a dependency cannot be installed.\n";
        print "Tracing info will " . (($options{'TRACE'} > 0 ) ? 
            "be written to '$options{'TRACEFILE'}'.\n" : "not be written.\n");
        print "Screens will " . ($options{'MORE'} > 0 ? 
            "pause after $options{'MORE'} lines.\n" : "not pause.\n");
        print "Query/search results will " . 
            ($options{'VERBOSE'} ? "" : "not ") . "be verbose.\n";
        if (defined $location) { print "Current PPD repository: $location\n"; }
        else {
            print "Current PPD repository paths:\n";
            my $location;
            foreach $_ (keys %repositories) {
                print "\t$_: $repositories{$_}\n";
            }
        }
        print "Packages will be installed under: $options{'ROOT'}\n" 
            if ($options{'ROOT'});
        print "Packages will be built under: $options{'BUILDDIR'}\n" 
            if ($options{'BUILDDIR'});
        return;
    }

    my $value = shift @_;
    if (command($option, "r|epository")) {
        if ($value =~ /${prefix_pattern}remove/i) {
            $value = join(" ", @_);
            print "Location not specified.\n" and return 1 
                unless (defined $value);
            PPM::RemoveRepository("repository" => $value);
            %repositories = PPM::ListOfRepositories();
        }
        else {
            my $location = shift @_;
            print "Repository not specified.\n" and return 1
                unless (defined $value and defined $location);
            PPM::AddRepository("repository" => $value,
                "location" => $location);
            %repositories = PPM::ListOfRepositories();
        }
    }
    else {
        if (command($option, "c|onfirm")) {
            $options{'CONFIRM'} = defined $value ? 
                ($value != 0) : ($options{'CONFIRM'} ? 0 : 1);
            print "Commands will " . ($options{'CONFIRM'} ? "" : "not ") . 
                "be confirmed.\n";
        }
        elsif (command($option, "|save")) {
            PPM::SetPPMOptions("options" => \%options, "save" => 1);
            return 0;
        }
        elsif (command($option, "c|ase")) {
            $options{'IGNORECASE'} = defined $value ? 
                ($value == 0) : ($options{'IGNORECASE'} ? 0 : 1);
            print "Case-" . ($options{'IGNORECASE'} ? "in" : "") . 
                "sensitive searches will be performed.\n";
        }
        elsif (command($option, "r|oot")) {
            my $old_root;
            print "Directory not specified.\n" and return 1 unless ($value);
            print "$PPM::PPMERR" and return 1
                    unless ($old_root = PPM::chroot("location" => $value));
            $options{'ROOT'} = $value;
            print "Root is now $value [was $old_root].\n";
        }
        elsif (command($option, "|build")) {
            print "Directory not specified.\n" and return 1 unless ($value);
            print "Directory '$value' does not exist.\n" and return 1 
                unless (-d $value);
            $options{'BUILDDIR'} = $value;
            print "Build directory is now $value.\n";
        }
        elsif (command($option, "|force_install")) {
            $options{'FORCE_INSTALL'} = defined $value ? ($value != 0) : 
                ($options{'FORCE_INSTALL'} ? 0 : 1);
            print "Package installations will " .
                  ($options{'FORCE_INSTALL'} ? "" : "not ") .
                  "continue if a dependency cannot be installed.\n";
        }
        elsif (command($option, "c|lean")) {
            $options{'CLEAN'} = defined $value ? 
                ($value != 0) : ($options{'CLEAN'} ? 0 : 1);
            print "Temporary files will " . ($options{'CLEAN'} ? "" : "not ") . 
                "be deleted.\n";
        }
        elsif (command($option, "|more")) {
            print "Numeric value must be given.\n" and return 1
                unless (defined $value && $value =~ /^\d+$/);
            $options{'MORE'} = $value;
            print "Screens will " . ($options{'MORE'} > 0 ? 
                "pause after $options{'MORE'} lines.\n" : "not pause.\n");
        }
        elsif (command($option, "trace|file")) {
            print "Filename not specified.\n" and return 1 unless ($value);
            $options{'TRACEFILE'} = $value;
            print "Tracing info will be written to $options{'TRACEFILE'}.\n";
        }
        elsif (command($option, "trace")) {
            print "Numeric value between 0 and 4 must be given.\n" and return 1
                unless (defined $value && 
                    $value =~ /^\d+$/ && $value >= 0 && $value <= 4);
            $options{'TRACE'} = $value;
            print "Tracing info will " . ($options{'TRACE'} > 0 ? 
                "be written to $options{'TRACEFILE'}.\n" : "not be written.\n");
        }
        elsif (command($option, "|verbose")) {
            $options{'VERBOSE'} = defined $value ? 
                ($value != 0) : ($options{'VERBOSE'} ? 0 : 1);
            print "Query/search results will " . 
                ($options{'VERBOSE'} ? "" : "not ") . "be verbose.\n";
        }
        else {
            print "Unknown or ambiguous option '$option'; see 'help set' for available options.\n";
            return 1;
        }
        PPM::SetPPMOptions("options" => \%options);
    }
    return;
}

sub search_PPDs
{
    my %argv = @_;
    my $location = $argv{'location'} || $location;
    my $searchtag = $argv{'searchtag'};
    my $ignorecase = defined $argv{'ignorecase'} ? 
        $argv{'ignorecase'} : $options{'IGNORECASE'};
    my $searchRE = $argv{'searchRE'};
    if (defined $searchRE) {
        eval { $searchRE =~ /$searchRE/ };
        if ($@) {
            print "'$searchRE': invalid regular expression.\n";
            return;
        }
        $searchRE = "(?i)$searchRE" if $ignorecase;
    }

    my %packages;
    my %ppds = PPM::RepositoryPackages("location" => $location);
    foreach my $loc (keys %ppds) {
        next if $#{$ppds{$loc}} == -1;
        # see if a summary file is available
        my %summary = RepositorySummary("location" => $loc);
        if (%summary) {
            foreach my $package (keys %{$summary{$loc}}) {
                next if (defined $searchtag && 
                    $summary{$loc}{$package}{$searchtag} !~ /$searchRE/);
                next if (!defined $searchtag && 
                    defined $searchRE && $package !~ /$searchRE/);
                $packages{$loc}{$package} = \%{$summary{$loc}{$package}};
            }
        }
        else {
            # No summary: oh my, nothing but 'Net
            foreach my $package (@{$ppds{$loc}}) {
                my %package_details = RepositoryPackageProperties(
                    "package" => $package, "location" => $loc);
                next unless %package_details;
                next if (defined $searchtag && 
                    $package_details{$searchtag} !~ /$searchRE/);
                next if (!defined $searchtag && 
                    defined $searchRE && $package !~ /$searchRE/);
                $packages{$loc}{$package} = \%package_details;
            }
        }
    }
    return %packages;
}

sub verify_packages
{
    my (%argv) = @_;
    my ($arg, @packages, $upgrade, $force);
    my $location = $location;
    foreach $arg (keys %argv) {
        if ($arg eq 'packages') { @packages = @{$argv{$arg}}; }
        if ($arg eq 'location') { $location = $argv{$arg}; }
        if ($arg eq 'upgrade') { $upgrade = $argv{$arg}; }
        if ($arg eq 'force') { $force = $argv{$arg}; }
    }
    unless ($packages[0]) {
        my ($i, %info);

        @packages = ();
        %info = QueryInstalledPackages();
        foreach $i (keys %info) {
            push @packages, $i;
        }
    }

    my $package = shift @packages;
    while ($package) {
        my $status = VerifyPackage("package" => $package, 
            "location" => $location, "upgrade" => $upgrade, "force" => $force);
        if (defined $status) {
            if ($status eq "0") {
                print "Package \'$package\' is up to date.\n";
            }
            elsif ($upgrade) {
                print "Package $package upgraded to version $status\n";
            }
            else {
                print "An upgrade to package \'$package\' is available.\n";
            }
        }
        else {
#            print "Error verifying $package: $PPM::PPMERR\n";
        }
        $package = shift @packages;
    }
}

sub genconfig
{
my $PerlDir = $Config{'prefix'};
print <<"EOF";
<PPMCONFIG>
    <PPMVER>2,1,0,0</PPMVER>
    <PLATFORM CPU="x86" OSVALUE="$Config{'osname'}" OSVERSION="0,0,0,0" />
    <OPTIONS BUILDDIR="$ENV{'TEMP'}" CLEAN="1" CONFIRM="1" FORCEINSTALL="1" IGNORECASE="1" MORE="0" ROOT="$PerlDir" TRACE="0" TRACEFILE="PPM.LOG" VERBOSE="1" />
    <REPOSITORY LOCATION="soap://www.ActiveState.com/cgibin/SOAP/ppmserver.plex?class=PPM::SOAPServer" NAME="ActiveState Package Repository" SUMMARYFILE="fetch_summary"/>
    <PPMPRECIOUS>Compress-Zlib;Archive-Tar;Digest-MD5;File-CounterFile;Font-AFM;HTML-Parser;HTML-Tree;MIME-Base64;URI;XML-Element;libwww-perl;XML-Parser;SOAP;PPM;libnet;libwin32</PPMPRECIOUS>
</PPMCONFIG>
EOF
}

__DATA__

=head1 NAME

PPM - Perl Package Manager: locate, install, upgrade software packages.

=head1 SYNOPSIS

 ppm genconfig
 ppm help [command]
 ppm install [--location=location] package1 [... packageN]
 ppm query [--case|nocase] [--abstract|author] PATTERN
 ppm remove package1 [... packageN]
 ppm search [--case|nocase] [--location=location] [--abstract|author] PATTERN
 ppm set [option]
 ppm verify [--location=location] [--upgrade] [--force] [package1 ... packageN]
 ppm version
 ppm [--location=location]

=head1 DESCRIPTION

ppm is a utility intended to simplify the tasks of locating, installing,
upgrading and removing software packages.  It is a front-end to the
functionality provided in PPM.pm.  It can determine if the most recent
version of a software package is installed on a system, and can install
or upgrade that package from a local or remote host.

ppm runs in one of two modes: an interactive shell from which commands
may be entered; and command-line mode, in which one specific action is
performed per invocation of the program.

ppm uses files containing an extended form of the Open Software
Description (OSD) specification for information about software packages.
These description files, which are written in Extensible Markup
Language (XML) code, are referred to as 'PPD' files.  Information about
OSD can be found at the W3C web site (at the time of this writing,
http://www.w3.org/TR/NOTE-OSD.html).  The extensions to OSD used by ppm
are documented in PPM.ppd.

=head1 Using PPM

=over 4

=item Interactive mode

If ppm is invoked with no command specified, it is started in interactive
mode.  If the '--location' argument is specified, it is used as the
search location, otherwise the repositories specified in the PPM data file
are used. 

The syntax of PPM commands is the same in interactive mode as it is in
command-line mode.  The 'help' command lists the available commands.

ppm commands may be abbreviated to their shortest unique form.

=item Installing

 ppm install [--location=location] package1 [... packageN]

Installs the specified software packages. Attempts to install from the 
URL or directory 'location' if the '--location' option is specfied. 

The 'package' arguments may be either package names ('foo'), pathnames 
(p:/packages/foo.ppd) or URLs (http://www.ActiveState.com/packages/foo.ppd)
to specific PPD files.

In the case where a package name is specified, and the '--location'
option is not used, ppm will refer to the default repository locations.

See also: 'confirm' option.

=item Removing

 ppm remove package1 [... packageN]

Reads information from the PPD file for the named software package and
removes the package from the system.

See also: 'confirm' option.

=item Verifying

 ppm verify [--location=location] [--upgrade] [--force] [package1 ... packageN]

Verifies that the currently installed packages are up to date.  If no
packages are specified as arguments, all installed packages will be verified.

If the '--upgrade' option is specified, any package for which an upgrade 
is available will be upgraded.  

If the '--location' option is specified, upgrades will be looked for at 
the specified URL or directory.

If the '--force' option is specified, all currently installed packages will 
be reinstalled regardless of whether they are out of date or not.

See also: 'confirm' option.

=item Querying

 ppm query [--case|nocase] [--abstract|author] PATTERN

Searches for 'PATTERN' (a regular expression) in the name of any installed 
package.  If a search is successful, information about the matching 
package(s) is displayed.  If 'PATTERN' is omitted, information about
all installed packages will be displayed.

If either '--abstract' or '--author' is specified, PATTERN will be 
searched for in the <ABSTRACT> or <AUTHOR> tags of the installed packages.

The '--case' and '--nocase' options can be used to override the default
case-sensitivity search settings.

See also: 'case' option.

=item Searching

 ppm search [--case|nocase] [--location=location] [--abstract|author] PATTERN

Displays a list of any packages matching 'PATTERN' (a regular expression)
available from the specified location.  If 'PATTERN' is omitted, information 
about all available packages will be displayed.

If the '--location' option is specified, the specified URL or directory
will be searched.  If '--location' is not specified, the repository location 
as specified in the PPM data file will be searched.

If either '--abstract' or '--author' is specified, PATTERN will be 
searched for in the <ABSTRACT> or <AUTHOR> tags of the available packages.

The '--case' and '--nocase' options can be used to override the default
case-sensitivity search settings.

See also: 'case' option.

=item Error Recovery

 ppm genconfig

This command will print a valid PPM config file (ppm.xml) to STDOUT.  This 
can be useful if the PPM config file ever gets damaged leaving PPM
unusable.

If required, this command should be run from a shell prompt:

    C:\Perl\site\lib> ppm genconfig > ppm.xml

=item Options

 ppm set [option value]

Sets or displays current options.  With no arguments, current option
settings are displayed.

Available options:

    build DIRECTORY
        - Changes the package build directory.

    case [1|0]
        - Sets case-sensitive searches.  If one of '1' or '0' is
          not specified, the current setting is toggled.

    clean [1|0]
        - Sets removal of temporary files from package's build 
          area, on successful installation of a package.  If one of
          '1' or '0' is not specified, the current setting is
          toggled.

    confirm [1|0]
        - Sets confirmation of 'install', 'remove' and 'upgrade'.
          If one of '1' or '0' is not specified, the current
          setting is toggled.

    force_install [1|0]
        - Continue installing a package even if a dependency cannot
          be installed.

    more NUMBER
        - Causes output to pause after NUMBER lines have been
          displayed.  Specifying '0' turns off this capability.

    set repository --remove NAME
        - Removes the repository 'NAME' from the list of repositories.

    set repository NAME LOCATION
        - Adds a repository to the list of PPD repositories for this
          session.  'NAME' is the name by which this repository will
          be referred; 'LOCATION' is a URL or directory name.

    root DIRECTORY
        - Changes the install root directory.  Packages will be
          installed under this new root.

    save
        - Saves the current options as default options for future
          sessions.

    trace
        - Tracing level--default is 1, maximum is 4, 0 indicates
          no tracing.

    tracefile
        - File to contain tracing information, default is 'PPM.LOG'.

    verbose [1|0]
        - Display additional package information for 'query' and
          'search' commands.

=head1 EXAMPLES

=over 4

=item ppm

Starts ppm in interactive mode, using the repository locations specified
in the PPM data file.  A session might look like this:

    [show all available packages]
    PPM> search
    Packages available from P:\PACKAGES:
    bar [2.91 ] supplies bar methods for perl5.
    bax [0.072] module for manipulation of bax archives.
    baz [1.03 ] Interface to baz library
    foo [2.23 ] Foo parser class
    
    [list what has already been installed]
    PPM> query
    bax [0.071] module for manipulation of bax archives.
    baz [1.02 ] Interface to baz library
    
    [install a package]
    PPM> install foo
    Install package foo? (y/N): y
    [...]
    
    [toggle confirmations]
    PPM> set confirm
    Commands will not be confirmed.
    
    [see if 'baz' is up-to-date]
    PPM> verify baz
    An upgrade to package 'baz' is available.
    
    [upgrade 'baz']
    PPM> verify --upgrade baz
    [...]
    
    [forced upgrade of 'baz']
    PPM> verify --upgrade --force baz
    [...]
    
    [toggle case-sensitive searches]
    PPM> set case
    Case-sensitive searches will be performed.
    
    [display all available packages beginning with 'b']
    PPM> search ^b
    bar [2.91 ] supplies bar methods for perl5.
    bax [0.072] module for manipulation of bax archives.
    baz [1.03 ] Interface to baz library
    
    [search for installed packages containing 'baz' in the ABSTRACT tag]
    PPM> query --abstract baz
    Matching packages found at P:\PACKAGES:
    baz [1.03 ] Interface to baz library
    PPM> quit

=item ppm install http://www.ActiveState.com/packages/foo.ppd

Installs the software package 'foo' based on the information in the PPD
obtained from the specified URL.

=item ppm verify --upgrade foo

Compares the currently installed version of the software package 'foo'
to the one available according to the PPD obtained from the location
specified for this package in the PPM data file, and upgrades
to a newer version if available.

=item ppm verify --location=P:\PACKAGES --upgrade foo

Compares the currently installed version of the software package 'foo'
to the one available according to the PPD obtained from the specified
directory, and upgrades to a newer version if available.

=item ppm verify --upgrade --force

Forces verification and reinstalls every installed package on the system, 
using upgrade locations specified in the PPM data file.

=item ppm search --location=http://www.ActiveState.com/packages

Displays the packages with PPD files available at the specified location.

=item ppm search --location=P:\PACKAGES --author ActiveState

Searches the specified location for any package with an <AUTHOR> tag
containing the string 'ActiveState'.  On a successful search, the package
name and the matching string are displayed.

=back

=head1 ENVIRONMENT VARIABLES

=over 4

=item HTTP_proxy

If the environment variable 'HTTP_proxy' is set, then it will
be used as the address of a proxy server for accessing the Internet.

The value should be of the form: 'http://proxy:port'.

=back

=head1 FILES

The following files are fully described in the 'Files' section of PPM:ppm.

=over 4

=item package.ppd

A description of a software package, in extended Open Software Description
(OSD) format.  More information on this file format can be found in
PPM::ppd.

=item ppm.xml - PPM data file.

An XML format file containing information about the local system,
specifics regarding the locations from which PPM obtains PPD files, and
the installation details for any package installed by ppm.

This file usually resides in '[perl]/site/lib'.  If the environment 
variable 'PPM_DAT' is set, its value will be used as the full pathname
to a PPM data file.  If all else fails, ppm will look for a data file
in the current directory.

=back

=head1 AUTHOR

Murray Nesbitt, E<lt>F<murray@ActiveState.com>E<gt>

=head1 CREDITS

Thanks to my colleague and friend Jan Dubois E<lt>F<jand@ActiveState.com>E<gt>.

=cut

histograma C++

#include <stdio.h>
#include <stdlib.h>
#define SIZE 10
int v1,v2,v3,v4,v5,v6,v7,v8,v9,v10;
char*prod[]={"Dulces","Palomitas","Cigarros","Galletas","Churritos","Refrescos","Agua","Chicles","Halls","Chocolates"};


main (int argc, char* argv[])
{
int x;
printf("1. Facturación,    2.Histograma\n");
scanf("%d", &x);
if (x==1)
{
printf("Entramos en Facturación\n");

printf("Dulces:     \n");
scanf("%d",&v1);
printf("Palomitas:  \n");
scanf("%d",&v2);
printf("Cigarros:   \n");
scanf("%d",&v3);
printf("Galletas:   \n");
scanf("%d",&v4);
printf("Churritos:  \n");
scanf("%d",&v5);
printf("Refrescos:  \n");
scanf("%d",&v6);
printf("Agua:       \n");
scanf("%d",&v7);
printf("Chicles:    \n");
scanf("%d",&v8);
printf("Halls:      \n");
scanf("%d",&v9);
printf("Chocolates: \n");
scanf("%d",&v10);


int n[SIZE]={v1,v2,v3,v4,v5,v6,v7,v8,v9,v10};
int i,j;

printf("%s%13s%23s%27s\n","CLAVE","PRODUCTO","CANTIDAD","PRECIO", "IMPORTE");
for (i=0;i<=SIZE-1;i++)
{
printf("%7d%13s%17d                    ",i,prod[i],n[i]);
// printf("precio\n");
for(j=1;j<=n[i];j++){
switch(i){
case 0 :printf("10  \n");
break;
case 1: printf("20\n");
break;
case 2: printf("20\n");
break;
case 3: printf("30\n");
break;
case 4: printf("40\n");
break;
case 5: printf("50\n");
break;
case 6: printf("60\n");
break;
case 7: printf("70\n");
break;
case 8: printf("80\n");
break;
case 9: printf("90\n");
break;



printf("\n");
}
}
//return 0;


}
}

else
{
printf("Entramos a histograma\n");

printf("Dulces:     \n");
scanf("%d",&v1);
printf("Palomitas:  \n");
scanf("%d",&v2);
printf("Cigarros:   \n");
scanf("%d",&v3);
printf("Galletas:   \n");
scanf("%d",&v4);
printf("Churritos:  \n");
scanf("%d",&v5);
printf("Refrescos:  \n");
scanf("%d",&v6);
printf("Agua:       \n");
scanf("%d",&v7);
printf("Chicles:    \n");
scanf("%d",&v8);
printf("Halls:      \n");
scanf("%d",&v9);
printf("Chocolates: \n");
scanf("%d",&v10);


int n[SIZE]={v1,v2,v3,v4,v5,v6,v7,v8,v9,v10};
int i,j;

printf("%s%13s%13s%17s\n","CLAVE","PRODUCTO","CANTIDAD","HISTOGRAMA");
for (i=0;i<=SIZE-1;i++)
{
printf("%7d%13s%7d                    ",i,prod[i],n[i]);
for(j=1;j<=n[i];j++){
printf("%c",'$');
printf("\n");
}
//return 0;


}
}
system("pause");
}

Encrypt/Decrypt module for SuperPro (Clipper)


/*****************************************************************************
*
*       Encrypt/Decrypt module for SuperPro (Clipper)
*
*
(C) Copyright 1986-1994 Rainbow Technologies, Inc. All rights reserved.
*
*****************************************************************************/

/*============================ V a r i a b l e s ===========================*/
static unsigned char      far  *CodePtr; /* Ptr. to byte to encrypt/decrypt */
static unsigned short int far  *wordPtr; /* Points to a word                */
static unsigned short int       tXseed;  /* Temp for encrypt/decrypt seed   */
static unsigned short int       tCount;  /* Temp for Xcount                 */
static unsigned short int       tMod;    /* Seed's adjustment value         */
static unsigned char            tSwap;   /* Temp for swapping bytes         */
/*==========================================================================*/

/****************************************************************************/
/* This subroutine sets up the variable tCount to contain the # of bytes of */
/* the SuperPro driver that are to be encrypted. This is done as follows:   */
/*   If Xcount is not 0, then tCount is just a copy of Xcount.              */
/*   If Xcount is 0, tCount is the number of bytes between Xstart and the   */
/*   last byte of the driver including both of those bytes.                 */
/****************************************************************************/
void DoMacroCore(unsigned int startX, unsigned int countX)
{
  wordPtr = ((unsigned short int far *)SUPERPRO) - 2;
                   /* Point 2 words (4 bytes) before the SuperPro entry     */
                   /* point. This word is used to decrypt the next word     */
                   /* in order to get the length of the SuperPro driver.    */

  tCount = *wordPtr;    /* Use this value to decrypt the SuperPro length.   */
  wordPtr++;            /* Advance 1 word (to the SuperPro length).         */
  tCount ^= *wordPtr;   /* tCount is now the length of the SuperPro driver  */

  if (countX == 0)
  {                     /* If 0, get the number of bytes from startX to     */
    tCount -= startX;   /* the end of the SuperPro driver (inclusive).      */
                        /* Note: we do not need to add 1 to this result     */
                        /* because tCount is 1-based and startX is 0-based. */
  }
  else
  {
    tCount = countX;    /* Not 0, so tCount gets what the user gave us      */
  }
}


/****************************************************************************/
/* Subroutine for Encrypting, by Xoring each byte with a seed.              */
/* None of the parameters are modified.                                     */
/****************************************************************************/
int CryptX(unsigned int Xseed, unsigned int Xmod,
        unsigned int Xstart, unsigned int Xcount)
{
  DoMacroCore(_parni(3), _parni(4));

  tXseed = _parni(1);
  tMod   = _parni(2);

  CodePtr = (unsigned char far *)(SUPERPRO) + _parni(3);
                        /* Point at 1st byte in SuperPro driver to encrypt  */
  while (tCount > 0)
  {
    *CodePtr ^= tXseed; /* Encrypt byte in SuperPro driver.                 */
    CodePtr++;          /* Point to next byte.                              */
    tXseed += tMod;     /* Modify seed.                                     */
    tCount--;           /* Decrement bytes remaining to be encrypted        */
  }
}


/****************************************************************************/
/* Subroutine for Encrypting, by adding a seed to each byte.                */
/* None of the parameters are modified.                                     */
/****************************************************************************/
int CryptA(unsigned int Xseed, unsigned int Xmod,
        unsigned int Xstart, unsigned int Xcount)
{
  DoMacroCore(_parni(3), _parni(4));

  tXseed = _parni(1);
  tMod   = _parni(2);

  CodePtr = (unsigned char far *)(SUPERPRO) + _parni(3);
                        /* Point at 1st byte in SuperPro driver to encrypt  */
  while (tCount > 0)
  {
    *CodePtr += tXseed; /* Encrypt byte in SuperPro driver.                 */
    CodePtr++;          /* Point to next byte.                              */
    tXseed += tMod;     /* Modify seed.                                     */
    tCount--;           /* Decrement bytes remaining to be encrypted        */
  }
}


/****************************************************************************/
/* Subroutine for Encrypting, by Rotating each byte left or right 1 bit.    */
/* The direction depends upon the current seed value.                       */
/* None of the parameters are modified.                                     */
/****************************************************************************/
int CryptR(unsigned int Xseed, unsigned int Xmod,
        unsigned int Xstart, unsigned int Xcount)
{
  DoMacroCore(_parni(3), _parni(4));

  tXseed = _parni(1);
  tMod   = _parni(2);

  CodePtr = (unsigned char far *)(SUPERPRO) + _parni(3);
                        /* Point at 1st byte in SuperPro driver to encrypt  */
  while (tCount > 0)
  {
    if ((tXseed & 1) == 0)
    {                   /* If tXseed is EVEN then rotate the bits right     */
      *CodePtr = (*CodePtr >> 1) | ((*CodePtr & 1) << 7);
    }
    else
    {                   /* If tXseed is ODD then rotate the bits left       */
      *CodePtr = (*CodePtr << 1) | ((*CodePtr & 0xEF) >> 7);
    }

    CodePtr++;          /* Point to next byte.                              */
    tXseed += tMod;     /* Modify seed.                                     */
    tCount--;           /* Decrement bytes remaining to be encrypted        */
  }
}


/****************************************************************************/
/* Subroutine for Encrypting, by swapping byte pairs. This implies          */
/* that the range to encrypt must be an even number of bytes.               */
/* The seed is not currently used in this method (yet).                     */
/* None of the parameters are modified.                                     */
/****************************************************************************/
int CryptS(unsigned int Xseed, unsigned int Xmod,
        unsigned int Xstart, unsigned int Xcount)
{
  DoMacroCore(_parni(3), _parni(4));

  tXseed = _parni(1);
  tMod   = _parni(2);

  if ((tCount & 1) != 0)         /* If count is odd . . .                   */
  {
    tCount -= 1;                 /* make count even                         */
  }

  CodePtr = (unsigned char far *)(SUPERPRO) + _parni(3);
                        /* Point at 1st byte in SuperPro driver to encrypt  */
  while (tCount > 0)
  {
    tSwap        = *CodePtr;     /* Copy 1st byte of byte pair              */
    *CodePtr     = *(CodePtr+1); /* Move 2nd byte of pair into 1st byte     */
    *(CodePtr+1) = tSwap;        /* Move 1st byte of pair into 2nd byte     */
    CodePtr     += 2;            /* Point to next byte pair.                */
    tXseed      += tMod;         /* Modify seed.                            */
    tCount      -= 2;            /* Decrement bytes left to be encrypted    */
  }
}


/****************************************************************************/
/* Subroutine for Decrypting, by Xoring each byte with a seed.              */
/* None of the parameters are modified.                                     */
/****************************************************************************/
int DecryptX(unsigned int Xseed, unsigned int Xmod,
        unsigned int Xstart, unsigned int Xcount)
{
  DoMacroCore(_parni(3), _parni(4) );

  tXseed = _parni(1);
  tMod   = _parni(2);

  CodePtr = (unsigned char far *)(SUPERPRO) + _parni(3);
                        /* Point at 1st byte in SuperPro driver to encrypt  */
  while (tCount > 0)
  {
    *CodePtr ^= tXseed; /* Encrypt byte in SuperPro driver.                 */
    CodePtr++;          /* Point to next byte.                              */
    tXseed += tMod;     /* Modify seed.                                     */
    tCount--;           /* Decrement bytes remaining to be encrypted        */
  }
}


/****************************************************************************/
/* Subroutine for Decrypting, by Subtracting a seed from each byte.         */
/* None of the parameters are modified.                                     */
/****************************************************************************/
int DecryptA(unsigned int Xseed, unsigned int Xmod,
        unsigned int Xstart, unsigned int Xcount)
{
  DoMacroCore(_parni(3), _parni(4));

  tXseed = _parni(1);
  tMod   = _parni(2);

  CodePtr = (unsigned char far *)(SUPERPRO) + _parni(3);
                        /* Point at 1st byte in SuperPro driver to encrypt  */
  while (tCount > 0)
  {
    *CodePtr -= tXseed; /* Encrypt byte in SuperPro driver.                 */
    CodePtr++;          /* Point to next byte.                              */
    tXseed += tMod;     /* Modify seed.                                     */
    tCount--;           /* Decrement bytes remaining to be encrypted        */
  }
}


/****************************************************************************/
/* Subroutine for Decrypting, by Rotating each byte left or right 1 bit.    */
/* The direction depends upon the current seed value.                       */
/* None of the parameters are modified.                                     */
/****************************************************************************/
int DecryptR(unsigned int Xseed, unsigned int Xmod,
        unsigned int Xstart, unsigned int Xcount)
{
  DoMacroCore(_parni(3), _parni(4));

  tXseed = _parni(1);
  tMod   = _parni(2);

  CodePtr = (unsigned char far *)(SUPERPRO) + _parni(3);
                        /* Point at 1st byte in SuperPro driver to encrypt  */
  while (tCount > 0)
  {
    if ((tXseed & 1) == 1)
    {                   /* If tXseed is ODD then rotate the bits right      */
      *CodePtr = (*CodePtr >> 1) | ((*CodePtr & 1) << 7);
    }
    else
    {                   /* If tXseed is EVEN then rotate the bits left      */
      *CodePtr = (*CodePtr << 1) | ((*CodePtr & 0xEF) >> 7);
    }

    CodePtr++;          /* Point to next byte.                              */
    tXseed += tMod;     /* Modify seed.                                     */
    tCount--;           /* Decrement bytes remaining to be encrypted        */
  }
}


/****************************************************************************/
/* Subroutine for Decrypting, by swapping byte pairs. This implies          */
/* that the range to decrypt must be an even number of bytes.               */
/* The seed is not currently used in this method (yet).                     */
/* None of the parameters are modified.                                     */
/****************************************************************************/
int DecryptS(unsigned int Xseed, unsigned int Xmod,
        unsigned int Xstart, unsigned int Xcount)
{
  DoMacroCore(_parni(3), _parni(4));

  tXseed = _parni(1);
  tMod   = _parni(2);

  if ((tCount & 1) != 0)         /* If count is odd . . .                   */
  {
    tCount -= 1;                 /* make count even                         */
  }

  CodePtr = (unsigned char far *)(SUPERPRO) + _parni(3);
                        /* Point at 1st byte in SuperPro driver to encrypt  */
  while (tCount > 0)
  {
    tSwap        = *CodePtr;     /* Copy 1st byte of byte pair              */
    *CodePtr     = *(CodePtr+1); /* Move 2nd byte of pair into 1st byte     */
    *(CodePtr+1) = tSwap;        /* Move 1st byte of pair into 2nd byte     */
    CodePtr     += 2;            /* Point to next byte pair.                */
    tXseed      += tMod;         /* Modify seed.                            */
    tCount      -= 2;            /* Decrement bytes left to be encrypted    */
  }
}


/****************************************************************************/
/* Subroutine to calculate a Long (32-bit) checksum over a given range.     */
/* The variable replaced by Xsum will be modified. Note that it is up to the*/
/* programmer to make sure this variable has the desired value before using */
/* this subr. (i.e. this subr. does not zero the variable replaced by Xsum  */
/* before using it!)                                                        */
/****************************************************************************/
int ChkSum(unsigned int Xstart, unsigned int Xcount, unsigned long Xsum)
{
  unsigned long sumX;

  sumX = 0;
  DoMacroCore(_parni(1), _parni(2));

  CodePtr = (unsigned char far *)(SUPERPRO) + _parni(1);
                        /* Point at 1st byte in SuperPro driver to checksum */
  while (tCount > 0)
  {
    sumX   += *CodePtr; /* Add byte of SuperPro driver to checksum value.   */
    CodePtr++;          /* Point to next byte.                              */
    tCount--;           /* Decrement bytes remaining to be checksummed      */
  }
  _retnl(sumX);         /* return the LONG checksum value to VB's Xsum var. */
}





*********************************************************************************
************************************************************************************
/****************************************************************************
 *            SuperPro (Clipper) Multiple Entry Points Module               *
    (C) Copyright 1986-1994 Rainbow Technologies, Inc. All rights reserved.
 ****************************************************************************
 * This module provides a method for performing SuperPro API commands so    *
 * so you do not have to deal with command packets.  It provides a function *
 * for each API command.                                                    *
 ****************************************************************************/

#include "superpro.h"           /* include of core driver definitions */
#include "extend.h"             /* for _retni, <others> */

APIPACKET ApiPacket;            /* API Command Packet */
UNITINFO  InitialUI ;

/****************************************************************************
 *
 *  Function: SPROINIT
 *  Purpose : To initialize the SuperPro Driver
 *
 *  Inputs      : NONE
 *  Outputs     : NONE
 *  Return Value: Status
 *
 *  Description : This routine does autotiming and checks for the valid port
 *                addresses based on the values passed in through the API
 *                packet's portAddrs field.
 ****************************************************************************/
int SPROINIT(void)
{
  int   error ;

  ApiPacket.functionCode = API_INITIALIZE;
  ApiPacket.intMode      = DEFAULT_INT_METHODS;
  ApiPacket.portAddrs[0] = 0;   /* DEFAULT_PORT_ADDRESS1; */
  ApiPacket.portAddrs[1] = 0;   /* DEFAULT_PORT_ADDRESS2; */
  ApiPacket.portAddrs[2] = 0;   /* DEFAULT_PORT_ADDRESS3; */
  ApiPacket.portAddrs[3] = 0;   /* DEFAULT_PORT_ADDRESS4; */
  ApiPacket.InitialPICMask1 = DEFAULT_PIC_MASK1;
  ApiPacket.InitialPICMask2 = DEFAULT_PIC_MASK2;
  error = SUPERPRO(&ApiPacket);
  InitialUI = ApiPacket.ui;
  _retni(error);
  return(error);
}


/****************************************************************************
 *
 *  Function: sproGetExtendedStatus
 *  Purpose : Return the Status (Word) from the previous SuperPro API Call.
 *
 *  Inputs      : *unitInfo - ptr to the current unit info handle structure.
 *  Outputs     : Status word in function result
 *  Return Value: Status (Word)
 *
 **************************************************************************/
int SPROGXST(UNITINFO *unitinfo)
{
    int   error;
  char  *str,   *Aptr = &ApiPacket.ui;
  unsigned int  len,    i;

  str = _parc(1);               /* address of unitinfo */
  len = _parclen(1);            /* length of unitinfo */
/*  if ... ApiPacket.ui = unitinfo;    */
  if (len)              {
    for (i=0; i<len; i++)         /* move [unitinfo] -> ApiPacket.ui */
      Aptr[i] = str[i]; }
  ApiPacket.functionCode  = API_GET_EXTENDED_STATUS;

  error = SUPERPRO(&ApiPacket);
/*    unitinfo = ApiPacket.ui;    */
  len = _parclen(1);
  if (len)
    _storclen(Aptr, len, 1);
  _retni(error);
  return(error);
}


typedef struct {
          unsigned short int O, S;
        } OS, *OSPtr;

unsigned short int LoWord(long);
unsigned short int HiWord(long);

unsigned short int HiWord(long L)
// Return high-order word of L
{
  return ((unsigned short int) ((OSPtr)&L)->S);
}

unsigned short int LoWord(long L)
// Return low-order word of L
{
  return ((unsigned short int) ((OSPtr)&L)->O);
}

 /****************************************************************************
 * Function    : sproGetVersion
 *
 * Purpose     : Returns the driver's version number.
 *
 * Inputs      : thePacket  - pointer to a user allocated API packet.
 *               majVer     - is a pointer to where to store the major version.
 *               minVer     - is a pointer to where to store the minor version.
 *               rev        - is a pointer to where to store the revision.
 *               osDrvrType - is a pointer to where to store the os driver type.
 *
 * Outputs     : majVer     - is a pointer to where to store the major version.
 *               minVer     - is a pointer to where to store the minor version.
 *               rev        - is a pointer to where to store the revision.
 *               osDrvrType - is a pointer to where to store the os driver type.
 *
 * Return Value: Status
 *
 **************************************************************************/
int SPROGVER(UNITINFO *unitinfo,
                   unsigned char *majVer,
                   unsigned char *minVer,
                   unsigned char *rev,
                   unsigned char *osDrvrType )
{
    int   error;
  char  *str,   *Aptr = &ApiPacket.ui;
  unsigned int  len,    i;
  unsigned char word;

  str = _parc(1);               /* address of unitinfo */
  len = _parclen(1);            /* length of unitinfo */
/*  if ... ApiPacket.ui = unitinfo;    */
  if (len)              {
    for (i=0; i<len; i++)         /* move [unitinfo] -> ApiPacket.ui */
      Aptr[i] = str[i]; }
  ApiPacket.functionCode  = API_GET_VERSION;
     error = SUPERPRO(&ApiPacket);

  if (!error) {
    word = LoWord(ApiPacket.longResult);
    _storni(word, 2);
    word = LoWord(ApiPacket.longResult) >> 8;
    _storni(word, 3);
    word = HiWord(ApiPacket.longResult);
    _storni(word, 4);
    word = HiWord(ApiPacket.longResult) >> 8;
    _storni(word, 5);
    }
  _retni(error);
  return(error);
}



/****************************************************************************
 *
 *  Function: SPROFIRST
 *  Purpose : Find a SuperPro with the specified developer ID and return a
 *            a unit handle.
 *
 *  Inputs      : developerID - your assigned 16 bit developer.
 *
 *  Outputs     : *unitInfo - ptr to a unit info handle structure.
 *
 *  Return Value: Status
 *
 **************************************************************************/
int SPROFIRST(unsigned int developerID, UNITINFO *unitinfo)
{
  int   error;
  unsigned int len;
  char  *Aptr = &ApiPacket.ui;

  ApiPacket.functionCode    = API_FIND_FIRST_UNIT;
  ApiPacket.memoryContents  = _parni(1);        /* developerID */
  ApiPacket.ui = InitialUI;

  error = SUPERPRO(&ApiPacket);

/*    if ... unitinfo = ApiPacket.ui;    */
  len = _parclen(2);
  if (len)
    _storclen(Aptr, len, 2);

  _retni(error);
  return(error);
}


 /****************************************************************************
 *
 *  Function: SPRONEXT
 *  Purpose : To find the next SuperPro unit with the same developer ID
 *            as the unit specified by the unitinfo parameter, and return
 *            a new unit handle.
 *
 *  Inputs      : *unitInfo - ptr to the current unit info handle structure.
 *  Outputs     : *unitInfo - ptr to a new unit info handle structure.
 *  Return Value: Status
 *
 **************************************************************************/
int SPRONEXT(UNITINFO *unitinfo)
{
  int   error;
  char  *str,   *Aptr = &ApiPacket.ui;
  unsigned int  len,    i;

  str = _parc(1);               /* address of unitinfo */
  len = _parclen(1);            /* length of unitinfo */
/*  if ... ApiPacket.ui = unitinfo;    */
  if (len)              {
    for (i=0; i<len; i++)         /* move [unitinfo] -> ApiPacket.ui */
      Aptr[i] = str[i]; }

  ApiPacket.functionCode = API_FIND_NEXT_UNIT;
  error = SUPERPRO(&ApiPacket);
/*    unitinfo = ApiPacket.ui;    */
  len = _parclen(1);
  if (len)
    _storclen(Aptr, len, 1);
  _retni(error);
  return(error);
}


 /****************************************************************************
 *
 *  Function: SPROREAD
 *  Purpose : To read the data in a readable SuperPro Cell
 *
 *  Inputs      : *unitInfo - ptr to the current unit info handle structure.
 *                 address - address 0-63 of the cell of interest.
 *  Outputs     : *data - ptr to 16 bit contents of the addressed cell.
 *  Return Value: Status
 *
 **************************************************************************/
int SPROREAD(UNITINFO *unitinfo, int address, unsigned int *data)
{
  int   error;
  char  *str,   *Aptr = &ApiPacket.ui;
  unsigned int  len,    i;

/*  ApiPacket.ui = unitinfo;    */
  str = _parc(1);               /* address of unitinfo */
  len = _parclen(1);            /* length of unitinfo */
  if (len)              {
    for (i=0; i<len; i++)         /* move [unitinfo] -> ApiPacket.ui */
      Aptr[i] = str[i]; }
  ApiPacket.functionCode  = API_READ;
  ApiPacket.memoryAddress = _parni(2);
  error = SUPERPRO(&ApiPacket);
  if (!error)  
    _storni(ApiPacket.memoryContents, 3);       /* data */
  _retni(error);
  return(error);
}


 /****************************************************************************
 *
 *  Function: SPROXREAD
 *  Purpose : To read the data in a readable SuperPro Cell
 *
 *  Inputs      : *unitInfo - ptr to the current unit info handle structure.
 *                 address - address 0-63 of the cell of interest.
 *  Outputs     : *data - ptr to 16 bit contents of the addressed cell.
 *                *accessCode - ptr to access code value (0-3) of the
 *                              addressed cell
 *  Return Value: Status
 *
 **************************************************************************/
int SPROXREAD(UNITINFO  *unitinfo,
int           address,
unsigned int  *data,
unsigned char *accessCode)
{
  int   error;
  char  *str,   *Aptr = &ApiPacket.ui;
  unsigned int  len,    i;

  /* ApiPacket.ui = *unitinfo; */
  str = _parc(1);             /* ptr to unitinfo */
  len = _parclen(1);          /* len of unitinfo */
  if (len)              {
    for (i=0; i<len; i++)       /* move unitinfo -> ApiPacket.ui */
      Aptr[i] = str[i]; }
  ApiPacket.functionCode  = API_EXTENDED_READ;
  ApiPacket.memoryAddress = _parni(2);  /* (addr) */
  error = SUPERPRO(&ApiPacket);
  if (!error)   {
    _storni(ApiPacket.memoryContents, 3); /* data */
    _storni(ApiPacket.accessCode, 4);     /* accesscode */
    }

  _retni(error);
  return(error);
}


 /****************************************************************************
 *
 *  Function: SPROWRITE
 *  Purpose : To write to a read/write Superpro Cell.
 *
 *  Inputs      : *unitInfo - ptr to the current unit info handle structure.
 *                 writePassword - 16 bit write password
 *                 address    - address 0-63 of the cell to write to.
 *                 data       - the 16 bit value to write to the target cell.
 *                 accessCode - the Access code to write (0-3)
 *                           0 = Read/write
 *                           1 = Read only
 *                           2 = Counter
 *                           3 = Algo/Password
 *  Outputs     : NONE
 *  Return Value: Status
 *
 **************************************************************************/
int SPROWRITE(UNITINFO  *unitinfo,
 unsigned int  writePassword,
 int           address,
 unsigned int  data,
 unsigned char accessCode)
{
  int   error;
  char  *str,   *Aptr = &ApiPacket.ui;
  unsigned int  len,    i;

/*  ApiPacket.ui = unitinfo;    */
  str = _parc(1);               /* address of unitinfo */
  len = _parclen(1);            /* length of unitinfo */
  if (len)              {
    for (i=0; i<len; i++)         /* move [unitinfo] -> ApiPacket.ui */
      Aptr[i] = str[i]; }

  ApiPacket.functionCode     = API_WRITE;
  ApiPacket.writePassword    = _parni(2);       /* writePassword */
  ApiPacket.memoryAddress    = _parni(3);       /* address */
  ApiPacket.memoryContents   = _parni(4);       /* data */
  ApiPacket.accessCode       = _parni(5);       /* accesscode */
  error = SUPERPRO(&ApiPacket);
  _retni(error);
  return(error);
}


 /****************************************************************************
 *
 *  Function: SPROOVERW
 *  Purpose : To Overwrite any Overwriteable Superpro Cell (cells 5-63)
 *
 *  Inputs      : *unitInfo - ptr to the current unit info handle structure.
 *                 writePassword      - 16 bit write password
 *                 OverwritePassword1 - 16 bit Overwrite password 1
 *                 OverwritePassword2 - 16 bit Overwrite password 2
 *                 address    - address 0-63 of the cell to write to.
 *                 data       - the 16 bit value to write to the target cell.
 *                 accessCode - the Access code to write (0-3)
 *                           0 = Read/write
 *                           1 = Read only
 *                           2 = Counter
 *                           3 = Algo/Password
 *  Outputs     : NONE
 *  Return Value: Status
 *
 **************************************************************************/
int SPROOVERW(UNITINFO  *unitinfo,
     unsigned int  writePassword,
     unsigned int  overwritePassword1,
     unsigned int  overwritePassword2,
     int           address,
     unsigned int  data,
     unsigned char accessCode)
{
  int   error;
  char  *str,   *Aptr = &ApiPacket.ui;
  unsigned int  len,    i;

/*  ApiPacket.ui = unitinfo;    */
  str = _parc(1);               /* address of unitinfo */
  len = _parclen(1);            /* length of unitinfo */
  if (len)              {
    for (i=0; i<len; i++)         /* move [unitinfo] -> ApiPacket.ui */
      Aptr[i] = str[i]; }

  ApiPacket.functionCode   = API_OVERWRITE;
  ApiPacket.writePassword  = _parni(2);         /* writePassword */
  ApiPacket.xtraPassword1  = _parni(3);         /* overwritePassword1 */
  ApiPacket.xtraPassword2  = _parni(4);         /* overwritePassword2 */
  ApiPacket.memoryAddress  = _parni(5);         /* address */
  ApiPacket.memoryContents = _parni(6);         /* data */
  ApiPacket.accessCode     = _parni(7);         /* accessCode */
  error = SUPERPRO(&ApiPacket);
  _retni(error);
  return(error);
}


 /****************************************************************************
 *
 *  Function: SPRODECR
 *  Purpose : This function decrements a specified cell.  If the cell
 *            decrements to 0 and there is an associated active algo
 *            descriptor, the algo descriptor is deactivated.
 *
 *  Inputs      : *unitInfo - ptr to the current unit info handle structure.
 *                 writePassword      - 16 bit write password
 *                 address    - address 0-63 of the cell to decrement.
 *  Outputs     : NONE
 *  Return Value: Status
 *
 **************************************************************************/
int SPRODECR(UNITINFO  *unitinfo,
     unsigned int writePassword,
     int          address)
{
  int   error;
  char  *str,   *Aptr = &ApiPacket.ui;
  unsigned int  len,    i;

/*  ApiPacket.ui = unitinfo;    */
  str = _parc(1);               /* address of unitinfo */
  len = _parclen(1);            /* length of unitinfo */
  if (len)              {
    for (i=0; i<len; i++)         /* move [unitinfo] -> ApiPacket.ui */
      Aptr[i] = str[i]; }

  ApiPacket.functionCode  = API_DECREMENT;
  ApiPacket.writePassword = _parni(2);          /* writePassword */
  ApiPacket.memoryAddress = _parni(3);          /* address */
  error = SUPERPRO(&ApiPacket);
  _retni(error);
  return(error);
}


 /****************************************************************************
 *
 *  Function: SPROACTIV
 *  Purpose : To activate an inactive algo descriptor.
 *
 *  Inputs      : *unitInfo - ptr to the current unit info handle structure.
 *                 writePassword      - 16 bit write password
 *                 activatePassword1  - 16 bit activate password 1
 *                 activatePassword2  - 16 bit activate password 2
 *                 address    - address 0-63 of the cell to decrement.
 *  Outputs     : NONE
 *  Return Value: Status
 *
 **************************************************************************/
int SPROACTIV(UNITINFO   *unitinfo,
    unsigned int  writePassword,
    unsigned int activatePassword1,
    unsigned int activatePassword2,
    int           address)
{
  int error;
  char  *str,   *Aptr = &ApiPacket.ui;
  unsigned int  len,    i;

/*  ApiPacket.ui = unitinfo;    */
  str = _parc(1);               /* address of unitinfo */
  len = _parclen(1);            /* length of unitinfo */
  if (len)              {
    for (i=0; i<len; i++)         /* move [unitinfo] -> ApiPacket.ui */
      Aptr[i] = str[i]; }

  ApiPacket.functionCode  = API_ACTIVATE_ALGORITHM;
  ApiPacket.writePassword = _parni(2);          /* writePassword */
  ApiPacket.xtraPassword1 = _parni(3);          /* activatePassword1 */
  ApiPacket.xtraPassword2 = _parni(4);          /* activatePassword2 */
  ApiPacket.memoryAddress = _parni(5);          /* address */
  error = SUPERPRO(&ApiPacket);
  _retni(error);
  return(error);
}

 /****************************************************************************
 *
 *  Function: SPROQUERY
 *  Purpose : to scramble a bit stream through the superpro.
 *
 *  Inputs      : *unitInfo - ptr to the current unit info handle structure.
 *                 address    - address of the algo descriptor to use.
 *                 *queryData - ptr to input string
 *                 *response  - ptr to returned response string
 *                 *response32 - last 32 bits of response data
 *                 length - length of the input (and response) string.
 *  Outputs     : NONE
 *  Return Value: Status
 *
 **************************************************************************/
int SPROQUERY(UNITINFO  *unitinfo,
 int           address,
 void          *queryData,
 void          *response,
 unsigned long *response32,
 unsigned int  length)
{
  int error;
  char  *temp,  *str,   *Aptr = &ApiPacket.ui;
  unsigned int  len,    i;

/*  ApiPacket.ui = unitinfo;    */
  str = _parc(1);               /* address of unitinfo */
  len = _parclen(1);            /* length of unitinfo */
  if (len)              {
    for (i=0; i<len; i++)         /* move [unitinfo] -> ApiPacket.ui */
      Aptr[i] = str[i]; }

  ApiPacket.functionCode  = API_QUERY;
  ApiPacket.memoryAddress = _parni(2);          /* address */
  str = _parc(3);                       /* ptr to query string */
  len = _parni(6);                      /* LEN also = _parclen(3) */
  temp = _xgrab(len+1);                 /* allocate space for result string */
  temp[len] = '\0';                     /* only because P/U manual says to */
 
  ApiPacket.QueryIn       = str;        /* (unsigned long)queryData */
  ApiPacket.QueryOut      = temp;       /* (unsigned long)response */
  ApiPacket.dataLength    = len;        /* length */
 
  error = SUPERPRO(&ApiPacket);         /* call the driver */
 
  _storclen(temp, len, 4);              /* move result to Clipper variable */
  _xfree(temp);

  if (!error && !response)
    _stornl(ApiPacket.longResult, 5);   /* response32, if no response */

  _retni(error);
  return(error);
}


Blogger Widgets