ARSperl
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
(TS) added ars_BeginBulkEntryTransaction, ars_EndBulkEntryTransaction
(TS) added AR_FIELD_OFFSET handling in perl_ARFieldValueOrArithStruct (support.c)
(TS) added ars_SetSessionConfiguration
(TS) completed sv_to_ARCurrencyStruct (support.c)
(TS) ARS.pm: set $ARS::logging_file_ptr = 0 to avoid "uninitialized" warning
(TS) changed t/01import.t to import form "ARSperl Test3"
(TS) added ars_CreateContainer, ars_SetContainer
(TS) added ars_CreateFilter, ars_SetFilter, ars_CreateEscalation, ars_SetEscalation,
ars_SetActiveLink
(TS) added declaration of boolcpyHVal(...) to supportrev.h
(TS) added declaration of revTypeName(...) to supportrev.h
example/ars_GetListEntry.pl
example/getAttachment-OO.pl
example/00-ReadMe
example/ars_GetListContainer.pl
example/Show_ALink.pl
example/ars_GetListEntryWithMultiSchemaFields.pl
example/GetFilter.pl
example/Show_Menu.pl
example/Dump_Setup.pl
example/ars_GetListGroup.pl
example/attachTest.pl
example/ars_GetControlStructFields.pl
example/ars_decodeStatusHistory.pl
example/ars_GetListSQL.pl
example/ars_DateToJulianDate.pl
example/ars_SetServerInfo.pl
example/AddUsersToGroup.pl
example/WhoUsesIt.pl
example/List_Entries.pl
example/GetField.pl
example/del_all.pl
Makefile.PL view on Meta::CPAN
#
# 'LD' => "/usr/ccs/bin/ld",
# don't fiddle with this
'realclean' => {
'FILES' => 'support.h ARS/ar-h.pm ARS/arerrno-h.pm ARS/_h2ph_pre.ph t/config.cache serverTypeInfoHints.h *~ .purify '
}
);
makeTestConfig();
print "
Type 'make' (windows: 'nmake') to build ARSperl.
Type 'make test' to test ARSperl before installing.
Type 'make install' to install ARSperl.
";
exit 0;
example/ars_GetListEntry.pl view on Meta::CPAN
( my %fids = ars_GetFieldTable( $ctrl, $schema ) )
|| die "ars_GetFieldTable: $ars_errstr";
( my $qual = ars_LoadQualifier( $ctrl, $schema, "(1 = 1)" ) )
|| die "ars_LoadQualifier: $ars_errstr";
# basic format: allow the server to provide sorting order
# and query list fields.
print "Testing: basic format.\n";
( my @entries = ars_GetListEntry( $ctrl, $schema, $qual, 0, 0 ) )
|| die "ars_GetListEntry: $ars_errstr";
for ( my $i = 0 ; $i < $#entries ; $i += 2 ) {
printf( "%s %s\n", $entries[$i], $entries[ $i + 1 ] );
}
# another format: specify a sorting order.
# sort by license type, ascending.
print "Testing: basic + sorting format.\n";
( my @sorted_entries =
ars_GetListEntry( $ctrl, $schema, $qual, 0, 0, $fids{$login_name}, 1 ) )
|| # sort on Login Name, ascending
die "ars_GetListEntry: $ars_errstr";
for ( my $i = 0 ; $i < $#sorted_entries ; $i += 2 ) {
printf( "%s %s\n", $sorted_entries[$i], $sorted_entries[ $i + 1 ] );
}
# another format: specify a custom query list field-list.
print "Testing: basic + sorting + custom field-list format.\n";
if ( !defined( $fids{$login_name} ) || !defined( $fids{$full_name} ) ) {
print
"Sorry. Either i can't find the field-id for \"$login_name\" or \"$full_name\"\n on your \"$schema\" form. I'm skipping this test.\n";
}
else {
(
my @basic_sorted_entries = ars_GetListEntry(
$ctrl, $schema, $qual, 0, 0,
[
example/attachTest.pl view on Meta::CPAN
#!/oratest/perl/bin/perl
use ARS;
$c = ars_Login(shift, shift, shift);
%f = ars_GetFieldTable($c, "ARSperl Test");
foreach (keys %f) {
$r{$f{$_}} = $_;
}
print "Creating new entry with an attachment..\n";
($id = ars_CreateEntry($c, "ARSperl Test",
$f{'Attachment Field'}, { file => "/tmp/test", size => 0 },
#$f{'Attachment Field'}, { buffer => "/tmp/test", size => 9 },
$f{'Submitter'}, "jeff",
$f{'Status'}, 1,
$f{'Short Description'}, "none")) ||
die "CreateEntry: $ars_errstr";
print "Created entry $id\n";
print "Fetching the entry we just made..\n";
%v = ars_GetEntry($c, "ARSperl Test", $id);
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;
html/changes.html view on Meta::CPAN
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added ars_BeginBulkEntryTransaction, ars_EndBulkEntryTransaction
</font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added AR_FIELD_OFFSET handling in perl_ARFieldValueOrArithStruct (support.c)
</font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added ars_SetSessionConfiguration
</font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>completed sv_to_ARCurrencyStruct (support.c)
</font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>ARS.pm: set $ARS::logging_file_ptr = 0 to avoid "uninitialized" warning
</font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>changed t/01import.t to import form "ARSperl Test3"
</font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added ars_CreateContainer, ars_SetContainer
</font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added ars_CreateFilter, ars_SetFilter, ars_CreateEscalation, ars_SetEscalation,
ars_SetActiveLink </font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added declaration of boolcpyHVal(...) to supportrev.h
</font></td></tr>
<tr bgcolor='#eeeeee'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added declaration of revTypeName(...) to supportrev.h
</font></td></tr>
<tr bgcolor='#dddddd'><td width='10%'>(TS)</td><td width='90%'><font color='black'>added "rev_ARReferenceStruct" to supportrev.c
html/manual/ars_GetEntryBLOB.html view on Meta::CPAN
<DT><B>On success</B><DD>
returns 1 if locType == AR_LOC_FILENAME <BR>
returns a scalar buffer if locType == AR_LOC_BUFFER <BR>
<DT><B>On failure</B><DD>
Returns <CODE>undef</CODE>.
</DL>
<P>Example:
<PRE>
ars_GetEntryBLOB($c, "00-Test", "000000000000001",
$fid,
ARS::AR_LOC_FILENAME,
"/tmp/attachtest") ||
die ("GetEntryBLOB: $ars_errstr");
my $a = ars_GetEntryBLOB($c, "00-Test", "000000000000001",
$fid,
ARS::AR_LOC_BUFFER);
die "GetEntryBLOB: $ars_errstr" if(!defined($a));
print "blob size = ".length($a)."\n";
open(FD, ">/tmp/attachtest2") || die "open: $!";
print FD $a;
close(FD);
</PRE>
html/manual/ars_SetImpersonatedUser.html view on Meta::CPAN
<DL>
<DT><B>On success</B><DD>
Returns 1
<DT><B>On failure</B><DD>
Returns 0
</DL>
<P>Example:
<PRE>
ars_SetImpersonatedUser($ctrl,"TestUser") || die "$ars_errstr";
</PRE>
<P>
<I>ars_SetImpersonatedUser was introduced in version 1.90 of ARSperl</I>
<P>
<HR WIDTH="30%">
<P>
<A HREF="toc.html"><IMG ALT="<--" SRC="arrow.gif" ALIGN=CENTER> Table of Contents </A>
<p>
html/manual/ars_SetLogging.html view on Meta::CPAN
<P>Example:
<PRE>
# start filter and sql logging
# (the logfile gets opened for appending)
ars_SetLogging( $c, ARS::AR_DEBUG_SERVER_FILTER | ARS::AR_DEBUG_SERVER_SQL,
"/var/log/filter_sql.log" ) ||
die ("SetLogging (start): $ars_errstr");
# call any ARS API function
my $id = ars_CreateEntry( $c, "User", 101 => "TestUser", 109 => 1 );
# stop logging (specify logTypeMask = 0 and no file)
# (the logfile gets closed)
ars_SetLogging( $c, 0 ) ||
die ("SetLogging (end): $ars_errstr");
</PRE>
<P>If SQL and Filter logging do appear as not working, it may be because the
the user is not a member of the "client-side logging group."
t/01import.t view on Meta::CPAN
if(ars_APIVersion() >= 6) {
$d = "aptest51.def";
}elsif(ars_APIVersion() >= 4) {
$d = "aptest50.def";
}
# delete the schema (assuming it already exists). if it doesnt,
# we ignore the error.
ars_DeleteSchema($ctrl, "ARSperl Test", ARS::AR_SCHEMA_FORCE_DELETE);
ars_DeleteSchema($ctrl, "ARSperl Test2", ARS::AR_SCHEMA_FORCE_DELETE);
ars_DeleteSchema($ctrl, "ARSperl Test-join", ARS::AR_SCHEMA_FORCE_DELETE);
ars_DeleteSchema($ctrl, "ARSperl Test3", ARS::AR_SCHEMA_FORCE_DELETE);
ars_DeleteFilter($ctrl, "ARSperl Test-Filter1");
ars_DeleteActiveLink($ctrl, "ARSperl Test-alink1");
ars_DeleteEscalation($ctrl, "ARSperl Test-escalation1");
ars_DeleteCharMenu($ctrl, "ARSperl Test-menu-search1");
ars_DeleteContainer($ctrl,"ARSperl Test-FilterGuide1");
# read in the schema definition
my $buf = "";
open(FD, "./t/".$d) || die "not ok (open $!)\n";
while(<FD>) {
$buf .= $_;
}
close(FD);
# import it
my $rv = ars_Import($ctrl,
&ARS::AR_IMPORT_OPT_CREATE,
$buf,
"Schema", "ARSperl Test",
"Schema", "ARSperl Test2",
"Schema", "ARSperl Test-join",
"Schema", "ARSperl Test3",
"Filter", "ARSperl Test-Filter1",
"Active_Link", "ARSperl Test-alink1",
"Escalation", "ARSperl Test-escalation1",
"Char_Menu", "ARSperl Test-menu-search1",
"Container", "ARSperl Test-FilterGuide1",
);
if(defined($rv) && ($rv == 1)) {
print "ok\n";
} else {
print "not ok [$ars_errstr]\n";
}
ars_Logoff($ctrl);
t/02export.t view on Meta::CPAN
my $d = "aptest.def";
if(ars_APIVersion() >= 4) {
$d = "aptest50.def";
}
my $def = "";
my $c = 1;
my @objects = (
"schema", "ARSperl Test",
"schema", "ARSperl Test2",
"schema", "ARSperl Test-join",
"filter", "ARSperl Test-Filter1",
"active_link", "ARSperl Test-alink1",
"escalation", "ARSperl Test-escalation1",
"char_menu", "ARSperl Test-menu-search1",
"container", "ARSperl Test-FilterGuide1",
);
my $junk = ars_Export($ctrl, "", 0, "schema", "blarg292394");
if (defined($junk)) {
print "not ok [$c]\n";
} else {
print "ok [$c]\n";
}
$c++;
t/09qualifier.t view on Meta::CPAN
my($ctrl) = ars_Login(&CCACHE::SERVER,
&CCACHE::USERNAME,
&CCACHE::PASSWORD, "","", &CCACHE::TCPPORT);
if(!defined($ctrl)) {
print "not ok [1]\n";
} else {
print "ok [1]\n";
}
my $q1 = ars_LoadQualifier($ctrl, "ARSperl Test",
qq{'Status' = "New"}
);
if (defined($q1)) {
print "ok [2]\n";
} else {
print "not ok [2] ($ars_errstr)\n";
}
print "expect DESTROY..\n";
undef $q1; # should result in a call to DESTROY
print "did you get it? (ARSPDEBUG must be defined)\n";
{
my $q2 = ars_LoadQualifier($ctrl, "ARSperl Test", "'Submitter' = \"jcmurphy\"");
if (defined($q2)) {
print "ok [3]\n";
} else {
print "not ok [3] ($ars_errstr)\n";
}
}
# implicit call to DESTROY for q2
my $q3 = ars_LoadQualifier($ctrl, "ARSperl Test", "'Create Date' > \"1/1/2000 01:02:03\"");
if (defined($q3)) {
print "ok [4]\n";
} else {
print "not ok [4] ($ars_errstr)\n";
}
exit 0; #implicit call to DESTROY for q3
t/10alink.t view on Meta::CPAN
&CCACHE::USERNAME,
&CCACHE::PASSWORD, "","", &CCACHE::TCPPORT);
if (defined($c)) {
print "ok [1] (login)\n";
} else {
print "not ok [1] (login $ars_errstr)\n";
exit(0);
}
my $a = ars_GetActiveLink($c, "ARSperl Test-alink1");
if (defined($a)) {
print "ok [2] (GAL) \n";
} else {
print "not ok [2] (GAL $ars_errstr)\n";
exit(0);
}
# the active link should have a schemaList key
t/10entry.t view on Meta::CPAN
-username => &CCACHE::USERNAME,
-password => &CCACHE::PASSWORD,
-tcpport => &CCACHE::TCPPORT,
-catch => { ARS::AR_RETURN_ERROR => "main::mycatch",
ARS::AR_RETURN_WARNING => "main::mycatch",
ARS::AR_RETURN_FATAL => "main::mycatch"
},
-debug => undef);
print "ok [1 cnx]\n";
my $s = $c->openForm(-form => "ARSperl Test");
print "ok [2 openform]\n";
# test 1: create an entry
my $id = $s->create("-values" => { 'Submitter' => &CCACHE::USERNAME,
'Status' => 'Assigned',
'Short Description' => 'A test submission',
'Diary Field' => 'A diary entry'
}
);
t/10getescalation.t view on Meta::CPAN
&CCACHE::USERNAME,
&CCACHE::PASSWORD, "","", &CCACHE::TCPPORT);
if (defined($c)) {
print "ok [1] (login)\n";
} else {
print "not ok [1] (login $ars_errstr)\n";
exit(0);
}
my $a = ars_GetEscalation($c, "ARSperl Test-escalation1");
if (defined($a)) {
print "ok [2] (GESC) \n";
} else {
print "not ok [2] (GESC $ars_errstr)\n";
exit(0);
}
# the escalation should have a schemaList key
t/10getlist.t view on Meta::CPAN
#!perl
use ARS;
use strict;
require './t/config.cache';
use Test::More tests => 9;
my $c = ars_Login(&CCACHE::SERVER,
&CCACHE::USERNAME,
&CCACHE::PASSWORD, "","", &CCACHE::TCPPORT);
ok(defined($c), "login") || diag "login: $ars_errstr";
SKIP: {
skip 8, "login failed" unless defined($c);
my @a = ars_GetListEscalation($c, "ARSperl Test");
ok($#a == 0, "GetListEscalation") ||
diag "GetListEscalation ($#a) $ars_errstr";
@a = ars_GetListField($c, "ARSperl Test", 0, 1);
ok($#a == 110, "GetListField") ||
diag "GetListField ($#a) $ars_errstr";
@a = ars_GetListFilter($c, "ARSperl Test");
ok($#a == 0, "GetListFilter") ||
diag "GetListFilter ($#a) $ars_errstr";
@a = ars_GetListGroup($c);
ok(@a, "GetListGroup") ||
diag "GetListGroup $ars_errstr";
@a = ars_GetListSchema($c, 0, 0 + 1024);
ok(@a, "GetListSchema") ||
diag "GetListSchema $ars_errstr";
t/12lotsoffields.t view on Meta::CPAN
if(!defined($ctrl)) {
print "not ok [", $TN++, "]\n";
while($TN <= $NT) {
print "not ok [", $TN++, "]\n";
}
exit(0);
} else {
print "ok [", $TN++,"]\n";
}
my %ft = ars_GetFieldTable($ctrl, "ARSperl Test");
if (%ft) {
print "ok [", $TN++, "]\n";
} else {
print "not ok [", $TN++, "]\n";
while($TN <= $NT) {
print "not ok [", $TN++, "]\n";
}
exit(0);
}
t/20merge.t view on Meta::CPAN
if(!defined($c)) {
for(my $i = 1 ; $i <= $maxtest ; $i++) {
print "not ok [$i] [ctrl]\n";
}
exit 0;
} else {
print "ok [1]\n";
}
my %fids = ars_GetFieldTable($c, "ARSperl Test");
if(!(%fids)) {
for(my $i = 2 ; $i <= $maxtest ; $i++) {
print "not ok [$i] [gft]\n";
}
exit 0;
} else {
print "ok [2]\n";
}
t/32createcontainer.t view on Meta::CPAN
} else {
print "not ok [1] (login $ars_errstr)\n";
exit(0);
}
#my @containers = sort {lc($a) cmp lc($b)} map {$_->{containerName}} ars_GetListContainer( $ctrl, 0, &ARS::AR_HIDDEN_INCREMENT, &ARS::ARCON_ALL );
#die "ars_GetListContainer( ALL ): $ars_errstr\n" if $ars_errstr;
#my @containers = sort {lc($a) cmp lc($b)} map {$_->{containerName}} grep {$_->{containerType} =~ /guide/} ars_GetListContainer( $ctrl, 0, &ARS::AR_HIDDEN_INCREMENT, &ARS::ARCON_ALL );
#die "ars_GetListContainer( ALL ): $ars_errstr\n" if $ars_errstr;
my @containers = ( 'ARSperl Test-FilterGuide1' );
$| = 1;
foreach my $ctnr ( @containers ){
next if $ctnr =~ / \((copy|renamed)\)$/;
my $ctnrNew = "$ctnr (copy)";
ars_DeleteContainer( $ctrl, $ctnrNew );
copyContainer( $ctrl, $ctnr, $ctnrNew );
t/33setcontainer.t view on Meta::CPAN
if (defined($ctrl)) {
print "ok [1] (login)\n";
} else {
print "not ok [1] (login $ars_errstr)\n";
exit(0);
}
#my @objects = sort {lc($a) cmp lc($b)} grep {/\(copy\)/} map {$_->{containerName}} grep {$_->{containerType} =~ /guide/} ars_GetListContainer( $ctrl, 0, &ARS::AR_HIDDEN_INCREMENT, &ARS::ARCON_ALL );
#die "ars_GetListContainer( ALL ): $ars_errstr\n" if $ars_errstr;
my @objects = ( 'ARSperl Test-FilterGuide1 (copy)' );
$| = 1;
foreach my $obj ( @objects ){
next if $obj !~ / \(copy\)$/;
my $objNew = $obj;
$objNew =~ s/ \(copy\)$/ (renamed)/;
ars_DeleteContainer( $ctrl, $objNew );
t/35setactlink.t view on Meta::CPAN
if (defined($ctrl)) {
print "ok [1] (login)\n";
} else {
print "not ok [1] (login $ars_errstr)\n";
exit(0);
}
#my @objects = sort {lc($a) cmp lc($b)} grep {/\(copy\)/} ars_GetListActiveLink( $ctrl );
#die "ars_GetListActiveLink( ALL ): $ars_errstr\n" if $ars_errstr;
my @objects = ( 'ARSperl Test-alink1 (copy)' );
$| = 1;
foreach my $obj ( @objects ){
next if $obj !~ / \(copy\)$/;
my $objNew = $obj;
$objNew =~ s/ \(copy\)$/ (renamed)/;
ars_DeleteActiveLink( $ctrl, $objNew );
t/36createfilter.t view on Meta::CPAN
if (defined($ctrl)) {
print "ok [1] (login)\n";
} else {
print "not ok [1] (login $ars_errstr)\n";
exit(0);
}
#my @objects = sort {lc($a) cmp lc($b)} ars_GetListFilter( $ctrl );
#die "ars_GetListFilter( ALL ): $ars_errstr\n" if $ars_errstr;
my @objects = ( 'ARSperl Test-Filter1' );
$| = 1;
foreach my $obj ( @objects ){
next if $obj =~ / \((copy|renamed)\)$/;
my $objNew = "$obj (copy)";
ars_DeleteFilter( $ctrl, $objNew );
copyObject( $ctrl, $obj, $objNew );
t/37setfilter.t view on Meta::CPAN
if (defined($ctrl)) {
print "ok [1] (login)\n";
} else {
print "not ok [1] (login $ars_errstr)\n";
exit(0);
}
#my @objects = sort {lc($a) cmp lc($b)} grep {/\(copy\)/} ars_GetListFilter( $ctrl );
#die "ars_GetListFilter( ALL ): $ars_errstr\n" if $ars_errstr;
my @objects = ( 'ARSperl Test-Filter1 (copy)' );
$| = 1;
foreach my $obj ( @objects ){
next if $obj !~ / \(copy\)$/;
my $objNew = $obj;
$objNew =~ s/ \(copy\)$/ (renamed)/;
ars_DeleteFilter( $ctrl, $objNew );
view release on metacpan - search on metacpan
( run in 2.233 seconds using v1.00-cache-2.02-grep-82fe00e-cpan-585fae043c8 )