ARSperl
view release on metacpan or search on metacpan
}
#else
(void) ARError_add( AR_RETURN_ERROR, AP_ERR_DEPRECATED,
"ars_SetServerPort() is only available in ARS >= 4.x");
#endif
}
OUTPUT:
RETVAL
ARControlStruct *
ars_Login(server, username, password, lang=NULL, authString=NULL, tcpport=0, rpcnumber=0, ...)
char * server
char * username
char * password
char * lang
char * authString
unsigned int tcpport
unsigned int rpcnumber
CODE:
{
int ret = 0, s_ok = 1;
int staticParams = 7;
ARStatusList status;
ARServerNameList serverList;
ARControlStruct *ctrl;
#ifdef PROFILE
struct timeval tv;
#endif
DBG( ("ars_Login(%s, %s, %s, %s, %s, %d, %d)\n",
SAFEPRT(server),
SAFEPRT(username),
SAFEPRT(password),
SAFEPRT(lang),
SAFEPRT(authString),
tcpport,
rpcnumber)
);
RETVAL = NULL;
Zero(&status, 1, ARStatusList);
Zero(&serverList, 1, ARServerNameList);
(void) ARError_reset();
else
perror("gettimeofday");
#endif
ctrl->cacheId = 0;
#if AR_EXPORT_VERSION >= 4
ctrl->sessionId = 0;
#endif
ctrl->operationTime = 0;
strncpy(ctrl->user, username, sizeof(ctrl->user));
ctrl->user[sizeof(ctrl->user)-1] = 0;
strncpy(ctrl->password, password, sizeof(ctrl->password));
ctrl->password[sizeof(ctrl->password)-1] = 0;
#ifndef AR_MAX_LOCALE_SIZE
/* 6.0.1 and 6.3 are AR_EXPORT_VERSION = 8L but 6.3 does not
* contain the language field
*/
ctrl->language[0] = 0;
if ( CVLD(lang) ) {
strncpy(ctrl->language, lang, AR_MAX_LANG_SIZE);
}
#else
ctrl->localeInfo.locale[0] = 0;
void
ars_GetControlStructFields(ctrl)
ARControlStruct * ctrl
PPCODE:
{
(void) ARError_reset();
if(!ctrl) return;
XPUSHs(sv_2mortal(newSViv(ctrl->cacheId)));
XPUSHs(sv_2mortal(newSViv(ctrl->operationTime)));
XPUSHs(sv_2mortal(newSVpv(ctrl->user, 0)));
XPUSHs(sv_2mortal(newSVpv(ctrl->password, 0)));
#ifndef AR_MAX_LOCALE_SIZE
XPUSHs(sv_2mortal(newSVpv(ctrl->language, 0)));
#else
XPUSHs(sv_2mortal(newSVpv(ctrl->localeInfo.locale, 0)));
#endif
XPUSHs(sv_2mortal(newSVpv(ctrl->server, 0)));
XPUSHs(sv_2mortal(newSViv(ctrl->sessionId)));
#if AR_EXPORT_VERSION >= 7
XPUSHs(sv_2mortal(newSVpv(ctrl->authString, 0)));
#endif
}
}
OUTPUT:
RETVAL
#ifdef GETLISTGROUP_OLD_STYLE
HV *
ars_GetListGroup(ctrl, userName=NULL,password=NULL)
ARControlStruct * ctrl
char * userName
char * password
CODE:
{
ARStatusList status;
ARGroupInfoList groupList;
int ret = 0;
unsigned int i = 0, v = 0;
(void) ARError_reset();
Zero(&status, 1,ARStatusList);
Zero(&groupList, 1, ARGroupInfoList);
RETVAL = newHV();
sv_2mortal( (SV*) RETVAL );
ret = ARGetListGroup(ctrl, userName,
#if AR_EXPORT_VERSION >= 6
password,
#endif
&groupList, &status);
#ifdef PROFILE
((ars_ctrl *)ctrl)->queries++;
#endif
if(!ARError( ret, status)) {
AV *gidList = newAV(), *gtypeList = newAV(),
*gnameListList = newAV(), *gnameList;
for(i = 0; i < groupList.numItems; i++) {
FreeARGroupInfoList(&groupList, FALSE);
}
}
OUTPUT:
RETVAL
#else
void
ars_GetListGroup(ctrl, userName=NULL,password=NULL)
ARControlStruct * ctrl
char * userName
char * password
PPCODE:
{
ARStatusList status;
ARGroupInfoList groupList;
int ret = 0;
(void) ARError_reset();
Zero(&status, 1,ARStatusList);
Zero(&groupList, 1, ARGroupInfoList);
ret = ARGetListGroup(ctrl, userName,
#if AR_EXPORT_VERSION >= 6
password,
#endif
&groupList, &status);
#ifdef PROFILE
((ars_ctrl *)ctrl)->queries++;
#endif
if(!ARError( ret, status)) {
unsigned int i;
for(i = 0; i < groupList.numItems; i++) {
unsigned int v;
HV *groupInfo = newHV();
}
}
FreeARGroupInfoList(&groupList, FALSE);
}
#endif
void
ars_GetListRole(ctrl, applicationName, userName=NULL,password=NULL)
ARControlStruct * ctrl
ARNameType applicationName
char * userName
char * password
PPCODE:
{
#if AR_EXPORT_VERSION >= 8L
ARStatusList status;
ARRoleInfoList roleList;
int ret = 0;
(void) ARError_reset();
Zero(&status, 1,ARStatusList);
Zero(&roleList, 1, ARRoleInfoList);
ret = ARGetListRole(ctrl,
applicationName,
userName,
password,
&roleList, &status);
if(!ARError( ret, status)) {
unsigned int i;
for(i = 0; i < roleList.numItems; i++) {
HV *roleInfo = newHV();
hv_store(roleInfo, "roleId", 6, newSViv(roleList.roleList[i].roleId), 0);
hv_store(roleInfo, "roleType", 8, newSViv(roleList.roleList[i].roleType), 0);
hv_store(roleInfo, "roleName", 8, newSVpv(roleList.roleList[i].roleName,0), 0);
ARS/OOsup.pm view on Meta::CPAN
#
# 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));
$self->initCatch();
# what error handlers should be called automatically by the OO layer?
# if a handler is 'undef' then the OO layer will ignore that type of
ARS/OOsup.pm view on Meta::CPAN
if(ref($ctrl) ne "ARControlStructPtr") {
$self->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"ctrl parameter should be an ARControlStructPtr reference. you passed a ".ref($ctrl)." reference."
);
}
$self->{'ctrl'} = $ctrl;
$self->{'.nologoff'} = 1;
} else {
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'};
ARS/OOsup.pm view on Meta::CPAN
}
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);
Makefile.PL view on Meta::CPAN
print "TCP Port [$T]: ";
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);
}
example/AddUsersToGroup.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/AddUsersToGroup.pl,v 1.5 2009/03/31 13:34:32 mbeijen Exp $
#
# NAME
# AddUsersToGroup server user password group user1 [user2] ...
#
# DESCRIPTION
# add given users to specified group
#
# AUTHOR
# jeff murphy
#
# $Log: AddUsersToGroup.pl,v $
# Revision 1.5 2009/03/31 13:34:32 mbeijen
# Verified and updated examples.
example/AddUsersToGroup.pl view on Meta::CPAN
#
# Revision 1.2 1998/09/14 20:48:59 jcmurphy
# changed usage, comments. fixed bug.
#
#
use ARS;
use strict;
use warnings;
die "usage: AddUserToGroup server username password group user1 [user2] ...\n"
if ( $#ARGV < 4 );
my ( $server, $user, $pass, $group, @users ) =
( shift, shift, shift, shift, @ARGV );
#Logging in to the server
( my $ctrl = ars_Login( $server, $user, $pass ) )
|| die "ars_Login: $ars_errstr";
# Retrieve a list of fieds in a hash for the User and Group forms, otherwise we have to use
example/ChangePassword.pl view on Meta::CPAN
#!/usr/bin/perl
#
# NAME
# ChangePassword.pl server username password newpassword
#
# DESCRIPTION
# This script allows a user to change his password. Since user accounts are just
# plain records in a form we use the common getlistentry and setentry calls to
# fetch the user's record and update the password field.
# Note that on some systems permissions are set strangely and depending on
# the type of license you have you might not be able to update your password
# (Think Read Restricted licenses...)
# Also on some systems the User form is renamed to something other than "User".
#
# AUTHOR
# Michiel Beijen, Mansolutions, 2007.
#
use ARS;
use strict;
die "usage: ChangePassword.pl server username password newpassword\n"
unless ( $#ARGV >= 3 );
my ( $server, $user, $password, $newpassword ) = ( shift, shift, shift, shift );
#Logging in to the server
( my $ctrl = ars_Login( $server, $user, $password ) )
|| die "ars_Login: $ars_errstr";
# Creating qualifier to look up the entry ID of the username; Login Name field is 101.
( my $userqualifier = ars_LoadQualifier( $ctrl, "User", "'101' = \"$user\"" ) )
|| die "ars_LoadQualifier(User): $ars_errstr";
# fetch the Entry ID for this user by using GetListEntry with the qualifier we
# just specified, otherwise die.
my @userentry = ars_GetListEntry( $ctrl, "User", $userqualifier, 0, 0 );
die "No such user $user? ($ars_errstr)\n" if ( $#userentry == -1 );
# Change the password for this user by setting field 102 (the password field) with the new value
ars_SetEntry( $ctrl, "User", $userentry[0], 0, 102, $newpassword )
|| die "Error updating password: $ars_errstr";
print "Password changed for user $user on server $server\n";
example/DelUsersFromGroup.pl view on Meta::CPAN
# Revision 1.2 1998/09/14 20:50:08 jcmurphy
# removed some debugging statements
#
# Revision 1.1 1998/09/14 20:49:13 jcmurphy
# Initial revision
#
#
use ARS;
die "usage: DelUserFromGroup server username password group user1 [user2] ...\n" unless ($#ARGV >= 4);
($server, $user, $pass, $group, @users) = (shift, shift, shift, shift, @ARGV);
($c = ars_Login($server, $user, $pass)) ||
die "ars_Login: $ars_errstr";
(%uf = ars_GetFieldTable($c, "User")) ||
die "ars_GetFieldTable(User): $ars_errstr";
(%gf = ars_GetFieldTable($c, "Group")) ||
example/Dump_Setup.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/Dump_Setup.pl,v 1.3 1999/06/14 17:07:39 jcmurphy Exp $
#
# EXAMPLE
# Dump_Setup.pl [username] [password] [path]
#
# DESCRIPTION
# Log onto the server and export all schemas, filters, etc.
#
# NOTES
# This might require special permission for the username you login as
#
# AUTHOR
# joel murphy
#
example/Dump_Users.pl view on Meta::CPAN
#
#
use ARS;
use strict;
my $SCHEMA = "User";
# Parse command line parameters
my ( $server, $username, $password ) = @ARGV;
if ( !defined($password) ) {
print "usage: $0 [server] [username] [password]\n";
exit 1;
}
# Log onto the ars server specified
( my $ctrl = ars_Login( $server, $username, $password ) )
|| die "can't login to the server: $ars_errstr";
# Load the qualifier structure with a dummy qualifier.
( my $qual = ars_LoadQualifier( $ctrl, $SCHEMA, "(1 = 1)" ) )
|| die "error in ars_LoadQualifier: $ars_errstr";
# Retrieve the fieldid's for the "Login name" and "Full name" fields.
# As of ARS4.0, "name" has become "Name", so we'll check for both fields
# and use whatever we find.
example/Dump_Users_OO.pl view on Meta::CPAN
#!/usr/local/bin/perl -w
#
# $Header: /cvsroot/arsperl/ARSperl/example/Dump_Users_OO.pl,v 1.3 2007/03/13 13:20:32 jeffmurphy Exp $
#
# NAME
# Dump_Users_OO.pl [server] [username] [password]
#
# DESCRIPTION
# Example of Object Oriented programming layered on top of ARSperl
#
# AUTHOR
# Jeff Murphy
#
# $Log: Dump_Users_OO.pl,v $
# Revision 1.3 2007/03/13 13:20:32 jeffmurphy
# minor update to example scripts
example/Dump_Users_OO.pl view on Meta::CPAN
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"
my $connection = new ARS (-server => shift,
-username => shift,
-password => shift,
-catch => { ARS::AR_RETURN_ERROR => "main::mycatch" },
-ctrl => undef,
-debug => undef);
print "Opening \"User\" form ..\n";
my ($u) = $connection->openForm(-form => "User");
$u->setSort($LoginNameField, &ARS::AR_SORT_ASCENDING);
example/GetCharMenu.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/GetCharMenu.pl,v 1.8 2003/03/28 05:51:56 jcmurphy Exp $
#
# NAME
# GetCharMenu.pl
#
# USAGE
# GetCharMenu.pl [server] [username] [password] [menuname]
#
# DESCRIPTION
# Retrieve and print information about the named menu.
#
# AUTHOR
# Jeff Murphy
# jcmurphy@acsu.buffalo.edu
#
# $Log: GetCharMenu.pl,v $
# Revision 1.8 2003/03/28 05:51:56 jcmurphy
example/GetCharMenu.pl view on Meta::CPAN
my @s = @_;
if(defined($t)) {
for( ; $t > 0 ; $t--) {
print "\t";
}
print @s;
}
}
($server, $username, $password, $name) = @ARGV;
if(!defined($name)) {
print "Usage: $0 [server] [username] [password] [menuname]\n";
exit 0;
}
$ctrl = ars_Login($server, $username, $password);
print "Calling ars_GetCharMenu($ctrl, $name)..\n";
($finfo = ars_GetCharMenu($ctrl, $name)) ||
die "error in GetCharMenu: $ars_errstr";
# 10005
print "Calling ars_GetCharMenuItems($ctrl, $name)..\n";
my ($menuItems) = ars_GetCharMenuItems($ctrl, $name);
die "$ars_errstr\n" unless defined($menuItems);
print "menuItems=<<$menuItems>> (should be an array ref)\n";
example/GetField.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/GetField.pl,v 1.5 2009/03/31 13:34:32 mbeijen Exp $
#
# EXAMPLE
# GetField.pl [server] [username] [password] [schema] [fieldname]
#
# DESCRIPTION
# Connect to the server and fetch information about the
# named field. Print the information out.
#
# NOTES
# We'll be looking up the field names in the Default Admin View.
#
# AUTHOR
# jeff murphy
example/GetField.pl view on Meta::CPAN
# Initial revision
#
#
#
use ARS;
use strict;
# Parse command line parameters
my ( $server, $username, $password, $schema, $fieldname ) = @ARGV;
if ( !defined($fieldname) ) {
print "usage: $0 [server] [username] [password] [schema] [fieldname]\n";
exit 1;
}
# Log onto the ars server specified
print "Logging in ..\n";
( my $ctrl = ars_Login( $server, $username, $password ) )
|| die "can't login to the server";
# Fetch all of the fieldnames/ids for the specified schema
print "Fetching field table ..\n";
( my %fids = ars_GetFieldTable( $ctrl, $schema ) )
|| die "GetFieldTable: $ars_errstr";
# See if the specified field exists.
example/GetFilter.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/GetFilter.pl,v 1.9 2003/04/02 01:43:35 jcmurphy Exp $
#
# NAME
# GetFilter.pl
#
# USAGE
# GetFilter.pl [server] [username] [password] [filtername]
#
# DESCRIPTION
# Retrieve and print information about the named filter.
#
# AUTHOR
# Jeff Murphy
# jcmurphy@acsu.buffalo.edu
#
# $Log: GetFilter.pl,v $
# Revision 1.9 2003/04/02 01:43:35 jcmurphy
example/GetFilter.pl view on Meta::CPAN
my @s = @_;
if(defined($t)) {
for( ; $t > 0 ; $t--) {
print "\t";
}
print @s;
}
}
($server, $username, $password, $filtername) = @ARGV;
if(!defined($filtername)) {
print "Usage: $0 [server] [username] [password] [filtername]\n";
exit 0;
}
$AR_OPERATION_GET = 1;
$AR_OPERATION_SET = 2;
$AR_OPERATION_CREATE = 4;
$AR_OPERATION_DELETE = 8;
$AR_OPERATION_MERGE = 16;
%ars_opSet = (
$AR_OPERATION_GET, "Display",
$AR_OPERATION_SET, "Modify",
$AR_OPERATION_CREATE, "Create",
$AR_OPERATION_DELETE, "Delete",
$AR_OPERATION_MERGE, "Merge"
);
$ctrl = ars_Login($server, $username, $password);
($finfo = ars_GetFilter($ctrl, $filtername)) ||
die "error in GetFilter: $ars_errstr";
print "\n\nerrstr contains \"$ars_errstr\"\n\n" if ($ars_errstr ne "");
print "** Filter Info:\n";
print "Name : \"".$finfo->{"name"}."\"\n";
print "Order : ".$finfo->{"order"}."\n";
if(defined($finfo->{'schema'})) {
print "Schema : \"".$finfo->{"schema"}."\"\n";
example/GetServerStatistics.pl view on Meta::CPAN
#!/usr/local/bin/perl -w
#
# $Header: /cvsroot/arsperl/ARSperl/example/GetServerStatistics.pl,v 1.2 2003/04/02 01:43:35 jcmurphy Exp $
#
# NAME
# GetServerStatistics.pl
#
# USAGE
# GetServerStatistics.pl [server] [username] [password]
#
# DESCRIPTION
# Retrieve and print statistics on the arserver
#
# AUTHOR
# Jeff Murphy
# jcmurphy@acsu.buffalo.edu
#
# $Log: GetServerStatistics.pl,v $
# Revision 1.2 2003/04/02 01:43:35 jcmurphy
# mem mgmt cleanup
#
# Revision 1.1 1996/11/21 20:13:53 jcmurphy
# Initial revision
#
#
use ARS;
use strict;
my ($server, $username, $password) = @ARGV;
if(!defined($password)) {
print "Usage: $0 [server] [username] [password]\n";
exit 0;
}
my $c = ars_Login($server, $username, $password);
die "login failed: $ars_errstr" unless defined($c);
my @rev_ServerStats;
foreach my $stype (keys %ARServerStats) {
$rev_ServerStats[$ARServerStats{$stype}] = $stype;
}
print "requesting: START_TIME($ARServerStats{'START_TIME'}) CPU($ARServerStats{'CPU'})\n";
my %stats = ars_GetServerStatistics($c,
example/Get_Diary.pl view on Meta::CPAN
# Revision 1.1 1996/11/21 20:13:54 jcmurphy
# Initial revision
#
#
use ARS;
use strict;
# Parse command line parameters
my ( $server, $username, $password, $schema, $qualifier, $diaryfield ) = @ARGV;
if ( !defined($diaryfield) ) {
print "usage: $0 [server] [username] [password] [schema] [qualifier]\n";
print " [diaryfieldname]\n";
exit 1;
}
# Log onto the ars server specified
print "schema=$schema
qualifier=$qualifier
diaryfield=$diaryfield\n";
( my $ctrl = ars_Login( $server, $username, $password ) )
|| die "can't login to the server";
# Load the qualifier structure with a dummy qualifier.
( my $qual = ars_LoadQualifier( $ctrl, $schema, $qualifier ) )
|| die "error in ars_LoadQualifier:\n$ars_errstr";
# Retrieve all of the entry-id's for the qualification.
my %entries = ars_GetListEntry( $ctrl, $schema, $qual, 0, 0 );
example/List_Entries.pl view on Meta::CPAN
# Revision 1.1 1996/11/21 20:13:54 jcmurphy
# Initial revision
#
#
use ARS;
use strict;
# Parse command line parameters
my ( $server, $username, $password, $schema ) = @ARGV;
if ( !defined($schema) ) {
print "usage: $0 [server] [username] [password] [schema]\n";
exit 1;
}
# Log onto the ars server specified
( my $ctrl = ars_Login( $server, $username, $password ) )
|| die "can't login to the server";
# Load the qualifier structure with a dummy qualifier.
( my $qual = ars_LoadQualifier( $ctrl, $schema, "(1 = 1)" ) )
|| die "error in ars_LoadQualifier";
# Retrieve all of the entry-id's for the schema.
my %entries = ars_GetListEntry( $ctrl, $schema, $qual, 0, 0 );
example/PrintQual.pl view on Meta::CPAN
#
use ARS;
require 'ars_QualDecode.pl';
$debug = 0;
# Parse command line parameters
($server, $username, $password, $schema, $qual) = @ARGV;
if(!defined($password)) {
print "usage: $0 [server] [username] [password] [schema] [qualification]\n";
exit 1;
}
# Log onto the ars server specified
($ctrl = ars_Login($server, $username, $password)) ||
die "can't login to the server";
# Load the qualifier structure
($q = ars_LoadQualifier($ctrl,$schema, $qual)) ||
die "error in ars_LoadQualifier:\n$ars_errstr\n";
# Decode the encoded structure
($dq = ars_perl_qualifier($ctrl, $q)) ||
example/Show_ALink.pl view on Meta::CPAN
use ARS;
$debug = 0;
require 'ars_QualDecode.pl';
@MessageTypes = ( "Note", "Warn", "Error" );
# Parse command line parameters
($server, $username, $password, $alink_name) = @ARGV;
if(!defined($alink_name)) {
print "usage: $0 [server] [username] [password] [alink name]\n";
exit 1;
}
$level = 0;
# SUBROUTINE
# printl
#
# DESCRIPTION
# prints the string after printing X number of tabs
example/Show_ALink.pl view on Meta::CPAN
}
$act_num++;
}
print "\n";
} else {
print "No actions to process!\n";
}
}
# Log onto the ars server specified
($ctrl = ars_Login($server, $username, $password)) ||
die "can't login to the server";
# Retrieve info about active link.
($a = ars_GetActiveLink($ctrl, $alink_name)) ||
die "can't fetch info about that active link";
print "Active Link Attributes:\n\n";
example/Show_Menu.pl view on Meta::CPAN
# $Log: Show_Menu.pl,v $
# Revision 1.1 1996/11/21 20:13:56 jcmurphy
# Initial revision
#
#
use ARS;
# Parse command line parameters
($server, $username, $password, $menu_name) = @ARGV;
if(!defined($menu_name)) {
print "usage: $0 [server] [username] [password] [menu name]\n";
exit 1;
}
# 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 {
example/WhoUsesIt.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/WhoUsesIt.pl,v 1.4 2005/04/06 19:13:57 jeffmurphy Exp $
#
# NAME
# WhoUsesIt.pl
#
# USAGE
# WhoUsesIt.pl [-v] [-s schema] [-a | -f | -m | -e | -p | -M [name]]
# [username] [password]
#
# DESCRIPTION
# Search all schemas and determine who uses the specified active link,
# filter, menu or escalation.
#
# -a list all schemas that use this active link
# -f .. this filter
# -m .. this menu
# -e .. this escalation
# -M list all menus that use this file
example/WhoUsesIt.pl view on Meta::CPAN
use ARS;
require 'getopts.pl'; # a standard perl module
$pname = $0;
$pname =~ s/.*\///g;
Getopts('s:a:f:m:e:p:M:Dhv');
$debug = $opt_D;
($server, $username, $password) = @ARGV;
$SCHEMA = defined($opt_s)?$opt_s:".*";
if($debug) {
print STDERR "a: ".(defined($opt_a)?"$opt_a":"undef")."\n";
print STDERR "f: ".(defined($opt_f)?"$opt_f":"undef")."\n";
print STDERR "m: ".(defined($opt_m)?"$opt_m":"undef")."\n";
print STDERR "e: ".(defined($opt_e)?"$opt_e":"undef")."\n";
print STDERR "p: ".(defined($opt_p)?"$opt_p":"undef")."\n";
print STDERR "s: ".(defined($opt_p)?"$opt_s":"undef")."\n";
example/WhoUsesIt.pl view on Meta::CPAN
if($username eq "") {
print "Username: ";
chomp($username = <STDIN>);
if($username eq "") {
print "Goodbye.\n";
exit 0;
}
}
if($password eq "") {
print "Password: ";
system 'stty', '-echo';
chomp($password = <STDIN>);
system 'stty', 'echo';
print "\n";
}
($ctrl = ars_Login($server, $username, $password)) ||
die "couldn't allocate control structure";
(@schemas = ars_GetListSchema($ctrl)) ||
die "can't read schema list: $ars_errstr";
if($opt_M) {
# fine any menu that uses this file as it's
# source of menu items.
print "Menus that use the file \"$opt_M\"... (this may take a minute or so to do)\n";
example/WhoUsesIt.pl view on Meta::CPAN
# 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_CopyActiveLink.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/ars_CopyActiveLink.pl,v 1.2 1998/09/14 17:38:47 jcmurphy Exp $
#
# NAME
# ars_CopyActiveLink.pl [server] [username] [password] [active link]
#
# DESCRIPTION
# copies the given active link to "Copy of ..."
#
# AUTHOR
# Jeff murphy
#
# $Log: ars_CopyActiveLink.pl,v $
# Revision 1.2 1998/09/14 17:38:47 jcmurphy
# changed #!perl path
example/ars_DateToJulianDate.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/ars_DateToJulianDate.pl,v 1.1 2009/03/31 13:29:50 mbeijen Exp $
#
# NAME
# ars_DateToJulianDate.pl
#
# USAGE
# ars_DateToJulianDate.pl [server] [username] [password] [year] [ month] [date]
#
# DESCRIPTION
# Converts a year-month-date value to a JulianDate.
#
# AUTHOR
# Michiel Beijen
#
# $Log: ars_DateToJulianDate.pl,v $
# Revision 1.1 2009/03/31 13:29:50 mbeijen
# added new examples: ChangePassword.pl, ars_DateToJulianDate.pl, getCharSets.pl
#
#
use ARS;
use strict;
die "usage: $0 server username password year month day\n"
unless ( $#ARGV >= 5 );
my ( $server, $user, $password, $year, $month, $day, ) =
( shift, shift, shift, shift, shift, shift, );
#Logging in to the server
( my $ctrl = ars_Login( $server, $user, $password ) )
|| die "ars_Login: $ars_errstr";
print "Converting year $year month $month day $day to Julian...\n";
( my $juliandate = ars_DateToJulianDate( $ctrl, $year, $month, $day ) )
|| die "ERR: $ars_errstr\n";
ars_Logoff($ctrl);
print "The JulianDate value is $juliandate\n";
example/ars_ExecuteProcess.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/ars_ExecuteProcess.pl,v 1.3 2009/03/31 13:34:32 mbeijen Exp $
#
# NAME
# ars_ExecuteProcess.pl
#
# USAGE
# ars_ExecuteProcess.pl [server] [username] [password] ["process"]
# if you need to use a specified TCP port, export the ARTCPPORT environment variable
# with the TCP Port number
#
# EXAMPLE
# ars_ExecuteProcess.pl arserver user password "ls -l /" (if the server is on Unix)
# ars_ExecuteProcess.pl arserver user password " cmd /c dir" (if the server is on Win32)
# ars_ExecuteProcess.pl arserver user password Application-Generate-GUID
#
# DESCRIPTION
# Execute given command on remote arserver. Requires admin account to work.
#
# AUTHOR
# Jeff Murphy
#
# $Log: ars_ExecuteProcess.pl,v $
# Revision 1.3 2009/03/31 13:34:32 mbeijen
# Verified and updated examples.
example/ars_GetControlStructFields.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/ars_GetControlStructFields.pl,v 1.1 1997/10/29 21:56:43 jcmurphy Exp $
#
# NAME
# ars_GetControlStructFields.pl
#
# USAGE
# ars_GetControlStructFields.pl [server] [username] [password]
#
# DESCRIPTION
# Demo of said function. See manual for details.
#
# AUTHOR
# Jeff Murphy
#
# $Log: ars_GetControlStructFields.pl,v $
# Revision 1.1 1997/10/29 21:56:43 jcmurphy
# Initial revision
#
#
#
#
use ARS;
($c = ars_Login(shift, shift, shift))
|| die "login: $ars_errstr";
($cacheId, $operationTime, $user, $password, $lang,
$server) = ars_GetControlStructFields($c);
print "Control Struct Fields:
cacheId = $cacheId
operationTime = $operationTime
username = $user
password = $password
language = $lang
server = $server
";
ars_Logoff($c);
example/ars_GetListContainer.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/ars_GetListContainer.pl,v 1.1 2000/02/10 19:31:09 jcmurphy Exp $
#
# NAME
# ars_GetListContainer.pl
#
# USAGE
# ars_GetListContainer.pl [server] [username] [password]
#
# DESCRIPTION
# demonstrate use of ars_GetListContainer call.
#
# AUTHOR
# jeff murphy
#
use ARS 1.67;
$c = new ARS(-server => shift,
-username => shift,
-password => shift);
@l = ars_GetListContainer($c->ctrl(), 0,
&ARS::AR_HIDDEN_INCREMENT,
&ARS::ARCON_GUIDE,
&ARS::ARCON_APP);
exit 0;
example/ars_GetListEntry.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/ars_GetListEntry.pl,v 1.3 2009/04/14 12:28:07 mbeijen Exp $
#
# NAME
# ars_GetListEntry.pl [server] [username] [password]
#
# DESCRIPTION
# Demonstration of GetListEntry().
#
# AUTHOR
# Jeff Murphy
# jcmurphy@buffalo.edu
#
# $Log: ars_GetListEntry.pl,v $
# Revision 1.3 2009/04/14 12:28:07 mbeijen
example/ars_GetListEntry.pl view on Meta::CPAN
# *** empty log message ***
#
# Revision 1.1 1998/03/25 22:52:51 jcmurphy
# Initial revision
#
#
#
use ARS;
use strict;
die "usage: $0 server username password \n"
unless ( $#ARGV >= 2 );
my ( $server, $user, $password ) = ( shift, shift, shift );
#Logging in to the server
( my $ctrl = ars_Login( $server, $user, $password ) )
|| die "ars_Login: $ars_errstr";
# Define form and fields - these may have different names on your server
my $schema = "User";
my $login_name = "Login Name";
my $lic_type = "License Type";
my $full_name = "Full Name";
( my %fids = ars_GetFieldTable( $ctrl, $schema ) )
|| die "ars_GetFieldTable: $ars_errstr";
example/ars_GetListGroup.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/ars_GetListGroup.pl,v 1.2 2008/05/15 18:30:07 tstapff Exp $
#
# NAME
# ars_GetListGroup.pl
#
# USAGE
# ars_GetListGroup.pl [server] [username] [password]
#
# DESCRIPTION
# Demo of said function. See web page for details or ARS Programmers
# Manual.
#
# AUTHOR
# Jeff Murphy
#
# $Log: ars_GetListGroup.pl,v $
# Revision 1.2 2008/05/15 18:30:07 tstapff
example/ars_GetListSQL.pl view on Meta::CPAN
#!/usr/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/ars_GetListSQL.pl,v 1.3 2009/03/31 13:34:32 mbeijen Exp $
#
# NAME
# ars_GetListSQL.pl
#
# USAGE
# ars_GetListSQL.pl [server] [username] [password]
#
# DESCRIPTIONS
# Log into the ARServer with the given username and password and
# request that the SQL command (hardcoded below) be executed. Dump
# output to stdout.
#
# NOTES
# Requires Administrator privs to work.
#
# AUTHOR
# Jeff Murphy
#
# $Log: ars_GetListSQL.pl,v $
example/ars_GetListSQL.pl view on Meta::CPAN
# fixed bug in GetListSQL
#
# Revision 1.1 1997/07/23 18:21:29 jcmurphy
# Initial revision
#
#
use ARS;
use strict;
die "usage: $0 server username password \n"
unless ( $#ARGV >= 2 );
my ( $server, $user, $password ) = ( shift, shift, shift );
#Logging in to the server
( my $ctrl = ars_Login( $server, $user, $password ) )
|| die "ars_Login: $ars_errstr";
# The arschema table contains information about what schemas are
# in the system. We'll grab some of the columns and dump them.
my $sql = "select name, schemaid, nextid from arschema";
print "Calling GetListSQL with:\n\t$sql\n\n";
( my $sql_hash = ars_GetListSQL( $ctrl, $sql ) )
example/ars_GetListUser.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/ars_GetListUser.pl,v 1.3 2009/03/31 13:34:32 mbeijen Exp $
#
# NAME
# ars_GetListUser.pl
#
# USAGE
# ars_GetListUser.pl [server] [username] [password]
#
# DESCRIPTION
# Demo of said function. Fetches and prints listing of
# all currently connected users and their license info.
#
# NOTES
# email addr and notify mech are (as far as we can tell) part of the
# return values from the API, but are never filled in. this is not a
# bug in arsperl.
#
example/ars_GetListUser.pl view on Meta::CPAN
#
# Revision 1.1 1997/07/23 18:21:29 jcmurphy
# Initial revision
#
#
#
use ARS;
use strict;
die "usage: $0 server username password \n"
unless ( $#ARGV >= 2 );
my ( $server, $user, $password ) = ( shift, shift, shift );
#Logging in to the server
( my $ctrl = ars_Login( $server, $user, $password ) )
|| die "ars_Login: $ars_errstr";
my @noteMech = ( "NONE", "NOTIFIER", "EMAIL", "?" );
my @licType = ( "NONE", "FIXED", "FLOATING", "FIXED2" );
my @licTag = ( "", "WRITE", "FULL_TEXT", "RESERVED1" );
print "Calling GetListUser and asking for all connected users...\n";
# 0 = current user's info
# 1 = all users' info
example/ars_GetServerInfo.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/ars_GetServerInfo.pl,v 1.3 2009/03/31 13:34:32 mbeijen Exp $
#
# NAME
# ars_GetServerInfo.pl
#
# USAGE
# ars_GetServerInfo.pl [server] [username] [password]
#
# DESCRIPTION
# Retrieve and print server configuration information.
#
# AUTHOR
# Jeff Murphy
#
# $Log: ars_GetServerInfo.pl,v $
# Revision 1.3 2009/03/31 13:34:32 mbeijen
# Verified and updated examples.
example/ars_GetServerInfo.pl view on Meta::CPAN
#
# Revision 1.1 1997/07/23 18:21:29 jcmurphy
# Initial revision
#
#
#
use ARS;
use strict;
die "usage: $0 server username password \n"
unless ( $#ARGV >= 2 );
my ( $server, $user, $password ) = ( shift, shift, shift );
#Logging in to the server
( my $ctrl = ars_Login( $server, $user, $password ) )
|| die "ars_Login: $ars_errstr";
print "Calling GetServerInfo ..\n";
( my %h = ars_GetServerInfo($ctrl) ) || die "ERR: $ars_errstr\n";
for my $it ( sort keys %h ) {
printf( "%25s %s\n", $it, $h{$it} );
}
example/ars_MergeEntry.pl view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Header: /cvsroot/arsperl/ARSperl/example/ars_MergeEntry.pl,v 1.2 2007/07/20 19:57:59 jeffmurphy Exp $
#
# NAME
# ars_MergeEntry.pl [server] [user] [password] [schema] [diaryfieldname]
# [entryid]
#
# DESCRIPTION
# open the named schema and retrieve the contents of the diary field
# for the specified entryid. if the diary field contains entries,
# change the first entry and merge it back into the record.
#
# AUTHOR
# jeff murphy
#
example/ars_MergeEntry.pl view on Meta::CPAN
# Initial revision
#
#
#
use ARS;
($S, $U, $P, $SC, $DF, $EID) = (shift, shift, shift, shift, shift, shift);
if($EID eq "") {
print "Usage: $0 [server] [user] [password] [schema] [diaryfieldname]
[entryid]\n";
exit 0;
}
($c = ars_Login($S, $U, $P)) ||
die "ars_Login: $ars_errstr";
($fid = ars_GetFieldByName($c, $SC, $DF)) ||
die "ars_GetFieldByName: $ars_errstr";
( run in 1.017 second using v1.01-cache-2.11-cpan-49f99fa48dc )