view release on metacpan or  search on metacpan

ARS.pm  view on Meta::CPAN

#
#    ARSperl - An ARS v5-v7 / Perl5 Integration Kit
#
#    Copyright (C) 1995-2007 Joel Murphy, jmurphy@acsu.buffalo.edu
#                            Jeff Murphy, jcmurphy@acsu.buffalo.edu
# 
#    This program is free software; you can redistribute it and/or modify
#    it under the terms as Perl itself. 
#    
#    Refer to the file called "Artistic" that accompanies the source distribution 
#    of ARSperl (or the one that accompanies the source distribution of Perl
#    itself) for a full description.
#
#    Official Home Page: 
#    http://www.arsperl.org
#
#    Mailing List (must be subscribed to post):
#    arsperl@arsperl.org
#

# Routines for grabbing the current error message "stack" 
# by simply referring to the $ars_errstr scalar.


package ARS::ERRORSTR;
sub TIESCALAR {
    bless {};
}
sub FETCH {
    my($s, $i) = (undef, undef);
    my(%mTypes) = ( 0 => "OK", 1 => "WARNING", 2 => "ERROR", 3 => "FATAL",
		    4 => "INTERNAL ERROR",
		   -1 => "TRACEBACK");
    for($i = 0; $i < $ARS::ars_errhash{numItems}; $i++) {

	# If debugging is not enabled, don't show traceback messages

	if($ARS::DEBUGGING == 1) {
	    $s .= sprintf("[%s] %s (ARERR \#%d)",
			  $mTypes{@{$ARS::ars_errhash{messageType}}[$i]},
			  @{$ARS::ars_errhash{messageText}}[$i],
			  @{$ARS::ars_errhash{messageNum}}[$i]);
	    $s .= "\n" if($i < $ARS::ars_errhash{numItems}-1);
	} else {
	    if(@{$ARS::ars_errhash{messageType}}[$i] != -1) {
		$s .= sprintf("[%s] %s (ARERR \#%d)",
			      $mTypes{@{$ARS::ars_errhash{messageType}}[$i]},
			      @{$ARS::ars_errhash{messageText}}[$i],
			      @{$ARS::ars_errhash{messageNum}}[$i]);
		$s .= "\n" if($i < $ARS::ars_errhash{numItems}-1);
	    }
	}
    }
    return $s;
}

package ARS;

require 5.005;
use strict "vars";
require Exporter;
require DynaLoader;
require Carp unless $^S;
use AutoLoader 'AUTOLOAD';
use Config;

require 'ARS/ar-h.pm';
require 'ARS/arerrno-h.pm';
require 'ARS/nparm.pm';

@ARS::ISA = qw(Exporter DynaLoader);
@ARS::EXPORT = qw(isa_int isa_float isa_string ars_LoadQualifier ars_Login 
ars_Logoff ars_GetListField ars_GetFieldByName ars_GetFieldTable 
ars_DeleteEntry ars_GetEntry ars_GetListEntry ars_GetListSchema 
ars_GetListServer ars_GetActiveLink ars_GetCharMenuItems ars_GetSchema 
ars_ExpandCharMenu
ars_GetField ars_simpleMenu ars_GetListActiveLink ars_SetEntry 
ars_perl_qualifier ars_qualifier_ptr ars_Export ars_GetListFilter ars_GetListEscalation 
ars_GetListCharMenu ars_padEntryid 
ars_GetFilter ars_SetFilter
ars_GetListEntryWithFields ars_GetMultipleEntries

ARS.pm  view on Meta::CPAN

 'FILTER_FIELDS_PROCESS', 69,
 'FILTER_FIELDS_FLTAPI', 70,
 'ESCL_FIELDS_SQL', 71,
 'ESCL_FIELDS_PROCESS', 72,
 'ESCL_FIELDS_FLTAPI', 73,
 'WRITE_RESTRICTED_READ', 74
);


sub new {
	require 'ARS/OOform.pm';
	require 'ARS/OOmsgs.pm';
	require 'ARS/OOsup.pm';
	return newObject( @_ );
}


# ROUTINE
#   ars_simpleMenu(menuItems, prepend)
#
# DESCRIPTION
#   merges all sub-menus into a single level menu. good for web 
#   interfaces.
#
# RETURNS
#   array of menu items.

sub ars_simpleMenu {
    my($m) = shift;
    my($prepend) = shift;
    my(@m) = @$m;
    my(@ret, @submenu);
    my($name, $val);
    
    while (($name, $val, @m) = @m) {
	if (ref($val)) {
	    @submenu = ars_simpleMenu($val, $name);
	    @ret = (@ret, @submenu);
	} else {
	    if ($prepend) {
		@ret = (@ret, "$prepend/$name", $val);
	    } else {
		@ret = (@ret, $name, $val);
	    }
	}
    }
    @ret;
}

# ROUTINE
#   ars_padEntryid(control, schema, entry-id)
#
# DESCRIPTION
#   this routine will left-pad the entry-id with
#   zeros out to the appropriate number of place (15 max)
#   depending upon if your prefix your entry-id's with
#   anything
#
# RETURNS
#   a new scalar on success
#   undef on error

sub ars_padEntryid {
	my($c) = shift;
	my($schema) = shift;
	my($entry_id) = shift;
	my($field);

	# entry id field is field id #1
	($field = ars_GetField($c, $schema, 1)) ||
	return undef;
	if( $field->{defaultVal} ){
		return $field->{defaultVal}.("0"x($field->{limit}{maxLength}-length($field->{defaultVal})-length($entry_id))).$entry_id;
	}else{
		return ("0"x($field->{limit}{maxLength}-length($entry_id))).$entry_id;
	}	
}

# ROUTINE
#   ars_decodeStatusHistory(field-value)
#
# DESCRIPTION
#   this routine, when given an encoded status history field
#   (returned by GetEntry) will decode it into a hash like:
#
#   $retval[ENUM]->{USER}
#   $retval[ENUM]->{TIME}
#
#   so if you have a status field that has two states: Open and Closed,
#   where Open is enum 0 and Closed is enum 1, this routine will return:
#
#   $retval[0]->{USER} = the user to last selected this enum
#   $retval[1]->{TIME} = the time that this enum was last selected
#
#   You can map from enum values to selection words by using 
#   arsGetField().

sub ars_decodeStatusHistory {
    my ($sval) = shift;
    my ($enum) = 0;
    my ($pair, $ts, $un);
    my (@retval);

    foreach $pair (split(/\003/, $sval)) {
	if($pair ne "") {
	    ($ts, $un) = split(/\004/, $pair);
	    $retval[$enum]->{USER} = $un;
	    $retval[$enum]->{TIME} = $ts;
	} else {
	    # no value for this enumeration
	    $retval[$enum]->{USER} = undef;
	    $retval[$enum]->{TIME} = undef;
	}
	$enum++;
    }

    return @retval;
}

#define AR_DEFN_DIARY_SEP        '\03'     /* diary items separator */
#define AR_DEFN_DIARY_COMMA      '\04'     /* char between date/user/text */