ARSperl
view release on metacpan or search on metacpan
# 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)",
$ARS::VERSION = '2.00';
$ARS::DEBUGGING = 0;
$ARS::logging_file_ptr = 0;
# definitions required for backwards compatibility
if (!defined &ARS::AR_IMPORT_OPT_CREATE) {
eval 'sub AR_IMPORT_OPT_CREATE { 0; }';
}
if (!defined &ARS::AR_IMPORT_OPT_OVERWRITE) {
eval 'sub AR_IMPORT_OPT_OVERWRITE { 1; }';
}
bootstrap ARS $ARS::VERSION;
tie $ARS::ars_errstr, ARS::ERRORSTR;
# This HASH is used by the ars_GetServerStatistics call.
# Refer to your ARS API Programmer's Manual or the "ar.h"
# file for an explaination of what each of these stats are.
#
# Usage of this hash would be something like:
'FILTER_FIELDS_SQL', 68,
'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;
}
# 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;
#
# 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;
# DESCRIPTION
# given a list of diary hashs (see ars_GetEntry),
# encode them into an ars-internal diary string. this can
# then be fed into ars_MergeEntry() in order to alter the contents
# of an existing diary entry.
#
# RETURNS
# an encoded diary string (scalar) on success
# undef on failure
sub ars_EncodeDiary {
my ($diary_string) = undef;
my ($entry);
foreach $entry (@_) {
$diary_string .= $entry->{timestamp}.pack("c",4).$entry->{user}.pack("c",4).$entry->{value};
$diary_string .= pack("c",3) if ($diary_string);
}
return $diary_string;
}
sub insertValueForCurrentTransaction {
my ($c, $s, $q) = (shift, shift, shift);
die Carp::longmess("Usage: insertValueForCurrentTransaction(ctrl, schema, qualifier, ...)\n")
if(!defined($q));
die Carp::longmess("Usage: insertValueForCurrentTransaction(ctrl, schema, qualifier, ...)\nEven number of arguments must follow 'qualifier'\n")
if($#_ % 2 == 1);
#foreach (field, value) pair {
# look up field
($fh->{'dataType'} eq "diary")) {
$v = "\"$v\"";
}
}
}
print "walktree..\n";
walkTree($q);
exit 0;
}
sub walkTree {
my $q = shift;
print "($q) ";
if(defined($q->{'oper'})) {
print "oper: ".$q->{'oper'}."\n";
if($q->{'oper'} eq "not") {
walkTree($q->{'not'});
return;
} elsif($q->{'oper'} eq "rel_op") {
walkTree($q->{'rel_op'});
return;
}
foreach (keys %$q) {
print "key: ", $_,"\n";
print "val: ", $q->{$_},"\n";
dumpHash ($q->{$_}) if(ref($q->{$_}) eq "HASH");
}
}
}
sub dumpHash {
my $h = shift;
foreach (keys %$h) {
print "key: ", $_,"\n";
print "val: ", $h->{$_},"\n";
dumpHash($h->{$_}) if(ref($h->{$_}) eq "HASH");
}
}
# ars_GetCharMenuItems(ctrl, menuName, qualifier)
# qual is optional.
# if it's specified:
# menuType must be "query"
# qualifier must compile against the form that the menu
# is written for.
sub ars_GetCharMenuItems {
my ($ctrl, $menuName, $qual) = (shift, shift, shift);
if(defined($qual)) {
my $menu = ars_GetCharMenu($ctrl, $menuName);
die "ars_GetCharMenuItems failed: $ARS::ars_errstr"
unless defined($menu);
die "ars_GetCharMenuItems failed: qualifier was specified, but menu is not a 'query' menu"
if($menu->{'menuType'} ne "query");
if(ref($qual) ne "ARQualifierStruct") {
$qual = ars_LoadQualifier($ctrl, $menu->{'menuQuery'}{'schema'}, $qual);
}
return ars_ExpandCharMenu2($ctrl, $menuName, $qual);
}
return ars_ExpandCharMenu2($ctrl, $menuName);
}
sub ars_ExpandCharMenu {
return ars_ExpandCharMenu2(@_);
}
# encodes status history from the same format
# as returned by ars_decodeStatusHistory()
sub ars_encodeStatusHistory {
my @sh = ();
while(my $hr = shift) {
push @sh, $hr->{USER} ? "$hr->{TIME}\cD$hr->{USER}" : "";
}
join "\cC", @sh;
}
sub ars_SetOverlayGroup {
my ($ctrl, $value) = (shift, shift);
ars_SetSessionConfiguration($ctrl, 12, $value);
ars_SetSessionConfiguration($ctrl, 13, $value);
}
sub ars_SwitchToBaseMode {
my $ctrl = shift;
ars_SetOverlayGroup($ctrl, 0);
}
sub ars_SwitchToBestPracticeMode {
my $ctrl = shift;
ars_SetOverlayGroup($ctrl, 1);
}
# As of ARS4.0, these routines (which call ARInitialization and ARTermination)
# need to pass a control struct. this means that we now must move them into
# ars_Login and ars_Logoff in order to have access to that control struct.
# the implications of this are that your script should always call ars_Logoff()
# inorder to ensure that licenses are released (i.e. ARTermination is called)
# as for ARInitialization: this is used for private servers, mostly, and shouldnt
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.
Comments to: arsperl@arsperl.org
(this is a *mailing list* and you must be
a subscriber before posting)
http://www.arsperl.org
*/
#include "support.h"
#include "supportrev.h"
#include "supportrev_generated.h"
OUTPUT:
RETVAL
HV*
ars_VerifyUser(ctrl)
ARControlStruct * ctrl
CODE:
{
int ret = 0;
ARBoolean adminFlag = 0,
subAdminFlag = 0,
customFlag = 0;
ARStatusList status;
(void) ARError_reset();
Zero(&status, 1, ARStatusList);
ret = ARVerifyUser( ctrl, &adminFlag, &subAdminFlag, &customFlag, &status );
/* printf( "ret = %d, adminFlag = %d, subAdminFlag = %d, customFlag = %d\n",
ret, adminFlag, subAdminFlag, customFlag ); */
if(! ARError(ret, status)) {
RETVAL = newHV();
sv_2mortal( (SV*) RETVAL );
hv_store( RETVAL, "adminFlag", strlen("adminFlag"), newSViv(adminFlag), 0);
hv_store( RETVAL, "subAdminFlag", strlen("subAdminFlag"), newSViv(subAdminFlag), 0);
hv_store( RETVAL, "customFlag", strlen("customFlag"), newSViv(customFlag), 0);
}else{
XSRETURN_UNDEF;
}
}
OUTPUT:
RETVAL
void
ars_GetControlStructFields(ctrl)
ARS/CodeTemplate.pm view on Meta::CPAN
package ARS::CodeTemplate;
use Exporter;
@ISA = qw( Exporter );
@EXPORT = qw( include modByRegex );
*opt = *main::opt;
#our $LINE_INDENT = '';
sub compile {
my( $input ) = @_;
my @input = split( /\n/, $input );
my( $pFlag, $pCode, $output ) = ( 0, '', '' );
my $line;
foreach $line ( @input ){
if( $line =~ /^@@\s+(\S+)\s+(.*)$/ ){
my( $openMode, $outFile ) = ( $1, $2 );
if( $outFile =~ /^<@(.*)@>\s*$/ ){
ARS/CodeTemplate.pm view on Meta::CPAN
}
}
return $output;
}
use Getopt::Long;
sub init_template {
%opt = ();
Getopt::Long::Configure( 'no_ignore_case' );
Getopt::Long::GetOptions( \%opt, 'o=s', 'x!', 'debug!', @_ );
}
sub procdef {
my( $text ) = @_;
my $outfile;
if( defined $opt{'o'} ){
$outfile = $opt{'o'};
}else{
$outfile = '-';
}
open( OUTFILE, ">$outfile" ) or die "$outfile: $!\n";
print OUTFILE get_header( $outfile, $0 ) if $opt{'o'};
print OUTFILE $text;
close OUTFILE;
}
sub include {
my( $file ) = @_;
local $/ = undef;
local *FILE;
open( FILE, $file ) or do {
warn "Cannot open \"$file\": $!\n";
return undef;
};
my $data = <FILE>;
close FILE;
return $data;
}
sub modByRegex {
package main;
my( $val, @regex ) = @_;
foreach my $regex ( @regex ){
eval "\$val =~ $regex";
warn $@, "\n" if $@;
}
return $val;
}
sub get_header {
my( $of, $tpt ) = @_;
my $HEADER = << "+";
/*******************************************************************************
** **
** Automatically genenerated <OUTFILE> file.
** D O N O T E D I T ! ! ! ! **
** Edit <TEMPLATE> instead.
** **
*******************************************************************************/
ARS/OOform.pm view on Meta::CPAN
# 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):
# See URL above.
#
package ARS::form;
require Carp;
# new ARS::form(-form => name, -vui => view, -connection => connection)
sub new {
my ($class, $self) = (shift, {});
my ($b) = bless($self, $class);
my ($form, $vui, $connection) =
ARS::rearrange([FORM,VUI,CONNECTION],@_);
$connection->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: new ARS::form(-form => name, -vui => vui, -connection => connection)\nform and connection parameters are required."
)
ARS/OOform.pm view on Meta::CPAN
$enums{$_} = { map { $_->{itemNumber}, $_->{itemName} } @{$fv->{'limit'}->{'enumLimits'}->{customList}} };
}
}
}
$self->{'fieldtypes'} = \%t;
$self->{'fieldEnumValues'} = \%enums;
return $b;
}
sub DESTROY {
}
# getEnumValues(-field => "fieldname")
sub getEnumValues {
my ($this) = shift;
my ($field) = ARS::rearrange([FIELD], @_);
if(ref($this->{'fieldEnumValues'}->{$field}) eq "ARRAY") {
return @{$this->{'fieldEnumValues'}->{$field}};
}
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81006,
"field $field is not an enumeration field.");
$this->{'connection'}->tryCatch();
return undef;
}
# query(-query => "qualifier", -maxhits => 100, -firstretrieve => 0)
sub query {
my ($this) = shift;
my ($query, $maxhits, $firstretr) = ARS::rearrange([QUERY,MAXHITS,FIRSTRETRIEVE], @_);
$query = "(1 = 1)" unless defined($query);
$maxhits = 0 unless defined($maxhits);
$firstretr = 0 unless defined($firstretr);
if($this->{'connection'}->{'.debug'}) {
print "form->query(".$this->{'form'}.", $query, ".$this->{'vui'}.")\n";
}
ARS/OOform.pm view on Meta::CPAN
}
$this->{'matches'} = \@mids;
$this->{'querylist'} = \@mdescs;
return @mids;
}
# getFieldID(-field => name)
sub getFieldID {
my $this = shift;
my ($name) = ARS::rearrange([FIELD], @_);
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: form->getFieldID(-field => name)\nname parameter is required.")
unless defined($name);
if(!defined($this->{'fields'}->{$name})) {
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81001,
"field '$name' not in view: ".$this->{'vui'}."\n"
);
}
return $this->{'fields'}->{$name} if(defined($name));
}
# getFieldName(-id => id)
sub getFieldName {
my $this = shift;
my ($id) = ARS::rearrange([ID], @_);
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: form->getFieldName(-id => id)\nid parameter required."
)
unless defined($id);
return $this->{'fields_rev'}->{$id} if defined($this->{'fields_rev'}->{$id});
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81002,
"field id '$id' not available on form: ".$this->{'form'}.""
);
}
# getFieldType(-field => name, -id => id)
sub getFieldType {
my $this = shift;
my ($name, $id) = ARS::rearrange([FIELD,ID], @_);
if(!defined($name) && !defined($id)) {
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: form->getFieldType(-field => name, -id => id)\none of the parameters must be specified.");
}
if(defined($name) && !defined($this->{'fieldtypes'}->{$name})) {
ARS/OOform.pm view on Meta::CPAN
return $this->{'fieldtypes'}->{$n};
}
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81003,
"couldn't determine dataType for field.");
}
# delete(-entry => id)
sub delete {
my $this = shift;
my ($id) = ARS::rearrange([ENTRY],@_);
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: form->delete(-entry => id)\nentry parameter is required.")
unless defined($id);
my (@d);
ARS/OOform.pm view on Meta::CPAN
foreach (@d) {
ARS::ars_DeleteEntry($this->{'connection'}->{'ctrl'},
$this->{'form'},
$_);
$this->{'connection'}->tryCatch();
}
}
# merge(-type => mergeType, -values => { field1 => value1, ... })
sub merge {
my ($this) = shift;
my ($type, $vals) =
ARS::rearrange([TYPE,[VALUE,VALUES]],@_);
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: form->merge(-type => mergeType, -values => { field1 => value1, ... })\ntype and values parameters are required.")
unless(defined($type) && defined($vals));
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
ARS/OOform.pm view on Meta::CPAN
!$this->{'connection'}->hasErrors()) {
$rv = $realmap{1};
}
}
return $rv;
}
# set(-entry => id, -gettime => tstamp, -values => { field1 => value1, ... })
sub set {
my ($this) = shift;
my ($entry,$gettime,$vals) =
ARS::rearrange([ENTRY,GETTIME,[VALUE,VALUES]],@_);
$gettime = 0 unless defined($gettime);
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: form->set(-entry => id, -gettime => tstamp, -values => { field1 => value1, ... })\nentry and values parameters are required."
)
ARS/OOform.pm view on Meta::CPAN
$gettime,
%realmap);
$this->{'connection'}->tryCatch();
return $rv;
}
# value2internal(-field => name, -value => value)
sub value2internal {
my ($this) = shift;
my ($f, $v) = ARS::rearrange([FIELD,VALUE], @_);
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: form->value2internal(-field => name, -value => value)\nfield parameter is required.")
unless (defined($f));
return $v unless defined $v;
my ($t) = $this->getFieldType($f);
ARS/OOform.pm view on Meta::CPAN
"[2] unable to translate enumeration value for field '$f'");
}
# we don't need translation..
return $v;
}
# internal2value(-field => name, -id => id, -value => value)
sub internal2value {
my ($this) = shift;
my ($f, $id, $v) = ARS::rearrange([FIELD,ID,VALUE], @_);
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: form->internal2value(-field => name, -id => id, -value => value)\nid or field parameter are required.")
unless (defined($f) || defined($id));
$f = $this->getFieldName(-id => $id) unless defined($f);
ARS/OOform.pm view on Meta::CPAN
return $this->{'fieldEnumValues'}->{$f}->{$v}
}
# we don't need translation..
return $v;
}
# create(-values => { field1 => value1, ... })
sub create {
my ($this) = shift;
my ($vals) = ARS::rearrange([[VALUES,VALUE]],@_);
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: form->create(-values => { field1 => value1, ... })\nvalues parameter is required.")
unless defined($vals);
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
ARS/OOform.pm view on Meta::CPAN
%realmap);
print "calling tryCatch()..\n" if $self->{'connection'}->{'.debug'};
$this->{'connection'}->tryCatch();
return $id;
}
# get(-entry => entryid, -fields => [ field1, field2 ])
sub get {
my $this = shift;
my ($eid, $fields) = ARS::rearrange([ENTRY,[FIELD,FIELDS]],@_);
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: form->get(-entry => entryid, -fields => [ field1, field2, ... ])\nentry parameter is required.")
unless defined($eid);
my (@fieldlist) = ();
my ($allfields) = 1;
ARS/OOform.pm view on Meta::CPAN
}
}
return @rv unless ($#rv == 0);
return $rv[0];
}
# getAsHash(-entry => entryid, -fields => [field1, field2, ...])
sub getAsHash {
my $this = shift;
my ($eid, $fields) = ARS::rearrange([ENTRY,[FIELD,FIELDS]],@_);
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: form->getAsHash(-entry => entryid, -fields => [ field1, field2, ... ])\nentry parameter is required.")
unless defined($eid);
my (@fieldlist) = ();
my ($allfields) = 1;
ARS/OOform.pm view on Meta::CPAN
}
$v[$i] = $this->getFieldName(-id => $v[$i]);
}
return @v;
}
# getAttachment(-entry => eid, -field => fieldname, -file => filename)
# if file isnt specified, the attachment is returned "in core"
sub getAttachment {
my $this = shift;
my ($eid, $field, $file) = ARS::rearrange([ENTRY,FIELD,FILE],@_);
if(!defined($eid) && !defined($field)) {
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: getAttachment(-entry => eid, -field => fieldname, -file => filename)\nentry and field parameters are required.");
}
if(defined($file)) {
ARS/OOform.pm view on Meta::CPAN
return ARS::ars_GetEntryBLOB($this->{'connection'}->{'ctrl'},
$this->{'form'},
$eid,
$this->getFieldID($field),
ARS::AR_LOC_BUFFER);
}
#setSort(... )
sub setSort {
my $this = shift;
if(($#_+1) % 2 == 1){
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: setSort(...)\nMust have an even number of parameters. (nparm = $#_)");
}
my (@t) = @_;
ARS/OOmsgs.pm view on Meta::CPAN
# 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):
# See URL above.
#
sub internalDie {
my ($this, $msg, $trace) = (shift, shift, shift);
$msg = "[no message available]" unless (defined($msg) && ($msg ne ""));
$trace = "[no traceback available]"
unless (defined($trace) && ($trace ne ""));
die "$msg\n\nTRACEBACK:\n\n$trace\n";
}
sub internalWarn {
my ($this, $msg, $trace) = (shift, shift, shift);
$msg = "[no message available]" unless (defined($msg) && ($msg ne ""));
$trace = "[no traceback available]"
unless (defined($trace) && ($trace ne ""));
warn "$msg\n\nTRACEBACK:\n\n$trace\n";
}
# 81000 = Usage Errors
# 81001 = Field Name Not In VUI
# 81002 = Invalid Field ID
# 81003 = Unknown Field Data Type
# 81004 = Unable to Xlate Enum Value
# 81005 = misspelled/invalid parameter
# .catch is a hash ref
sub initCatch {
my $this = shift;
$this->setCatch(&ARS::AR_RETURN_WARNING => "internalWarn");
$this->setCatch(&ARS::AR_RETURN_ERROR => "internalDie");
$this->setCatch(&ARS::AR_RETURN_FATAL => "internalDie");
}
sub setCatch {
my $this = shift;
my $type = shift;
my $func = shift;
$this->{'.catch'}->{$type} = $func;
}
# this routine is periodically called to see if any exceptions
# have occurred. if they have, and an exception handler is specified,
# we will call the handler and pass it the exception.
sub tryCatch {
my $this = shift;
if(defined($this->{'.catch'}) && ref($this->{'.catch'}) eq "HASH") {
foreach (&ARS::AR_RETURN_WARNING, &ARS::AR_RETURN_ERROR,
&ARS::AR_RETURN_FATAL) {
if(defined($this->{'.catch'}->{$_}) && $this->hasMessageType($_)) {
my $stackTrace = Carp::longmess("exception generated");
&{$this->{'.catch'}->{$_}}($_, $this->messages(),
$stackTrace);
}
}
}
}
sub pushMessage {
my ($this, $type, $num, $text) = (shift, shift, shift, shift);
$ARS::ars_errhash{numItems}++;
push @{$ARS::ars_errhash{messageType}}, $type;
push @{$ARS::ars_errhash{messageNum}}, $num;
push @{$ARS::ars_errhash{messageText}}, $text;
$this->tryCatch();
}
sub messages {
my(%mTypes) = ( 0 => "OK", 1 => "WARNING", 2 => "ERROR", 3 => "FATAL",
4 => "INTERNAL ERROR",
-1 => "TRACEBACK");
my ($this, $type, $str) = (shift, shift, undef);
return $ars_errstr if(!defined($type));
for(my $i = 0; $i < $ARS::ars_errhash{numItems}; $i++) {
if(@{$ARS::ars_errhash{'messageType'}}[$i] == $type) {
$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;
}
sub errors {
my $this = shift;
return $this->messages(&ARS::AR_RETURN_ERROR);
}
sub warnings {
my $this = shift;
return $this->messages(&ARS::AR_RETURN_WARNING);
}
sub fatals {
my $this = shift;
return $this->messages(&ARS::AR_RETURN_FATAL);
}
sub hasMessageType {
my ($this, $t) = (shift, shift);
return $t if !defined($t);
for(my $i = 0; $i < $ARS::ars_errhash{numItems}; $i++) {
return 1
if(@{$ARS::ars_errhash{'messageType'}}[$i] == $t);
}
return 0;
}
sub hasFatals {
my $this = shift;
return $this->hasMessageType(&ARS::AR_RETURN_FATAL);
}
sub hasErrors {
my $this = shift;
return $this->hasMessageType(&ARS::AR_RETURN_ERROR);
}
sub hasWarnings {
my $this = shift;
return $this->hasMessageType(&ARS::AR_RETURN_WARNING);
}
1;
ARS/OOsup.pm view on Meta::CPAN
# 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):
# See URL above.
#
# Object Oriented Hoopla
sub newObject {
my ($class, @p) = (shift, @_);
my ($self) = {};
my ($blessed) = bless($self, $class);
my ($server, $username, $password, $catch, $ctrl, $dbg, $tcpport) =
rearrange([SERVER,USERNAME,PASSWORD,CATCH,CTRL,DEBUG,TCPPORT],@p);
# should the OO layer emit debugging information?
$self->{'.debug'} = 0;
$self->{'.debug'} = 1 if(defined($dbg));
ARS/OOsup.pm view on Meta::CPAN
print "new connection object: ($server, $username, $password)\n"
if $self->{'.debug'};
$self->{'ctrl'} = ars_Login($server, $username, $password, "","", $tcpport);
$self->{'.nologoff'} = 0;
$self->tryCatch();
}
return $blessed;
}
sub DESTROY {
my ($self) = shift;
print "destroying connection object: " if $self->{'.debug'};
if(defined($self->{'.nologoff'}) && $self->{'.nologoff'} == 0) {
print "ars_Logoff called.\n" if $self->{'.debug'};
ars_Logoff($self->{'ctrl'}) if defined($self->{'ctrl'});
} else {
print "ars_Logoff suppressed.\n" if $self->{'.debug'};
}
}
sub ctrl {
my $this = shift;
return $this->{'ctrl'};
}
sub print {
my $this = shift;
my($cacheId, $operationTime, $user, $password, $lang,
$server) = ars_GetControlStructFields($this->{'ctrl'});
print "connection object details:\n";
print "\tcacheId = $cacheId\n";
print "\toperationTime = ".localtime($operationTime)."\n";
print "\tuser = $user\n";
print "\tpassword = $password\n";
print "\tserver = $server\n";
print "\tlang = $lang\n";
}
sub availableSchemas {
my $this = shift;
my ($changedSince, $schemaType, $name) =
rearrange([CHANGEDSINCE,SCHEMATYPE,NAME],@_);
$changedSince = 0 unless defined($changedSince);
$schemaType = ARS::AR_LIST_SCHEMA_ALL unless defined($schemaType);
$name = "" unless defined($name);
return ars_GetListSchema($this->{'ctrl'},
$changedSince,
$schemaType, undef,
$name);
}
sub openForm {
my $this = shift;
my($form, $vui) = rearrange([FORM,VUI], @_);
$this->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: c->openForm(-form => name, -vui => vui)\nform parameter is required.")
if(!defined($form) || ($form eq ""));
$this->tryCatch();
return new ARS::form(-form => $form,
ARS/nparm.pm view on Meta::CPAN
# 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):
# See URL above.
#
# the following two routines
# make_attributes()
# rearrange()
# were borrowed from the CGI module. these routines implement
# named parameters.
# (http://stein.cshl.org/WWW/software/CGI/cgi_docs.html)
# Copyright 1995-1997 Lincoln D. Stein. All rights reserved.
sub make_attributes {
my($attr) = @_;
return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
my(@att);
foreach (keys %{$attr}) {
#print "attr=$_\n";
my($key) = $_;
$key=~s/^\-//; # get rid of initial - if present
$key=~tr/a-z_/A-Z-/; # parameters are upper case, use dashes
push(@att,$attr->{$_} ne '' ? qq/$key="$attr->{$_}"/ : qq/$key/);
}
return @att;
}
# rearrange(order, params)
# order will be an array reference (might contain other array refs)
# that lists the order we want the params returned in.
#
# param is the actual params, probably as (-key, value) pairs.
sub rearrange {
my($order,@param) = @_;
return () unless @param;
my($param, @possibilities);
foreach (@$order) {
if(ref($_) && (ref($_) eq "ARRAY")) {
foreach my $P (@{$_}) {
push @possibilities, $P;
}
} else {
push @possibilities, $_;
}
}
#print "possibilities=".join(',', @possibilities)."\n";
unless (ref($param[0]) eq 'HASH') {
return @param unless (defined($param[0]) && substr($param[0],0,1) eq '-');
$param = {@param}; # convert into associative array
} else {
$param = $param[0];
}
my($key)='';
foreach (keys %{$param}) {
my $old = $_;
s/^\-//; # get rid of initial - if present
under the copyright of this Package, but belong to whoever generated
them, and may be sold commercially, and may be aggregated with this
Package. If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
perl_ARArchiveInfoStruct; those functions now return the converted perl structure
instead of the pointer to a C structure.
(TS) fixed Makefile.PL to work with $ARSAPI containing spaces on Windows
(TS) added ars_DeleteContainer (changes to ARS.xs, ARS.pm)
(TS) fixed Makefile.PL to use $ra_arlibs for Version <= 5.0 on Windows
(TS) fixed rev_ARValueStructStr2Type: use strcasecmp instead of strncasecmp
(failure to differentiate between string and substring)
(TS) added "case AR_DATA_TYPE_CURRENCY" to perl_ARValueStruct
(TS) moved existing code for AR_DATA_TYPE_CURRENCY from sv_to_ARValueStruct
to new function sv_to_ARCurrencyStruct, completed ARCurrencyStruct handling
(TS) added handling of AR_DATA_TYPE_DATE, AR_DATA_TYPE_TIME_OF_DAY,
to rev_ARValueStruct, sv_to_ARValueStruct
(TS) added conversion functions rev_ARDisplayInstanceList,
(TS) added binmode-statements in t/10entry.t (test failed on win32)
(TS) warning cleanup in test files (t/02export.t, t/13join.t)
(TS) added ars_SetLogging (changes to ARS.xs, ARS.pm, support.c, support-h.template,
html/manual/toc.html; new files: html/manual/ars_SetLogging.html, t/21setlogging.t)
(TS) fixed pointer dereferencing error in supportrev.c:strmakHval
(TS) fixed supportrev.c:strcasecmp, strncasecmp; failure to differentiate between
string and substring (e.g. "page_holder" and "page")
(TS) fixed support.c:perl_ARByteList (Bug ID 1213180)
(David Lindes {lindes at users.sourceforge.net})
(TS) added support for DATA_TYPE_CURRENCY to perl_ARFieldLimitStruct
(TS) added function perl_ARCurrencyDetailList
(TS) fixed support.c:my_strtok, perl_BuildEntryList
(ars_GetEntry crashed when retrieving join form entries)
see the documentation on the return values of these functions
for details on what has changed.
(JCM) ! changed ars_GetCharMenu so that {'menuType'} is returned
as a string (decoded) instead of an integer.
(JCM) ! added a parameter to ars_Import which will require that existing
scripts be updated. see documentation for details.
(JCM) added patch submitted by Geoff Endresen which enabled decoding
of push fields actions in GetFilter()
(JCM) enhanced Makefile.PL to be more intelligent when h2ph fails or
doesnt exist
(JCM) added/decoded schemaType (within GetSchema()/CompoundSchema structure)
(JCM) documentation updates
(BM) removed most of the PPERLC and AWP stuff that was intended
to help the port to ActiveState perl. Use the One True Perl.
(BM) Changed many of the allocations to use perl's memory manager,
except where the structure or element is grown further internally
by ARS, or where the structure is non-trivial to free(). I still
have concerns about some of the un-freed allocations in
supportrev.c, but at least ALL of the demo scripts,
including ARSDoc-1.11 (with small patch submitted to list) now
run, and produce the right results.
(BM) Removed all references to ZEROMEM in favor of perl's Zero, which
is guaranteed to work everywhere, and doesn't need additional logic.
(BM) fixed a couple of small typos, including one in a elliptical
declaration (...) which didn't have a comma separator.
(BM) Changed the logic of CVLD in one place that was attempting to free()
null pointers.
INSTALLATION view on Meta::CPAN
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.
Comments to: arsperl-users@lists.sourceforge.net
(this is a *mailing list* and you must be
a subscriber before posting)
Home Page: http://www.arsperl.org
---------------------------------------------------------------------------
This is a perl extension for Remedy's Action Request System. Remedy
Corporation, Action Request System, and AR System are trademarks of Remedy
Corporation.
This extension is offered completely for free and without support
INSTALLATION view on Meta::CPAN
Please see: https://rrr.se/cgi/index?pg=arapi
for a pre-packaged archive of API libraries
(it is also possible to pull all of this together on your own if you have access
to /opt/bmc/ARSystem on your ARS server)
Note for Linux 64-bit:
The expansion of the rrr.se targzip's will result in a directory similar to
"api764sp5linux" depending on the version of the API. The actual AR System
libraries as provided by Remedy need to be found by the linker in the lib
subdirectory of the $ARSAPI variable value set in Makefile.PL and with shortened
names as follows.
Example:
cp api764sp5linux/bin/* api764sp5linux/lib
cd api764sp5linux/lib
ln -s libicudatabmc.so.32 libicudatabmc.so
ln -s libicui18nbmc.so.32 libicui18nbmc.so
ln -s libicuiobmc.so.32 libicuiobmc.so
ln -s libicuucbmc.so.32 libicuucbmc.so
Makefile.PL view on Meta::CPAN
# set to 1 if you need a backwards compatible version of ars_GetListGroup
# (see the manual page of ars_GetListGroup for a more specific description)
GETLISTGROUP_OLD_STYLE => 0,
);
##############################
# unless you run into problems, you shouldn't need to read any further.
# if you do run into problems, and don't really know what this file
# does, try subscribing to the mailing list and ask for help there.
# subscription information is available at http://www.arsperl.org/
if( $ENV{ARSPERLTEST_PARAM} ){
( $ARSVERSION, $ARSAPI, $ARSPERLTEST_SERVER, $ARSPERLTEST_USERNAME, $ARSPERLTEST_PASSWORD, $ARSPERLTEST_TCPPORT )
= split( /;/, $ENV{ARSPERLTEST_PARAM} );
}
my $ra_arlibs = findArLibs($ARSAPI);
# use Data::Dumper;
# print "found ar libraries: ", Dumper($ra_arlibs);
Makefile.PL view on Meta::CPAN
exit 0;
# ROUTINE
# GenerateSupportDotH(template-file, includes-dir)
#
# DESCRIPTION
# this routine extracts some information from the
# "ar.h" file and generates some "type maps" which help
# us translate from code numbers to readable text.
sub GenerateSupportDotH {
my ($tmpl, $incdir) = (shift, shift);
my (@arh);
$incdir =~ s/^-I//g;
$incdir =~ s/^"//;
$incdir =~ s/"$//;
print "Generating support.h file..\n";
die "not a directory ($incdir): $!" if(! -d $incdir);
Makefile.PL view on Meta::CPAN
print FD $_;
}
}
close(TMPL);
close(FD);
print "\n";
}
sub makeTestConfig {
my ($SERVER, $USERNAME, $PASSWORD, $TCPPORT);
my ($S, $U, $P, $T) = ("", "", "", 0);
if(-e "./t/config.cache") {
do './t/config.cache';
$S = &CCACHE::SERVER;
$U = &CCACHE::USERNAME;
$P = &CCACHE::PASSWORD;
$T = &CCACHE::TCPPORT;
}
Makefile.PL view on Meta::CPAN
chomp($TCPPORT = defined($ARSPERLTEST_TCPPORT) ? $ARSPERLTEST_TCPPORT : <STDIN>);
if($TCPPORT eq "") {
$TCPPORT = $T if ($T ne "");
}
$TCPPORT = 0 if ! $TCPPORT;
#print "Storing $SERVER / $USERNAME / $PASSWORD ..\n";
open (FD, "> ./t/config.cache") || die "open failed: $!";
print FD "package CCACHE;\n";
print FD "\# enter your server, admin username and password below.\n\n";
print FD "sub SERVER { \"$SERVER\" ; }\n";
print FD "sub USERNAME { \"$USERNAME\" ; }\n";
print FD "sub PASSWORD { \"$PASSWORD\" ; }\n";
print FD "sub TCPPORT { $TCPPORT ; }\n";
print FD "1;\n";
close(FD);
}
#
# given a path to the Api directory, go find ar.h and parse the value
# of the AR_CURRENT_API_VERSION #define and return it.
# if the path to ar.h is, e.g.,
# c:\Program Files\ARSystem6.0.1\Arserver\Api\include\ar.h
# then this method wants an appropriately quoted
# c:\Program Files\ARSystem6.0.1\Arserver\Api
# as its first arg
#
sub findAPIVersion {
my $path_to_api_dir = shift;
my $ar_fname = join('/', $path_to_api_dir, 'include', 'ar.h');
open ($ar_fh, '<'. $ar_fname) or
die "couldn't open ar.h include file from: \"$ar_fname\": $!\n";
my $api_version = undef;
# the line we want to parse looks like:
#
Makefile.PL view on Meta::CPAN
# time we have arsperl will have to change to support the API change.
#
# this whole strategy of deriving the server version from the api version
# presumes that we won't have to distinguish between releases of the
# same api version, which may or may not be correct.
#
# the api version can be the main variable arsperl uses to adjust
# itself however.
#
sub serverReleaseFromAPIVersion {
my $api_version = shift;
# keys are server releases converted to floating point numbers;
# values are the api version that release produced.
# add more values to this table as needed.
my $rh_api_version_table =
{
4.5 => 7,
4.51 => 7,
4.52 => 7,
Makefile.PL view on Meta::CPAN
push @api_list, $server_rel;
}
}
# make sure the values are treated as numbers during the sort
my @sorted = sort { ($a + 0) <=> ($b + 0) }@api_list;
return $sorted[0];
}
sub findArLibs {
my $path_to_api_dir = shift;
my $cwd = getcwd();
my $ar_lib_dir = join('/', $path_to_api_dir, 'lib');
chdir($ar_lib_dir);
# we want all of the files that end in .lib on win32
my @libs = <*.lib>;
chdir($cwd);
return \@libs;
}
sub ARS_VERSION_45 { 7; }
sub ARS_VERSION_50 { 8; }
sub ARS_VERSION_51 { 9; }
sub ARS_VERSION_60 { 10; }
sub ARS_VERSION_63 { 11; }
sub ARS_VERSION_70 { 12; }
sub ARS_VERSION_71 { 13; }
sub ARS_VERSION_75 { 14; }
sub ARS_VERSION_760 { 15; }
sub ARS_VERSION_762 { 16; }
sub ARS_VERSION_763 { 17; }
sub ARS_VERSION_764 { 18; }
sub ARS_VERSION_80 { 19; }
sub ARS_VERSION_81 { 20; }
## @Devs: set the following constant always to the latest version supported by ARSPerl
sub ARS_MAX_API { ARS_VERSION_81; }
sub ARSVersionString {
my $APIVersionID = shift;
my $api2Version = {
&ARS_VERSION_45 => '4.5',
&ARS_VERSION_50 => '5.0',
&ARS_VERSION_51 => '5.1',
&ARS_VERSION_60 => '6.0',
&ARS_VERSION_63 => '6.3',
&ARS_VERSION_70 => '7.0',
&ARS_VERSION_71 => '7.1',
&ARS_VERSION_75 => '7.5',
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.
Comments to: arsperl@arsperl.org
(this is a *mailing list* and you must be
a subscriber before posting)
Home Page: http://www.arsperl.org
---------------------------------------------------------------------------
1.80 Notes
----------
The 1.80 release includes ARS 5.x integration. When compiling against
ARS 5.x APIs, the ars_NT* functions (notifier library) will no longer
In addition, doing ars_SetEntry($ctrl, ..., $fieldId, undef) will now
correctly set a field to $NULL$
1.0 Beta User Notes
-------------------
o The library and extension seem fairly stable. However, bugs and
memory leaks might still occur. We've only been able to build it
under Solaris 2.x (4 and 5 to be specific) because that is what we
run ARS under. Users who attempt builds on other systems and are
successful should submit diffs back to us so that they can be
incorporated into the distribution.
o The WEB client example works (more or less) but there is much
room for improvement.
o There is a mailing list available for people to share their
thoughts concerning ARSperl.
---------------------------------------------------------------------------
arsperl@arsperl.org
StructDef.pl view on Meta::CPAN
},
outputValueFieldPairs => {
_type => 'ARFieldAssignList',
_data => 'p->outputValueFieldPairs',
},
windowMode => {
_max_version => '5.1.2',
_map => {
AR_ACTIVE_LINK_ACTION_OPEN_DLG => "open_dlg",
AR_ACTIVE_LINK_ACTION_OPEN_SEARCH => "open_search",
AR_ACTIVE_LINK_ACTION_OPEN_SUBMIT => "open_submit",
AR_ACTIVE_LINK_ACTION_OPEN_MODIFY_LST => "open_modify_lst",
AR_ACTIVE_LINK_ACTION_OPEN_MODIFY_DETAIL => "open_modify_detail",
AR_ACTIVE_LINK_ACTION_OPEN_MODIFY_SPLIT => "open_modify_split",
AR_ACTIVE_LINK_ACTION_OPEN_DSPLY_LST => "open_dsply_lst",
AR_ACTIVE_LINK_ACTION_OPEN_DSPLY_DETAIL => "open_dsply_detail",
AR_ACTIVE_LINK_ACTION_OPEN_DSPLY_SPLIT => "open_dsply_split",
AR_ACTIVE_LINK_ACTION_OPEN_REPORT => "open_report",
},
_type => 'int',
_data => 'p->windowMode',
},
'windowMode+' => {
_min_version => '6.0.0',
_map => {
AR_ACTIVE_LINK_ACTION_OPEN_DLG => "open_dlg",
AR_ACTIVE_LINK_ACTION_OPEN_SEARCH => "open_search",
AR_ACTIVE_LINK_ACTION_OPEN_SUBMIT => "open_submit",
AR_ACTIVE_LINK_ACTION_OPEN_MODIFY_LST => "open_modify_lst",
AR_ACTIVE_LINK_ACTION_OPEN_MODIFY_DETAIL => "open_modify_detail",
AR_ACTIVE_LINK_ACTION_OPEN_MODIFY_SPLIT => "open_modify_split",
AR_ACTIVE_LINK_ACTION_OPEN_DSPLY_LST => "open_dsply_lst",
AR_ACTIVE_LINK_ACTION_OPEN_DSPLY_DETAIL => "open_dsply_detail",
AR_ACTIVE_LINK_ACTION_OPEN_DSPLY_SPLIT => "open_dsply_split",
AR_ACTIVE_LINK_ACTION_OPEN_REPORT => "open_report",
AR_ACTIVE_LINK_ACTION_OPEN_MODIFY => "open_modify",
AR_ACTIVE_LINK_ACTION_OPEN_DSPLY => "open_dsply",
},
StructDef.pl view on Meta::CPAN
_data => 'p->notifyPriority',
},
notifyMechanism => {
_type => 'unsigned int',
_data => 'p->notifyMechanism',
},
notifyMechanismXRef => {
_type => 'ARInternalId',
_data => 'p->notifyMechanismXRef',
},
subjectText => {
_type => 'char *',
_data => 'p->subjectText',
},
fieldIdListType => {
_type => 'unsigned int',
_data => 'p->fieldIdListType',
},
fieldList => {
_type => 'ARInternalIdList',
_data => 'p->fieldIdList',
},
notifyBehavior => {
@SYBASE_SQL = get_SybaseSQL($ARS_QUERY);
where:
$ARS_QUERY = "'Field' = \"$value\" ...etc"
and:
@SYBASE_QUERY would be something like this:
select Ticket_No from Schema_Name
WHERE Field = '$value'
-----------------------------------------------
allow substitution of current transaction values
in qual and recompilation of qual. this facilitates
the retrieval of dynamic query menu items
-------------
createactivelink not working with SQL assignements
changes.dat view on Meta::CPAN
TS change in perl_ARFieldValueOrArithStruct; if tag == AR_VALUE, put dataType into hash
TS added check for h != NULL to strcpyHVal
TS added "case AR_COND_OP_FROM_FIELD" to perl_qualifier()
TS changed handling of qualifier structs in perl_ARFieldLimitStruct, perl_ARJoinSchema,
perl_ARArchiveInfoStruct; those functions now return the converted perl structure
instead of the pointer to a C structure.
TS fixed Makefile.PL to work with $ARSAPI containing spaces on Windows
TS added ars_DeleteContainer (changes to ARS.xs, ARS.pm)
TS fixed Makefile.PL to use $ra_arlibs for Version <= 5.0 on Windows
TS fixed rev_ARValueStructStr2Type: use strcasecmp instead of strncasecmp
(failure to differentiate between string and substring)
TS added "case AR_DATA_TYPE_CURRENCY" to perl_ARValueStruct
TS moved existing code for AR_DATA_TYPE_CURRENCY from sv_to_ARValueStruct
to new function sv_to_ARCurrencyStruct, completed ARCurrencyStruct handling
TS added handling of AR_DATA_TYPE_DATE, AR_DATA_TYPE_TIME_OF_DAY,
to rev_ARValueStruct, sv_to_ARValueStruct
TS added conversion functions rev_ARDisplayInstanceList,
rev_ARDisplayInstanceStruct and rev_ARPermissionList
TS fixed DESTROY(ctrl) (use safefree if allocated with safemalloc)
TS minor fix in in rev_ARValueStructKW2KN (*keyword == '\0')
TS minor fix in rev_ARCoordList_helper ( if (hv_exists("x"... )
changes.dat view on Meta::CPAN
(assume "keyword" if first character == '\0' and length > 0)
JCM minor update to example scripts Dump_User*.pl
released=09/20/2005 version=1.85
TS added binmode-statements in t/10entry.t (test failed on win32)
TS warning cleanup in test files (t/02export.t, t/13join.t)
TS added ars_SetLogging (changes to ARS.xs, ARS.pm, support.c, support-h.template,
html/manual/toc.html; new files: html/manual/ars_SetLogging.html, t/21setlogging.t)
TS fixed pointer dereferencing error in supportrev.c:strmakHval
TS fixed supportrev.c:strcasecmp, strncasecmp; failure to differentiate between
string and substring (e.g. "page_holder" and "page")
TS fixed support.c:perl_ARByteList (Bug ID 1213180)
(David Lindes {lindes at users.sourceforge.net})
TS added support for DATA_TYPE_CURRENCY to perl_ARFieldLimitStruct
TS added function perl_ARCurrencyDetailList
TS fixed support.c:my_strtok, perl_BuildEntryList
(ars_GetEntry crashed when retrieving join form entries)
TS added preprocessor directives (ARS.xs, support.c, support-h.template)
for conditional compilation depending on API version
(compiles now against version 4.5.1 to 6.3.0)
JCM added ars_encodeStatusHistory() routine
changes.dat view on Meta::CPAN
ars_GetFilter<BR>
ars_GetEscalation<BR>
ars_CreateActiveLink<BR>
</blockquote>
see the documentation on the return values of these functions
for details on what has changed.
!JCM changed ars_GetCharMenu so that {'menuType'} is returned
as a string (decoded) instead of an integer.
!JCM added a parameter to ars_Import which will require that existing
scripts be updated. see documentation for details.
JCM added patch submitted by Geoff Endresen which enabled decoding
of push fields actions in GetFilter()
JCM enhanced Makefile.PL to be more intelligent when h2ph fails or
doesnt exist
JCM added/decoded schemaType (within GetSchema()/CompoundSchema structure)
JCM documentation updates
released=2/17/00 version=1.67
JCM ars_SetServerPort() added
JCM fixed bug in ars_GetListSQL()
changes.dat view on Meta::CPAN
routines (which were removed as of ars3.2 api)
released=03/31/98 version=1.6000 BETA
BM removed most of the PPERLC and AWP stuff that was intended
to help the port to ActiveState perl. Use the One True Perl.
BM Changed many of the allocations to use perl's memory manager,
except where the structure or element is grown further internally
by ARS, or where the structure is non-trivial to free(). I still
have concerns about some of the un-freed allocations in
supportrev.c, but at least ALL of the demo scripts,
including ARSDoc-1.11 (with small patch submitted to list) now
run, and produce the right results.
BM Removed all references to ZEROMEM in favor of perl's Zero, which
is guaranteed to work everywhere, and doesn't need additional logic.
BM fixed a couple of small typos, including one in a elliptical
declaration (...) which didn't have a comma separator.
BM Changed the logic of CVLD in one place that was attempting to free()
null pointers.
released=03/31/98 version=1.56
JCM fixed a problem caused by some debugging code that
example/Dump_Setup.pl view on Meta::CPAN
die "login error: $ars_errstr\n" unless defined($c);
@schema = ars_GetListSchema($c, 0, 1024);
@active = ars_GetListActiveLink($c);
@filter = ars_GetListFilter($c);
@escal = ars_GetListEscalation($c);
@menu = ars_GetListCharMenu($c);
@admin_ext = ars_GetListAdminExtension($c);
# Warning! this might make several names map to the same file
sub name_to_path {
my $name = shift;
$name =~ s/ /_/g;
$name =~ s/\//:/g;
return $name;
}
sub dump_type {
my ($path, $type, $names) = @_;
if (! -d "$path") {
mkdir "$path", $perm || die "can't create directory $path";
mkdir "$path/RCS", $perm || die "can't create directory $path/RCS";
}
foreach $name (@$names) {
$val = ars_Export($c,"",$type,$name);
$val =~ s/^#.*/#/gm; # get rid of comments with export date
$name = name_to_path($name);
example/Dump_Users_OO.pl view on Meta::CPAN
# minor change to exception handler
#
# Revision 1.1 1999/05/05 19:57:40 rgc
# Initial revision
#
use strict;
use ARS;
require Carp;
sub mycatch {
my $type = shift;
my $msg = shift;
my $trace = shift;
print "i caught an exception:\ntype=$type msg=$msg\ntraceback:\n$trace\n";
exit;
}
my $LoginNameField = "Login name"; # earlier versions of ars used "Login Name"
example/GetCharMenu.pl view on Meta::CPAN
use ARS;
require 'ars_QualDecode.pl';
# SUBROUTINE
# printl
#
# DESCRIPTION
# prints the string after printing X number of tabs
sub printl {
my $t = shift;
my @s = @_;
if(defined($t)) {
for( ; $t > 0 ; $t--) {
print "\t";
}
print @s;
}
}
example/GetCharMenu.pl view on Meta::CPAN
printMenuItems(1, $menuItems);
print "Simple Menu : (with 'prepend' = false)\n";
print "\t", join("\n\t", ars_simpleMenu($menuItems, 0)), "\n";
print "Simple Menu : (with 'prepend' = true)\n";
print "\t", join("\n\t", ars_simpleMenu($menuItems, 1)), "\n";
ars_Logoff($ctrl);
exit 0;
sub printMenuItems {
my ($l, $m) = (shift, shift);
my ($i) = 0;
for ($i = 0 ; $i <= $#$m ; $i += 2) {
printl($l, $m->[$i]);
if(ref($m->[$i+1]) eq "ARRAY") {
print "\n";
printMenuItems($l+1, $m->[$i+1]);
} else {
print " -> ".$m->[$i+1]."\n";
}
example/GetField.pl view on Meta::CPAN
owner: $fieldInfo->{owner}
";
dumpKV( $fieldInfo, 0 );
ars_Logoff($ctrl);
exit 0;
sub dumpKV {
my $hr = shift;
my $i = shift;
foreach my $k ( keys %$hr ) {
print "\t" x $i . "key=<$k> val=<$hr->{$k}>\n";
if ( ref( $hr->{$k} ) eq "HASH" ) {
dumpKV( $hr->{$k}, $i + 1 );
}
elsif ( ref( $hr->{$k} ) eq "ARRAY" ) {
dumpAV( $hr->{$k}, $i + 1 );
}
}
}
sub dumpAV {
my $ar = shift;
my $i = shift;
my $a = 0;
foreach (@$ar) {
print "\t" x $i . "index=<$a> val=<$_>\n";
if ( ref($_) eq "HASH" ) {
dumpKV( $_, $i + 1 );
}
elsif ( ref($_) eq "ARRAY" ) {
example/GetFilter.pl view on Meta::CPAN
$debug = 0;
require 'ars_QualDecode.pl';
# SUBROUTINE
# printl
#
# DESCRIPTION
# prints the string after printing X number of tabs
sub printl {
my $t = shift;
my @s = @_;
if(defined($t)) {
for( ; $t > 0 ; $t--) {
print "\t";
}
print @s;
}
}
example/GetFilter.pl view on Meta::CPAN
foreach (@{$finfo->{"changeDiary"}}) {
print "\tTIME: ".localtime($_->{"timestamp"})."\n";
print "\tUSER: $_->{'user'}\n";
print "\tWHAT: $_->{'value'}\n";
}
ars_Logoff($ctrl);
exit 0;
# Most of these subroutines were taken directly from Show_ALink.pl
# SUBROUTINE
# PrintArith
#
# DESCRIPTION
# Attempt to "pretty print" the arith expression (just for
# the hell of it)
#
# NOTES
# Notic that parenthesis are printed, although they are not
example/GetFilter.pl view on Meta::CPAN
#
# ars_web.cgi has an evaluation routine for computing the value
# of a arith structure. we will probably break it out into a
# perl module.
#
# THOUGHTS
# I don't know if this routine will work for all cases.. but
# i did some tests and it looked good. Ah.. i just wrote it
# for the fun of it.. so who cares? :)
sub PrintArith {
my $a = shift;
PrintArith_Recurs($a, 0);
print "\n";
}
sub PrintArith_Recurs {
my $a = shift;
my $p = shift;
my $n, $i;
if(defined($a)) {
$n = $a->{left};
if(defined($n)) {
if(defined($n->{arith})) {
PrintArith_Recurs($n->{arith}, $p+1);
} else {
example/GetFilter.pl view on Meta::CPAN
}
}
# SUBROUTINE
# ProcessArithStruct
#
# DESCRIPTION
# This routine breaks down the arithmetic structure
sub ProcessArithStruct {
my $a = shift;
my $n;
if(defined($a)) {
printl 5, "Operation: $a->{oper}\n";
$n = $a->{left};
if(defined($n)) {
# printl 5, "(Left) ";
printl 5, "Value: \"$n->{value}\"\n" if defined($n->{value});
printl 5, "Field: \$$n->{field}->{fieldId}\$\n" if defined($n->{field});
example/GetFilter.pl view on Meta::CPAN
}
}
}
# SUBROUTINE
# ProcessFunctionList
#
# DESCRIPTION
# Parse and dump the function list structure.
sub ProcessFunctionList {
my $t = shift; # how much indentation to use
my @func = @_;
my $i;
printl $t, "Function Name: \"$func[0]\" .. Num of args: $#func\n";
# we need to process all of the arguments listed.
for($i=1;$i<=$#func;$i++) {
printl $t+1, "Value: \"$func[$i]->{value}\"\n" if defined($func[$i]->{value});
example/GetFilter.pl view on Meta::CPAN
}
}
# SUBROUTINE
# ProcessSetFields
#
# DESCRIPTION
# This routine dumps the various forms of the Set Fields
# action in active links.
sub ProcessSetFields {
my $field = shift;
if(defined($field->{sql})) {
printl 3, "SQL:\n";
printl 4, "server: $field->{sql}->{server}\n";
printl 4, "sqlCommand: $field->{sql}->{sqlCommand}\n";
printl 4, "valueIndex: $field->{sql}->{valueIndex}\n";
}
if(defined($field->{valueType})) {
printl 3, "valueType: $field->{valueType}\n";
example/GetFilter.pl view on Meta::CPAN
# ProcessActions
#
# DESCRIPTION
# this routine processes the list of actions for this filter,
# deciding what actions are defined and dumping the appropriate
# information.
#
# AUTHOR
# jeff murphy
sub ProcessActions {
my @actions = @_;
if(defined(@actions)) {
$act_num = 1;
foreach $action (@actions) {
printl 1, "Action $act_num:\n";
if(defined($action->{assign_fields})) {
printl 2, "Set Fields:\n";
foreach $setFields (@{$action->{assign_fields}}) {
printl 3, "fieldId: $setFields->{fieldId}\n";
ProcessSetFields($setFields->{assignment});
example/GetFilter.pl view on Meta::CPAN
if(defined($action->{process})) {
printl 2, "Process: ".$action->{process}."\n";
}
if(defined($action->{notify})) {
printl 2, "Notify:\n";
printl 3, "user: $action->{notify}{user}\n";
printl 3, "notifyMechanism: ".
("Notifier", "E-Mail", "User Default", "Cross Ref",
"Other")[$action->{notify}{notifyMechanism}-1]."\n";
printl 3, "notifyMechanismXRef: $action->{notify}{notifyMechanismXRef}\n";
printl 3, "subjectText: $action->{notify}{subjectText}\n";
printl 3, "notifyText: $action->{notify}{notifyText}\n";
printl 3, "fieldIdListType: ".
("None", "List", "Changed", "All")
[$action->{notify}{fieldIdListType}-1]."\n";
printl 3, "Field List: $action->{notify}{fieldList}\n";
foreach $fid (@{$action->{notify}{fieldList}}) {
printl 4, "$fid\n";
}
}
if(defined($action->{none})) {
example/GetFilter.pl view on Meta::CPAN
# SUBROUTINE
# Decode_opSetMask (value)
#
# DESCRIPTION
# Takes the numeric opSet field and returns a list (space separated)
# of operation names that this filter will execute on.
#
# AUTHOR
# jeff murphy
sub Decode_opSetMask {
my $m = shift;
my $s, $v;
if(defined($m)) {
foreach $v (sort keys %ars_opSet) {
if($v & $m) {
$s = $s.$ars_opSet{$v}." ";
}
}
}
return($s);
}
sub isempty {
my $r = shift;
return 1 if !defined($r);
if(ref($r) eq "ARRAY") {
return ($#{$r} == -1) ? 1 : 0;
}
if(ref($r) eq "HASH") {
my @k = keys %{$r};
return ($#k == -1) ? 1 : 0;
}
return 1 if($r eq "");
example/Show_ALink.pl view on Meta::CPAN
}
$level = 0;
# SUBROUTINE
# printl
#
# DESCRIPTION
# prints the string after printing X number of tabs
sub printl {
my $t = shift;
my @s = @_;
if(defined($t)) {
for( ; $t > 0 ; $t--) {
print "\t";
}
print @s;
}
}
example/Show_ALink.pl view on Meta::CPAN
$AR_EXECUTE_ON_LOOSE_FOCUS, "Loose_Focus",
$AR_EXECUTE_ON_SET_DEFAULT, "Set_Default",
$AR_EXECUTE_ON_QUERY, "Query",
$AR_EXECUTE_ON_AFTER_MODIFY, "After_Modify",
$AR_EXECUTE_ON_AFTER_SUBMIT, "After_Submit",
$AR_EXECUTE_ON_GAIN_FOCUS, "Gain_Focus",
$AR_EXECUTE_ON_WINDOW_OPEN, "Window_Open",
$AR_EXECUTE_ON_WINDOW_CLOSE, "Window_Close"
);
sub DecodeExecMask {
my $m = shift;
my $s, $v;
if(defined($m)) {
foreach $v (sort keys %ars_ExecuteOn) {
if($v & $m) {
$s = $s." ".$ars_ExecuteOn{$v};
}
}
}
example/Show_ALink.pl view on Meta::CPAN
#
# ars_web.cgi has an evaluation routine for computing the value
# of a arith structure. we will probably break it out into a
# perl module.
#
# THOUGHTS
# I don't know if this routine will work for all cases.. but
# i did some tests and it looked good. Ah.. i just wrote it
# for the fun of it.. so who cares? :)
sub PrintArith {
my $a = shift;
PrintArith_Recurs($a, 0);
print "\n";
}
sub PrintArith_Recurs {
my $a = shift;
my $p = shift;
my $n, $i;
if(defined($a)) {
$n = $a->{left};
if(defined($n)) {
if(defined($n->{arith})) {
PrintArith_Recurs($n->{arith}, $p+1);
} else {
example/Show_ALink.pl view on Meta::CPAN
}
}
# SUBROUTINE
# ProcessArithStruct
#
# DESCRIPTION
# This routine breaks down the arithmetic structure
sub ProcessArithStruct {
my $a = shift;
my $n;
if(defined($a)) {
printl 5, "Operation: $a->{oper}\n";
$n = $a->{left};
if(defined($n)) {
# printl 5, "(Left) ";
printl 5, "Value: \"$n->{value}\"\n" if defined($n->{value});
printl 5, "Field: \$$n->{field}->{fieldId}\$\n" if defined($n->{field});
example/Show_ALink.pl view on Meta::CPAN
}
}
}
# SUBROUTINE
# ProcessFunctionList
#
# DESCRIPTION
# Parse and dump the function list structure.
sub ProcessFunctionList {
my $t = shift; # how much indentation to use
my @func = @_;
my $i;
printl $t, "Function Name: \"$func[0]\" .. Num of args: $#func\n";
# we need to process all of the arguments listed.
for($i=1;$i<=$#func;$i++) {
printl $t+1, "Value: \"$func[$i]->{value}\"\n" if defined($func[$i]->{value});
example/Show_ALink.pl view on Meta::CPAN
}
}
# SUBROUTINE
# ProcessSetFields
#
# DESCRIPTION
# This routine dumps the various forms of the Set Fields
# action in active links.
sub ProcessSetFields {
my $field = shift;
if(defined($field->{none})) {
printl 3, "No set fields instructions found.\n";
}
if(defined($field->{value})) {
printl 3, "Value: \$$field->{value}\$\n";
}
if(defined($field->{field})) {
printl 3, "Field: $field->{field}\n";
example/Show_ALink.pl view on Meta::CPAN
}
}
# SUBROUTINE
# ProcessMacroStruct
#
# DESCRIPTION
# This routine breaks down the macro structure and
# dumps the information contained in it.
sub ProcessMacroStruct {
my $t = shift; # how much indentation to use
my $m = shift; # the macro struct
my $i, @p;
if(defined($m)) {
printl $t, "Macro Name : \"$m->{macroName}\"\n";
printl $t, "Macro Params: $m->{macroParms}\n";
foreach (keys %{$m->{macroParms}}) {
printl $t+1, "$_ = $m->{macroParms}{$_}\n";
example/Show_ALink.pl view on Meta::CPAN
# SUBROUTINE
# ProcessActions
#
# DESCRIPTION
# this routine processes the list of actions for this active link,
# deciding what actions are defined and dumping the appropriate
# information.
sub ProcessActions {
my @actions = @_;
if(defined(@actions)) {
$act_num = 1;
foreach $action (@actions) {
printl 1, "Action $act_num:\n";
if(defined($action->{macro})) {
printl 2, "Macro:\n";
ProcessMacroStruct(3, $action->{macro});
}
if(defined($action->{assign_fields})) {
example/Show_ALink.pl view on Meta::CPAN
print "\tUSER: $_->{user}\n";
print "\tWHAT: $_->{value}\n";
}
# Log out of the server.
ars_Logoff($ctrl);
exit 0;
sub isempty {
my $r = shift;
return 1 if !defined($r);
if(ref($r) eq "ARRAY") {
return ($#{$r} == -1) ? 1 : 0;
}
if(ref($r) eq "HASH") {
my @k = keys %{$r};
return ($#k == -1) ? 1 : 0;
}
return 1 if($r eq "");
example/Show_Menu.pl view on Meta::CPAN
# Log onto the ars server specified
($ctrl = ars_Login($server, $username, $password)) ||
die "can't login to the server";
# SUBROUTINE
# IndPrint(indentation, string)
#
# DESCRIP
# This subroutine will print a string with [indentation] number
# of preceding TABS.
sub IndPrint {
my $ind = shift;
my $s = shift;
my $i;
if(defined($s)) {
for($i = 0; $i < $ind; $i++) {
print "\t";
}
print $s;
}
}
# SUBROUTINE
# DumpMenu(arraypointer, indentation count)
#
# DESCRIP
# Recursive subroutine to dump menu and sub menu items
sub DumpMenu {
my $m = shift;
my $i = shift;
my @m = @$m;
my $name, $val;
$i = 0 unless $i;
while (($name, $val, @m) = @m) {
if (ref($val)) {
IndPrint($i, "SubMenu: $name\n");
example/WhoUsesIt.pl view on Meta::CPAN
foreach $link (@alinks) {
if($link =~ /$opt_a/) {
$users{$schema} .= "$link,";
}
}
}
}
foreach $schema (sort keys %users) {
print "\t$schema\n";
foreach $link (split(/,/, substr($users{$schema}, 0, length($users{$schema})-1))) {
print "\t\t$link\n";
}
}
} elsif($opt_f) {
# find any schema that uses this filter.
print "Searching for Filter \"$opt_f\" in Schema \"$SCHEMA\" ...\n";
foreach $schema (@schemas) {
example/WhoUsesIt.pl view on Meta::CPAN
foreach $filter (@filters) {
if($filter =~ /^$opt_f$/) {
$users{$schema} .= "$filter,";
}
}
}
}
foreach $schema (sort keys %users) {
print "\t$schema\n";
foreach $filter (split(/,/, substr($users{$schema}, 0, length($users{$schema})-1))) {
print "\t\t$filter\n";
}
}
} elsif($opt_m) {
# find any schema that uses this menu.
# this particular routine will take longer, because we
# need to open each schema, and then retrieve all field
# definitions and finally flip thru each field and see
# what menus (if any) are attached.
example/WhoUsesIt.pl view on Meta::CPAN
($finfo->{limit}{charMenu} =~ /$opt_m/)) {
$users{$schema} .= "$finfo->{limit}{charMenu},";
}
}
}
}
}
foreach $schema (sort keys %users) {
print "\t$schema\n";
foreach $menu (split(/,/, substr($users{$schema}, 0, length($users{$schema})-1))) {
print "\t\t$menu\n";
}
}
} elsif($opt_e) {
# find any schema that uses this escalation.
print "Searching for Escalation \"$opt_e\"...\n";
foreach $schema (@schemas) {
example/WhoUsesIt.pl view on Meta::CPAN
# ROUTINE
# Usage()
#
# DESCRIPTION
# Dump usage information.
#
# AUTHOR
# jeff murphy
sub Usage {
print "Usage: $pname [-v] [-h] [-s schema] [-a | -f | -m | -e | -p [name]]\n";
print " [username] [password]\n"
}
example/ars_GetEntryBLOB.pl view on Meta::CPAN
foreach (keys %v) {
print "$r{$_} = $v{$_}\n";
dh($v{$_}) if $r{$_} =~ /Attachment/;
ra($_) if $r{$_} =~ /Attachment/;
}
ars_Logoff($c);
exit 0;
#sub AR_LOC_FILENAME { 1;}
#sub AR_LOC_BUFFER { 2;}
sub ra {
my $fid = shift;
print "\t[Retrieving attachment.]\n";
# file: $a = 0 || 1
# buff: $a = undef || attachment
unlink('/tmp/attachtest', '/tmp/attachtest2');
example/ars_GetEntryBLOB.pl view on Meta::CPAN
$fid,
ARS::AR_LOC_BUFFER);
die "GetEntryBLOB: $ars_errstr" if(!defined($a));
print "\tattachment size = ".length($a)."\n";
open(FD, ">/tmp/attachtest2") || die "open: $!";
print FD $a;
close(FD);
}
sub dh {
my $h = shift;
foreach (keys %$h) {
print "\t$_ = $h->{$_}\n";
}
}
example/ars_QualDecode.pl view on Meta::CPAN
# We need the ctrl struct and schema name so
# we can reverse map from fieldId's to field names.
#
# RETURNS
# a scalar on success
# undef on failure
#
# AUTHOR
# jeff murphy
sub ars_Decode_QualHash {
my $c = shift;
my $s = shift;
my $q = shift;
my $fids;
my %fids_orig;
my $fieldName;
print "ars_Decode_QualHash(c=$c, s=$s, q=$q)\n" if !$debug;
if(!(defined($c) && (ref($c) eq "ARControlStructPtr"))) {
example/ars_QualDecode.pl view on Meta::CPAN
}
(%fids_orig = ars_GetFieldTable($c, $s)) ||
die "GetFieldTable: $ars_errstr";
foreach $fieldName (keys %fids_orig) {
$fids{$fids_orig{$fieldName}} = $fieldName;
}
return ars_DQH($q, %fids);
}
sub ars_DQH {
my $h = shift;
my $fids = shift;
my $e = undef;
print "ars_DQH(h=$h, fids=$fids)\n" if $debug;
if($h) {
print "\n
left = $h->{left}
example/ars_QualDecode.pl view on Meta::CPAN
else {
$e .= "(".Decode_FVoAS($h->{left}, $fids)." ".$h->{oper}." ".Decode_FVoAS($h->{right}, $fids).")";
}
} else {
print "WARNING: ars_DQH: invalid params\n";
}
return $e;
}
sub Decode_FVoAS {
my $h = shift;
my $fids = shift;
my $e = "";
# my $f;
# print "keys:\n";
# foreach $f (keys %$h) {
# print "$f <".$h->{$f}.">\n";
# }
# print "\n";
example/attachTest.pl view on Meta::CPAN
foreach (keys %v) {
print "$r{$_} = $v{$_}\n";
dh($v{$_}) if $r{$_} eq "Attachment Field";
ra($_) if $r{$_} eq "Attachment Field";
}
ars_Logoff($c);
exit 0;
#sub AR_LOC_FILENAME { 1;}
#sub AR_LOC_BUFFER { 2;}
sub ra {
my $fid = shift;
print "\t[Retrieving attachment.]\n";
# file: $a = 0 || 1
# buff: $a = undef || attachment
ars_GetEntryBLOB($c, "ARSperl Test", $id,
example/attachTest.pl view on Meta::CPAN
$fid,
ARS::AR_LOC_BUFFER);
die "GetEntryBLOB: $ars_errstr" if(!defined($a));
print "\tattachment size = ".length($a)."\n";
open(FD, ">/tmp/attachtest2") || die "open: $!";
print FD $a;
close(FD);
}
sub dh {
my $h = shift;
foreach (keys %$h) {
print "\t$_ = $h->{$_}\n";
}
}
example/getAttachment-OO.pl view on Meta::CPAN
print "field/value dump:\n";
foreach (keys %v) {
print "$_ = $v{$_}\n";
dh($v{$_}) if $s->getFieldType(-field => $_) eq "attach";
ra($_) if $s->getFieldType(-field => $_) eq "attach";
}
exit 0;
sub ra {
my $field = shift;
print "\t[Retrieving attachment.]\n";
# file: $a = 0 || 1
# buff: $a = undef || attachment
$s->getAttachment(-entry => "000000000000002",
-field => $field,
-file => "/tmp/attachtest");
example/getAttachment-OO.pl view on Meta::CPAN
-field => $field);
print "\tattachment size = ".length($a)."\n";
open(FD, ">/tmp/attachtest2") || die "open: $!";
print FD $a;
close(FD);
# if you "cmp" the files, they should be identical.
}
sub dh {
my $h = shift;
foreach (keys %$h) {
print "\t$_ = $h->{$_}\n";
}
}
html/WhoUsesIt.html view on Meta::CPAN
-M list all menus that use this file
-p list all filters that call this process
-s specify a specific schema to search
-v verbose output
-h get help on usage
</PRE>
<H3> Examples </H3>
<B> First we'll see who is calling a particular external process. This is a
substring match, so the file name of the process need only <I>contain</I>
the characters "mail_ip" to match. </B>
<PRE>
% ./WhoUsesIt.pl -p mail_ip
Username: jcmurphy
Password:
Searching for filters that call "mail_ip"...
PT-Mail IP List
SM-Mail IP List
TS-PTA-Mail_IP_List
html/changes.html view on Meta::CPAN
</font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>changed handling of qualifier structs in perl_ARFieldLimitStruct, perl_ARJoinSchema,
perl_ARArchiveInfoStruct; those functions now return the converted perl structure instead of the pointer to a C structure. </font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>fixed Makefile.PL to work with $ARSAPI containing spaces on Windows
</font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added ars_DeleteContainer (changes to ARS.xs, ARS.pm)
</font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>fixed Makefile.PL to use $ra_arlibs for Version <= 5.0 on Windows
</font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>fixed rev_ARValueStructStr2Type: use strcasecmp instead of strncasecmp
(failure to differentiate between string and substring) </font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added "case AR_DATA_TYPE_CURRENCY" to perl_ARValueStruct
</font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>moved existing code for AR_DATA_TYPE_CURRENCY from sv_to_ARValueStruct
to new function sv_to_ARCurrencyStruct, completed ARCurrencyStruct handling </font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added handling of AR_DATA_TYPE_DATE, AR_DATA_TYPE_TIME_OF_DAY,
to rev_ARValueStruct, sv_to_ARValueStruct </font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added conversion functions rev_ARDisplayInstanceList,
rev_ARDisplayInstanceStruct and rev_ARPermissionList </font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>fixed DESTROY(ctrl) (use safefree if allocated with safemalloc)
</font></td></tr>
html/changes.html view on Meta::CPAN
</tr></table></td>
</tr><tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added binmode-statements in t/10entry.t (test failed on win32)
</font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>warning cleanup in test files (t/02export.t, t/13join.t)
</font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added ars_SetLogging (changes to ARS.xs, ARS.pm, support.c, support-h.template,
html/manual/toc.html; new files: html/manual/ars_SetLogging.html, t/21setlogging.t) </font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>fixed pointer dereferencing error in supportrev.c:strmakHval
</font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>fixed supportrev.c:strcasecmp, strncasecmp; failure to differentiate between
string and substring (e.g. "page_holder" and "page") </font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>fixed support.c:perl_ARByteList (Bug ID 1213180)
(David Lindes {lindes at users.sourceforge.net}) </font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added support for DATA_TYPE_CURRENCY to perl_ARFieldLimitStruct
</font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added function perl_ARCurrencyDetailList
</font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>fixed support.c:my_strtok, perl_BuildEntryList
(ars_GetEntry crashed when retrieving join form entries) </font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added preprocessor directives (ARS.xs, support.c, support-h.template)
for conditional compilation depending on API version (compiles now against version 4.5.1 to 6.3.0) </font></td></tr>
html/changes.html view on Meta::CPAN
<tr bgcolor='#dddddd'><td width='10%'>(JCM)</td><td width='90%'><font color='black'>arsperl now requires at minimum perl 5.004.
</font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(JCM)</td><td width='90%'><font color='black'>converted "na" "sv_unref" to PL_ namespace.
added perl-version checking so it will still compile against 5.004. </font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(JCM)</td><td width='90%'><font color='red'>ars4.5 compatibility changes. the following functions
have altered return values which will break scripts that use them <U>if you compile against 4.5 or later libraries</U> <blockquote> ars_GetActiveLink<BR> ars_GetFilter<BR> ars_GetEscalation<BR> ars_CreateActiveLink<BR> </blockquote> see the documenta...
<tr bgcolor='#eeeeee'><td width='10%'>(JCM)</td><td width='90%'><font color='red'>changed ars_GetCharMenu so that {'menuType'} is returned
as a string (decoded) instead of an integer. </font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(JCM)</td><td width='90%'><font color='red'>added a parameter to ars_Import which will require that existing
scripts be updated. see documentation for details. </font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(JCM)</td><td width='90%'><font color='black'>added patch submitted by Geoff Endresen which enabled decoding
of push fields actions in GetFilter() </font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(JCM)</td><td width='90%'><font color='black'>enhanced Makefile.PL to be more intelligent when h2ph fails or
doesnt exist </font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(JCM)</td><td width='90%'><font color='black'>added/decoded schemaType (within GetSchema()/CompoundSchema structure)
</font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(JCM)</td><td width='90%'><font color='black'>documentation updates
</table></td></tr></table>
<P>
html/changes.html view on Meta::CPAN
<TABLE CELLSPACING='0' CELLPADDING='3' WIDTH='100%' BORDER='0'
BGCOLOR='lightblue'>
<tr><td colspan='2'>
<table width='100%' border='0'><tr>
<td width='50%'>Released: <B>03/31/98</B></td>
<td width='50%'>Version: <B>1.6000 BETA
</B></td>
</tr></table></td>
</tr><tr bgcolor='#eeeeee'><td width='10%'>(BM)</td><td width='90%'><font color='black'>removed most of the PPERLC and AWP stuff that was intended
to help the port to ActiveState perl. Use the One True Perl. </font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(BM)</td><td width='90%'><font color='black'>Changed many of the allocations to use perl's memory manager,
except where the structure or element is grown further internally by ARS, or where the structure is non-trivial to free(). I still have concerns about some of the un-freed allocations in supportrev.c, but at least ALL of the demo scripts, includin...
<tr bgcolor='#eeeeee'><td width='10%'>(BM)</td><td width='90%'><font color='black'>Removed all references to ZEROMEM in favor of perl's Zero, which
is guaranteed to work everywhere, and doesn't need additional logic. </font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(BM)</td><td width='90%'><font color='black'>fixed a couple of small typos, including one in a elliptical
declaration (...) which didn't have a comma separator. </font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(BM)</td><td width='90%'><font color='black'>Changed the logic of CVLD in one place that was attempting to free()
null pointers. </table></td></tr></table>
<P>
html/copying.html view on Meta::CPAN
operating system on which the executable runs, unless that component
itself accompanies the executable.<p>
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.<p>
<dt>4.
<dd>You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.<p>
<dt>5.
<dd>You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.<p>
<dt>6.
<dd>Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.<p>
<dt>7.
<dd>If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
html/copying.html view on Meta::CPAN
<dl>
<dd>Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.<p>
<dd><signature of Ty Coon>, 1 April 1989<br>
Ty Coon, President of Vice<p>
</dl>
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.<p>
</body>
</html>
( run in 1.973 second using v1.01-cache-2.11-cpan-88abd93f124 )