line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
################################################### |
2
|
|
|
|
|
|
|
## ARSTools.pm |
3
|
|
|
|
|
|
|
## Andrew N. Hicox |
4
|
|
|
|
|
|
|
## |
5
|
|
|
|
|
|
|
## A perl wrapper class for ARSPerl |
6
|
|
|
|
|
|
|
## a nice interface for remedy functions. |
7
|
|
|
|
|
|
|
################################################### |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
## global stuff ################################### |
11
|
|
|
|
|
|
|
package Remedy::ARSTools; |
12
|
1
|
|
|
1
|
|
16368
|
use 5.6.0; |
|
1
|
|
|
|
|
4
|
|
13
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
14
|
|
|
|
|
|
|
require Exporter; |
15
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
901
|
use AutoLoader qw(AUTOLOAD); |
|
1
|
|
|
|
|
1451
|
|
|
1
|
|
|
|
|
6
|
|
17
|
1
|
|
|
1
|
|
1540
|
use ARS; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
use Date::Parse; |
19
|
|
|
|
|
|
|
use Time::Interval; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
#class global vars |
22
|
|
|
|
|
|
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $errstr %currency_codes); |
23
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
24
|
|
|
|
|
|
|
@EXPORT = qw(&ParseDBDiary &EncodeDBDiary); |
25
|
|
|
|
|
|
|
@EXPORT_OK = qw($VERSION $errstr); |
26
|
|
|
|
|
|
|
$VERSION = 1.21; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
## this is a global lookup table for currencies |
29
|
|
|
|
|
|
|
our %currency_codes = ( |
30
|
|
|
|
|
|
|
'ARS' => { 'name' => "Argentina Peso", 'ascii_prefix_sequence' => ['36'] }, |
31
|
|
|
|
|
|
|
'AUD' => { 'name' => "Australia Dollar", 'ascii_prefix_sequence' => ['36'] }, |
32
|
|
|
|
|
|
|
'BSD' => { 'name' => "Bahamas Dollar", 'ascii_prefix_sequence' => ['36'] }, |
33
|
|
|
|
|
|
|
'BBD' => { 'name' => "Barbados Dollar", 'ascii_prefix_sequence' => ['36'] }, |
34
|
|
|
|
|
|
|
'BMD' => { 'name' => "Bermuda Dollar", 'ascii_prefix_sequence' => ['36'] }, |
35
|
|
|
|
|
|
|
'BND' => { 'name' => "Brunei Darussalam Dollar", 'ascii_prefix_sequence' => ['36'] }, |
36
|
|
|
|
|
|
|
'CAD' => { 'name' => "Canada Dollar", 'ascii_prefix_sequence' => ['36'] }, |
37
|
|
|
|
|
|
|
'KYD' => { 'name' => "Cayman Islands Dollar", 'ascii_prefix_sequence' => ['36'] }, |
38
|
|
|
|
|
|
|
'CLP' => { 'name' => "Chile Peso", 'ascii_prefix_sequence' => ['36'] }, |
39
|
|
|
|
|
|
|
'COP' => { 'name' => "Colombia Peso", 'ascii_prefix_sequence' => ['36'] }, |
40
|
|
|
|
|
|
|
'XCD' => { 'name' => "East Caribbean Dollar", 'ascii_prefix_sequence' => ['36'] }, |
41
|
|
|
|
|
|
|
'SVC' => { 'name' => "El Salvador Colon", 'ascii_prefix_sequence' => ['36'] }, |
42
|
|
|
|
|
|
|
'FJD' => { 'name' => "Fiji Dollar", 'ascii_prefix_sequence' => ['36'] }, |
43
|
|
|
|
|
|
|
'GYD' => { 'name' => "Guyana Dollar", 'ascii_prefix_sequence' => ['36'] }, |
44
|
|
|
|
|
|
|
'HKD' => { 'name' => "Hong Kong Dollar", 'ascii_prefix_sequence' => ['36'] }, |
45
|
|
|
|
|
|
|
'LRD' => { 'name' => "Liberia Dollar", 'ascii_prefix_sequence' => ['36'] }, |
46
|
|
|
|
|
|
|
'MXN' => { 'name' => "Mexico Peso", 'ascii_prefix_sequence' => ['36'] }, |
47
|
|
|
|
|
|
|
'NAD' => { 'name' => "Namibia Dollar", 'ascii_prefix_sequence' => ['36'] }, |
48
|
|
|
|
|
|
|
'NZD' => { 'name' => "New Zealand Dollar", 'ascii_prefix_sequence' => ['36'] }, |
49
|
|
|
|
|
|
|
'SGD' => { 'name' => "Singapore Dollar", 'ascii_prefix_sequence' => ['36'] }, |
50
|
|
|
|
|
|
|
'SBD' => { 'name' => "Solomon Islands Dollar", 'ascii_prefix_sequence' => ['36'] }, |
51
|
|
|
|
|
|
|
'SRD' => { 'name' => "Suriname Dollar", 'ascii_prefix_sequence' => ['36'] }, |
52
|
|
|
|
|
|
|
'TVD' => { 'name' => "Tuvalu Dollar", 'ascii_prefix_sequence' => ['36'] }, |
53
|
|
|
|
|
|
|
'USD' => { 'name' => "United States Dollar", 'ascii_prefix_sequence' => ['36'], 'match_preference' => 1 }, |
54
|
|
|
|
|
|
|
'HNL' => { 'name' => "Honduras Lempira", 'ascii_prefix_sequence' => ['76'] }, |
55
|
|
|
|
|
|
|
'BWP' => { 'name' => "Botswana Pula", 'ascii_prefix_sequence' => ['80'] }, |
56
|
|
|
|
|
|
|
'GTQ' => { 'name' => "Guatemala Quetzal", 'ascii_prefix_sequence' => ['81'] }, |
57
|
|
|
|
|
|
|
'ZAR' => { 'name' => "South Africa Rand", 'ascii_prefix_sequence' => ['82'] }, |
58
|
|
|
|
|
|
|
'SOS' => { 'name' => "Somalia Shilling", 'ascii_prefix_sequence' => ['83'] }, |
59
|
|
|
|
|
|
|
'GHC' => { 'name' => "Ghana Cedis", 'ascii_prefix_sequence' => ['162'] }, |
60
|
|
|
|
|
|
|
'EGP' => { 'name' => "Egypt Pound", 'ascii_prefix_sequence' => ['163'] }, |
61
|
|
|
|
|
|
|
'FKP' => { 'name' => "Falkland Islands (Malvinas) Pound", 'ascii_prefix_sequence' => ['163'] }, |
62
|
|
|
|
|
|
|
'GIP' => { 'name' => "Gibraltar Pound", 'ascii_prefix_sequence' => ['163']}, |
63
|
|
|
|
|
|
|
'GGP' => { 'name' => "Guernsey Pound", 'ascii_prefix_sequence' => ['163'] }, |
64
|
|
|
|
|
|
|
'IMP' => { 'name' => "Isle of Man Pound", 'ascii_prefix_sequence' => ['163'] }, |
65
|
|
|
|
|
|
|
'JEP' => { 'name' => "Jersey Pound", 'ascii_prefix_sequence' => ['163'] }, |
66
|
|
|
|
|
|
|
'LBP' => { 'name' => "Lebanon Pound", 'ascii_prefix_sequence' => ['163'] }, |
67
|
|
|
|
|
|
|
'SHP' => { 'name' => "Saint Helena Pound", 'ascii_prefix_sequence' => ['163'] }, |
68
|
|
|
|
|
|
|
'SYP' => { 'name' => "Syria Pound", 'ascii_prefix_sequence' => ['163'] }, |
69
|
|
|
|
|
|
|
'GBP' => { 'name' => "United Kingdom Pound", 'ascii_prefix_sequence' => ['163'], 'match_preference' => 1 }, |
70
|
|
|
|
|
|
|
'CNY' => { 'name' => "China Yuan Renminbi", 'ascii_prefix_sequence' => ['165'] }, |
71
|
|
|
|
|
|
|
'JPY' => { 'name' => "Japan Yen", 'ascii_prefix_sequence' => ['165'], 'match_preference' => 1 }, |
72
|
|
|
|
|
|
|
'AWG' => { 'name' => "Aruba Guilder", 'ascii_prefix_sequence' => ['402'] }, |
73
|
|
|
|
|
|
|
'ANG' => { 'name' => "Netherlands Antilles Guilder", 'ascii_prefix_sequence' => ['402'], 'match_preference' => 1 }, |
74
|
|
|
|
|
|
|
'AFN' => { 'name' => "Afghanistan Afghani", 'ascii_prefix_sequence' => ['1547'] }, |
75
|
|
|
|
|
|
|
'THB' => { 'name' => "Thailand Baht", 'ascii_prefix_sequence' => ['3647'] }, |
76
|
|
|
|
|
|
|
'KHR' => { 'name' => "Cambodia Riel", 'ascii_prefix_sequence' => ['6107'] }, |
77
|
|
|
|
|
|
|
'CRC' => { 'name' => "Costa Rica Colon", 'ascii_prefix_sequence' => ['8353'] }, |
78
|
|
|
|
|
|
|
'TRL' => { 'name' => "Turkey Lira", 'ascii_prefix_sequence' => ['8356'] }, |
79
|
|
|
|
|
|
|
'NGN' => { 'name' => "Nigeria Naira", 'ascii_prefix_sequence' => ['8358'] }, |
80
|
|
|
|
|
|
|
'MUR' => { 'name' => "Mauritius Rupee", 'ascii_prefix_sequence' => ['8360'] }, |
81
|
|
|
|
|
|
|
'NPR' => { 'name' => "Nepal Rupee", 'ascii_prefix_sequence' => ['8360'], 'match_preference' => 1 }, |
82
|
|
|
|
|
|
|
'PKR' => { 'name' => "Pakistan Rupee", 'ascii_prefix_sequence' => ['8360'] }, |
83
|
|
|
|
|
|
|
'SCR' => { 'name' => "Seychelles Rupee", 'ascii_prefix_sequence' => ['8360'] }, |
84
|
|
|
|
|
|
|
'LKR' => { 'name' => "Sri Lanka Rupee", 'ascii_prefix_sequence' => ['8360'] }, |
85
|
|
|
|
|
|
|
'KPW' => { 'name' => "Korea (North) Won", 'ascii_prefix_sequence' => ['8361'] }, |
86
|
|
|
|
|
|
|
'KRW' => { 'name' => "Korea (South) Won", 'ascii_prefix_sequence' => ['8361'] , 'match_preference' => 1 }, |
87
|
|
|
|
|
|
|
'ILS' => { 'name' => "Israel Shekel", 'ascii_prefix_sequence' => ['8362'] }, |
88
|
|
|
|
|
|
|
'VND' => { 'name' => "Viet Nam Dong", 'ascii_prefix_sequence' => ['8363'] }, |
89
|
|
|
|
|
|
|
'EUR' => { 'name' => "Euro Member Countries", 'ascii_prefix_sequence' => ['8364'] }, |
90
|
|
|
|
|
|
|
'LAK' => { 'name' => "Laos Kip", 'ascii_prefix_sequence' => ['8365'] }, |
91
|
|
|
|
|
|
|
'MNT' => { 'name' => "Mongolia Tughrik", 'ascii_prefix_sequence' => ['8366'] }, |
92
|
|
|
|
|
|
|
'CUP' => { 'name' => "Cuba Peso", 'ascii_prefix_sequence' => ['8369'] }, |
93
|
|
|
|
|
|
|
'PHP' => { 'name' => "Philippines Peso", 'ascii_prefix_sequence' => ['8369'], 'match_preference' => 1 }, |
94
|
|
|
|
|
|
|
'UAH' => { 'name' => "Ukraine Hryvna", 'ascii_prefix_sequence' => ['8372'] }, |
95
|
|
|
|
|
|
|
'IRR' => { 'name' => "Iran Rial", 'ascii_prefix_sequence' => ['65020'] }, |
96
|
|
|
|
|
|
|
'OMR' => { 'name' => "Oman Rial", 'ascii_prefix_sequence' => ['65020'] }, |
97
|
|
|
|
|
|
|
'QAR' => { 'name' => "Qatar Riyal", 'ascii_prefix_sequence' => ['65020'] }, |
98
|
|
|
|
|
|
|
'SAR' => { 'name' => "Saudi Arabia Riyal", 'ascii_prefix_sequence' => ['65020'], 'match_preference' => 1 }, |
99
|
|
|
|
|
|
|
'YER' => { 'name' => "Yemen Rial", 'ascii_prefix_sequence' => ['65020'] }, |
100
|
|
|
|
|
|
|
'RSD' => { 'name' => "Serbia Dinar", 'ascii_prefix_sequence' => ['1044', '1080', '1085', '46'] }, |
101
|
|
|
|
|
|
|
'HRK' => { 'name' => "Croatia Kuna", 'ascii_prefix_sequence' => ['107', '110'] }, |
102
|
|
|
|
|
|
|
'DKK' => { 'name' => "Denmark Krone", 'ascii_prefix_sequence' => ['107', '114'], 'match_preference' => 1 }, |
103
|
|
|
|
|
|
|
'EEK' => { 'name' => "Estonia Kroon", 'ascii_prefix_sequence' => ['107', '114'] }, |
104
|
|
|
|
|
|
|
'ISK' => { 'name' => "Iceland Krona", 'ascii_prefix_sequence' => ['107', '114'] }, |
105
|
|
|
|
|
|
|
'NOK' => { 'name' => "Norway Krone", 'ascii_prefix_sequence' => ['107', '114'] }, |
106
|
|
|
|
|
|
|
'SEK' => { 'name' => "Sweden Krona", 'ascii_prefix_sequence' => ['107', '114'] }, |
107
|
|
|
|
|
|
|
'MKD' => { 'name' => "Macedonia Denar", 'ascii_prefix_sequence' => ['1076', '1077', '1085'] }, |
108
|
|
|
|
|
|
|
'RON' => { 'name' => "Romania New Leu", 'ascii_prefix_sequence' => ['108', '101', '105'] }, |
109
|
|
|
|
|
|
|
'BGN' => { 'name' => "Bulgaria Lev", 'ascii_prefix_sequence' => ['1083', '1074'] }, |
110
|
|
|
|
|
|
|
'KZT' => { 'name' => "Kazakhstan Tenge", 'ascii_prefix_sequence' => ['1083', '1074'], 'match_preference' => 1 }, |
111
|
|
|
|
|
|
|
'KGS' => { 'name' => "Kyrgyzstan Som", 'ascii_prefix_sequence' => ['1083', '1074'] }, |
112
|
|
|
|
|
|
|
'UZS' => { 'name' => "Uzbekistan Som", 'ascii_prefix_sequence' => ['1083', '1074'] }, |
113
|
|
|
|
|
|
|
'AZN' => { 'name' => "Azerbaijan New Manat", 'ascii_prefix_sequence' => ['1084', '1072', '1085'] }, |
114
|
|
|
|
|
|
|
'RUB' => { 'name' => "Russia Ruble", 'ascii_prefix_sequence' => ['1088', '1091', '1073'] }, |
115
|
|
|
|
|
|
|
'BYR' => { 'name' => "Belarus Ruble", 'ascii_prefix_sequence' => ['112', '46'] }, |
116
|
|
|
|
|
|
|
'PLN' => { 'name' => "Poland Zloty", 'ascii_prefix_sequence' => ['122', '322'] }, |
117
|
|
|
|
|
|
|
'UYU' => { 'name' => "Uruguay Peso", 'ascii_prefix_sequence' => ['36', '85'] }, |
118
|
|
|
|
|
|
|
'BOB' => { 'name' => "Bolivia Boliviano", 'ascii_prefix_sequence' => ['36', '98'] }, |
119
|
|
|
|
|
|
|
'VEF' => { 'name' => "Venezuela Bolivar", 'ascii_prefix_sequence' => ['66', '115'] }, |
120
|
|
|
|
|
|
|
'PAB' => { 'name' => "Panama Balboa", 'ascii_prefix_sequence' => ['66', '47', '46'] }, |
121
|
|
|
|
|
|
|
'BZD' => { 'name' => "Belize Dollar", 'ascii_prefix_sequence' => ['66', '90', '36'] }, |
122
|
|
|
|
|
|
|
'NIO' => { 'name' => "Nicaragua Cordoba", 'ascii_prefix_sequence' => ['67', '36'] }, |
123
|
|
|
|
|
|
|
'CHF' => { 'name' => "Switzerland Franc", 'ascii_prefix_sequence' => ['67', '72', '70'] }, |
124
|
|
|
|
|
|
|
'HUF' => { 'name' => "Hungary Forint", 'ascii_prefix_sequence' => ['70', '116'] }, |
125
|
|
|
|
|
|
|
'PYG' => { 'name' => "Paraguay Guarani", 'ascii_prefix_sequence' => ['71', '115'] }, |
126
|
|
|
|
|
|
|
'JMD' => { 'name' => "Jamaica Dollar", 'ascii_prefix_sequence' => ['74', '36'] }, |
127
|
|
|
|
|
|
|
'CZK' => { 'name' => "Czech Republic Koruna", 'ascii_prefix_sequence' => ['75', '269'] }, |
128
|
|
|
|
|
|
|
'BAM' => { 'name' => "Bosnia and Herzegovina Convertible Marka", 'ascii_prefix_sequence' => ['75', '77'] }, |
129
|
|
|
|
|
|
|
'ALL' => { 'name' => "Albania Lek", 'ascii_prefix_sequence' => ['76', '101', '107'] }, |
130
|
|
|
|
|
|
|
'LVL' => { 'name' => "Latvia Lat", 'ascii_prefix_sequence' => ['76', '115'] }, |
131
|
|
|
|
|
|
|
'LTL' => { 'name' => "Lithuania Litas", 'ascii_prefix_sequence' => ['76', '116'] }, |
132
|
|
|
|
|
|
|
'MZN' => { 'name' => "Mozambique Metical", 'ascii_prefix_sequence' => ['77', '84'] }, |
133
|
|
|
|
|
|
|
'TWD' => { 'name' => "Taiwan New Dollar", 'ascii_prefix_sequence' => ['78', '84', '36'] }, |
134
|
|
|
|
|
|
|
'IDR' => { 'name' => "Indonesia Rupiah", 'ascii_prefix_sequence' => ['82', '112'] }, |
135
|
|
|
|
|
|
|
'BRL' => { 'name' => "Brazil Real", 'ascii_prefix_sequence' => ['82', '36'] }, |
136
|
|
|
|
|
|
|
'DOP' => { 'name' => "Dominican Republic Peso", 'ascii_prefix_sequence' => ['82', '68', '36'] }, |
137
|
|
|
|
|
|
|
'MYR' => { 'name' => "Malaysia Ringgit", 'ascii_prefix_sequence' => ['82', '77'] }, |
138
|
|
|
|
|
|
|
'PEN' => { 'name' => "Peru Nuevo Sol", 'ascii_prefix_sequence' => ['83', '47', '46'] }, |
139
|
|
|
|
|
|
|
'TTD' => { 'name' => "Trinidad and Tobago Dollar", 'ascii_prefix_sequence' => ['84', '84', '36'] }, |
140
|
|
|
|
|
|
|
'ZWD' => { 'name' => "Zimbabwe Dollar", 'ascii_prefix_sequence' => ['90', '36'] } |
141
|
|
|
|
|
|
|
); |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
## new ############################################ |
145
|
|
|
|
|
|
|
sub new { |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
#take the class name off the arg list, if it's called that way |
148
|
|
|
|
|
|
|
shift() if ($_[0] =~/^Remedy/); |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
#bless yourself, baby! |
151
|
|
|
|
|
|
|
my $self = bless({@_}); |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
#the following options are required |
154
|
|
|
|
|
|
|
foreach ('Server', 'User', 'Pass'){ |
155
|
|
|
|
|
|
|
exists($self->{$_}) || do { |
156
|
|
|
|
|
|
|
$errstr = $_ . " is a required option for creating an object"; |
157
|
|
|
|
|
|
|
warn($errstr) if $self->{'Debug'}; |
158
|
|
|
|
|
|
|
return (undef); |
159
|
|
|
|
|
|
|
}; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
#default options |
163
|
|
|
|
|
|
|
$self->{'ReloadConfigOK'} = 1 if ($self->{'ReloadConfigOK'} =~/^\s*$/); |
164
|
|
|
|
|
|
|
$self->{'GenerateConfig'} = 1 if ($self->{'GenerateConfig'} =~/^\s*$/); |
165
|
|
|
|
|
|
|
$self->{'TruncateOK'} = 1 if ($self->{'TruncateOK'} =~/^\s*$/); |
166
|
|
|
|
|
|
|
$self->{'Port'} = undef if ($self->{'Port'} !~/^\d+/); |
167
|
|
|
|
|
|
|
$self->{'DateTranslate'} = 1 if ($self->{'DateTranslate'} =~/^\s*$/); |
168
|
|
|
|
|
|
|
$self->{'TwentyFourHourTimeOfDay'} = 0 if ($self->{'TwentyFourHourTimeOfDay'} =~/^\s*$/); |
169
|
|
|
|
|
|
|
$self->{'OverrideJoinSubmitQuery'} = 0 if ($self->{'OverrideJoinSubmitQuery'} =~/^\s*$/); |
170
|
|
|
|
|
|
|
#default options apply only to ARS >= 1.8001 |
171
|
|
|
|
|
|
|
$self->{'Language'} = undef if ($self->{'Language'} =~/^\s*$/); |
172
|
|
|
|
|
|
|
$self->{'AuthString'} = undef if ($self->{'AuthString'} =~/^\s*$/); |
173
|
|
|
|
|
|
|
$self->{'RPCNumber'} = undef if ($self->{'RPCNumber'} =~/^\s*$/); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
#load config file |
177
|
|
|
|
|
|
|
$self->LoadARSConfig() || do { |
178
|
|
|
|
|
|
|
$errstr = $self->{'errstr'}; |
179
|
|
|
|
|
|
|
warn ($errstr) if $self->{'Debug'}; |
180
|
|
|
|
|
|
|
return (undef); |
181
|
|
|
|
|
|
|
}; |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
#get a control token (unless 'LoginOverride' is set) |
184
|
|
|
|
|
|
|
unless ($self->{'LoginOverride'}){ |
185
|
|
|
|
|
|
|
$self->ARSLogin() || do { |
186
|
|
|
|
|
|
|
$errstr = $self->{'errstr'}; |
187
|
|
|
|
|
|
|
warn ($errstr) if $self->{'Debug'}; |
188
|
|
|
|
|
|
|
return (undef) |
189
|
|
|
|
|
|
|
}; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
#bye, now! |
193
|
|
|
|
|
|
|
return($self); |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
## LoadARSConfig ################################## |
201
|
|
|
|
|
|
|
## load the config file with field definitions |
202
|
|
|
|
|
|
|
sub LoadARSConfig { |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
my ($self, %p) = @_; |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
#if the file dosen't exist (or is marked stale), load data from Remedy instead |
207
|
|
|
|
|
|
|
if ( (! -e $self->{'ConfigFile'}) || ($self->{'staleConfig'} > 0) ) { |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
#blow away object's current config (if we have one) |
210
|
|
|
|
|
|
|
$self->{'__oldARSConfig'} = $self->{'ARSConfig'}; |
211
|
|
|
|
|
|
|
$self->{'ARSConfig'} = (); |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
#get a control structure if we don't have one |
214
|
|
|
|
|
|
|
$self->ARSLogin(); |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
#if no 'Schemas' defined on object, pull data for all |
217
|
|
|
|
|
|
|
if (! $self->{'Schemas'}){ |
218
|
|
|
|
|
|
|
warn ("getting schema list from server") if $self->{'Debug'}; |
219
|
|
|
|
|
|
|
@{$self->{'Schemas'}} = ARS::ars_GetListSchema($self->{'ctrl'}) || do { |
220
|
|
|
|
|
|
|
$self->{'errstr'} = "LoadARSConfig: can't retrieve schema list (all): " . $ARS::ars_errstr; |
221
|
|
|
|
|
|
|
warn($self->{'errstr'}) if $self->{'Debug'}; |
222
|
|
|
|
|
|
|
return (undef); |
223
|
|
|
|
|
|
|
}; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
#get field data for each schema |
227
|
|
|
|
|
|
|
foreach (@{$self->{'Schemas'}}){ |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
## NEW HOTNESS (1.11) -- we have to capture metadata about the form, like primarily ... is it a join form? |
230
|
|
|
|
|
|
|
warn ("getting schema metadata for " . $_) if $self->{'Debug'}; |
231
|
|
|
|
|
|
|
my $md_tmp = ARS::ars_GetSchema($self->{'ctrl'}, $_) || do { |
232
|
|
|
|
|
|
|
$self->{'errstr'} = "LoadARSConfig: can't retrieve schema meta-data for: " . $_ . ": " . $ARS::ars_errstr; |
233
|
|
|
|
|
|
|
warn($self->{'errstr'}) if $self->{'Debug'}; |
234
|
|
|
|
|
|
|
return(undef); |
235
|
|
|
|
|
|
|
}; |
236
|
|
|
|
|
|
|
if ((ref($md_tmp) eq "HASH") && (exists($md_tmp->{'schema'}))){ |
237
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_}->{'_schema_info'} = $md_tmp->{'schema'}; |
238
|
|
|
|
|
|
|
}else{ |
239
|
|
|
|
|
|
|
warn("cannot get schema info from this version of the API. CreateTicket will not work against join forms") if ($self->{'Debug'}); |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
## OLD but not busted |
243
|
|
|
|
|
|
|
warn ("getting field list for " . $_) if $self->{'Debug'}; |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
#get field list ... |
246
|
|
|
|
|
|
|
(my %fields = ARS::ars_GetFieldTable($self->{'ctrl'}, $_)) || do { |
247
|
|
|
|
|
|
|
$self->{'errstr'} = "LoadARSConfig: can't retrieve table data for " . $_ . ": " . $ARS::ars_errstr; |
248
|
|
|
|
|
|
|
warn($self->{'errstr'}) if $self->{'Debug'}; |
249
|
|
|
|
|
|
|
return (undef); |
250
|
|
|
|
|
|
|
}; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
#get meta-data for each field |
254
|
|
|
|
|
|
|
foreach my $field (keys %fields){ |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
#set field id |
257
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_}->{'fields'}->{$field}->{'id'} = $fields{$field}; |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
#get meta-data |
260
|
|
|
|
|
|
|
(my $tmp = ARS::ars_GetField( |
261
|
|
|
|
|
|
|
$self->{'ctrl'}, #control token |
262
|
|
|
|
|
|
|
$_, #schema name |
263
|
|
|
|
|
|
|
$fields{$field} #field id |
264
|
|
|
|
|
|
|
)) || do { |
265
|
|
|
|
|
|
|
$self->{'errstr'} = "LoadARSConfig: can't get field meta-data for " . $_ . " / " . $field . |
266
|
|
|
|
|
|
|
": " . $ARS::ars_errstr; |
267
|
|
|
|
|
|
|
warn($self->{'errstr'}) if $self->{'Debug'}; |
268
|
|
|
|
|
|
|
return (undef); |
269
|
|
|
|
|
|
|
}; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
## 1.15 - stash the field's "option" (i.e. "entry_mode": required, optional or display-only) |
272
|
|
|
|
|
|
|
if (defined($tmp->{'option'})){ |
273
|
|
|
|
|
|
|
if ($tmp->{'option'} == 1){ |
274
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_}->{'fields'}->{$field}->{'entry_mode'} = "required"; |
275
|
|
|
|
|
|
|
}elsif ($tmp->{'option'} == 2){ |
276
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_}->{'fields'}->{$field}->{'entry_mode'} = "optional"; |
277
|
|
|
|
|
|
|
}elsif ($tmp->{'option'} == 4){ |
278
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_}->{'fields'}->{$field}->{'entry_mode'} = "display-only"; |
279
|
|
|
|
|
|
|
}else{ |
280
|
|
|
|
|
|
|
warn ("LoadARSConfig: encountered unknown 'option' value (" . $tmp->{'option'} . ") on Schema: " . $_ . " / field: " . $field) if ($self->{'Debug'}); |
281
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_}->{'fields'}->{$field}->{'entry_mode'} = $tmp->{'option'}; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
## NEW HOTNESS (1.02) |
286
|
|
|
|
|
|
|
## depending on the C-api version that ARSperl was compiled against, the data we're looking |
287
|
|
|
|
|
|
|
## for may be in one of two locations. We'll check both, and take the one that has data |
288
|
|
|
|
|
|
|
if ( defined($tmp->{'dataType'}) ){ |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
## some 1.06 hotness ... stash the field dataType too |
291
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_}->{'fields'}->{$field}->{'dataType'} = $tmp->{'dataType'}; |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
if ($tmp->{'dataType'} eq "enum"){ |
294
|
|
|
|
|
|
|
#handle enums |
295
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_}->{'fields'}->{$field}->{'enum'} = 1; |
296
|
|
|
|
|
|
|
if (ref($tmp->{'limit'}) eq "ARRAY"){ |
297
|
|
|
|
|
|
|
#found it in the old place |
298
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_}->{'fields'}->{$field}->{'vals'} = $tmp->{'limit'}; |
299
|
|
|
|
|
|
|
}elsif ( defined($tmp->{'limit'}) && defined($tmp->{'limit'}->{'enumLimits'}) && ( ref($tmp->{'limit'}->{'enumLimits'}->{'regularList'}) eq "ARRAY")){ |
300
|
|
|
|
|
|
|
#found it in the new place |
301
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_}->{'fields'}->{$field}->{'vals'} = $tmp->{'limit'}->{'enumLimits'}->{'regularList'}; |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
## EVEN NEWER HOTNESS (1.04) |
304
|
|
|
|
|
|
|
## handle enums with custom value lists |
305
|
|
|
|
|
|
|
}elsif ( defined($tmp->{'limit'}) && defined($tmp->{'limit'}->{'enumLimits'}) && ( ref($tmp->{'limit'}->{'enumLimits'}->{'customList'}) eq "ARRAY")){ |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
## NEW HOTNESS -- we'll just use a hash |
309
|
|
|
|
|
|
|
## 'ARSConfig'->{schema}->{fields}->{field}->{'enum'} = 1 (regular enum) |
310
|
|
|
|
|
|
|
## 'ARSConfig'->{schema}->{fields}->{field}->{'enum'} = 2 (custom enum -- use the hash) |
311
|
|
|
|
|
|
|
## the hash will be where the 'vals' array used to be. The string will be the key. The enum will be the value |
312
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_}->{'fields'}->{$field}->{'enum'} = 2; |
313
|
|
|
|
|
|
|
foreach my $blah (@{$tmp->{'limit'}->{'enumLimits'}->{'customList'}}){ |
314
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_}->{'fields'}->{$field}->{'vals'}->{$blah->{'itemName'}} = $blah->{'itemNumber'}; |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
}else { |
317
|
|
|
|
|
|
|
#didn't find it at all |
318
|
|
|
|
|
|
|
$self->{'errstr'} = "LoadARSConfig: I can't find the enum list for this field! " . $field . "(" . $fields{$field} . ")"; |
319
|
|
|
|
|
|
|
warn($self->{'errstr'}) if $self->{'Debug'}; |
320
|
|
|
|
|
|
|
return (undef); |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
}else{ |
323
|
|
|
|
|
|
|
#handle everything else (we rolls like that, yo) |
324
|
|
|
|
|
|
|
if ( defined($tmp->{'maxLength'}) && ($tmp->{'maxLength'} =~/^\d+$/)){ |
325
|
|
|
|
|
|
|
#found it in the old place |
326
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_}->{'fields'}->{$field}->{'length'} = $tmp->{'maxLength'}; |
327
|
|
|
|
|
|
|
}elsif (defined($tmp->{'limit'}) && defined($tmp->{'limit'}->{'maxLength'}) && ($tmp->{'limit'}->{'maxLength'} =~/^\d+$/)) { |
328
|
|
|
|
|
|
|
#found it in the new place |
329
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_}->{'fields'}->{$field}->{'length'} = $tmp->{'limit'}->{'maxLength'}; |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
}else{ |
333
|
|
|
|
|
|
|
$self->{'errstr'} = "LoadARSConfig: I can't find field limit data on this version of the API!"; |
334
|
|
|
|
|
|
|
warn($self->{'errstr'}) if $self->{'Debug'}; |
335
|
|
|
|
|
|
|
return (undef); |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
## if we had staleConfig, merge anything from the old one that is MISSING from the new one |
341
|
|
|
|
|
|
|
## it is a cache after all :-) |
342
|
|
|
|
|
|
|
foreach my $_schema (keys (%{$self->{'ARSConfig'}})){ |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
#skip internal shiznit |
345
|
|
|
|
|
|
|
if ($_schema =~/^__/){ next; } |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
#dooo ieeeeet! |
348
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{$_schema} = $self->{'__oldARSConfig'}->{$_schema} if (! exists($self->{'ARSConfig'}->{$_schema})); |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
#unset staleConfig flag |
353
|
|
|
|
|
|
|
delete($self->{'__oldARSConfig'}) if (exists($self->{'__oldARSConfig'})); |
354
|
|
|
|
|
|
|
$self->{'staleConfig'} = 0; |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
## new for 1.06, keep Remedy::ARSTools::VERSION in the config, so we can know later if we need to upgrade it |
358
|
|
|
|
|
|
|
$self->{'ARSConfig'}->{'__Remedy_ARSTools_Version'} = $Remedy::ARSTools::VERSION; |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
#now that we have our data, write the file (if we have the flag) |
361
|
|
|
|
|
|
|
if ($self->{'GenerateConfig'} > 0){ |
362
|
|
|
|
|
|
|
require Data::DumpXML; |
363
|
|
|
|
|
|
|
my $xml = Data::DumpXML::dump_xml($self->{'ARSConfig'}); |
364
|
|
|
|
|
|
|
warn("LoadARSConfig: exported field data to XML") if $self->{'Debug'}; |
365
|
|
|
|
|
|
|
open (CFG, ">" . $self->{'ConfigFile'}) || do { |
366
|
|
|
|
|
|
|
$self->{'errstr'} = "LoadARSConfig: can't open config file for writing: " . $!; |
367
|
|
|
|
|
|
|
warn($self->{'errstr'}) if $self->{'Debug'}; |
368
|
|
|
|
|
|
|
return(undef); |
369
|
|
|
|
|
|
|
}; |
370
|
|
|
|
|
|
|
print CFG $xml, "\n"; |
371
|
|
|
|
|
|
|
close(CFG); |
372
|
|
|
|
|
|
|
warn("LoadARSConfig: exported field data to config file: " . $self->{'ConfigFile'}) if $self->{'Debug'}; |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
#we're done here |
375
|
|
|
|
|
|
|
return (1); |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
#otherwise, load it from the file |
379
|
|
|
|
|
|
|
}else{ |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
#open config file |
382
|
|
|
|
|
|
|
open (CFG, $self->{'ConfigFile'}) || do { |
383
|
|
|
|
|
|
|
$self->{'errstr'} = "LoadARSConfig: can't open specified config file: " . $!; |
384
|
|
|
|
|
|
|
warn($self->{'errstr'}) if $self->{'Debug'}; |
385
|
|
|
|
|
|
|
return (undef); |
386
|
|
|
|
|
|
|
}; |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
#parse it |
389
|
|
|
|
|
|
|
require Data::DumpXML::Parser; |
390
|
|
|
|
|
|
|
my $parser = Data::DumpXML::Parser->new(); |
391
|
|
|
|
|
|
|
eval { $self->{ARSConfig} = $parser->parsestring(join("", )); }; |
392
|
|
|
|
|
|
|
if ($@){ |
393
|
|
|
|
|
|
|
$self->{'errstr'} = "LoadARSConfig: can't parse config data from file: " . $@; |
394
|
|
|
|
|
|
|
warn($self->{'errstr'}) if $self->{'Debug'}; |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
close (CFG); |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
#actually just the first element will do ;-) |
399
|
|
|
|
|
|
|
$self->{'ARSConfig'} = $self->{'ARSConfig'}->[0]; |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
## new for 1.06 ... upgrade the config if it was created with an earlier version of Remedy::ARSTools |
402
|
|
|
|
|
|
|
if ($self->{'ARSConfig'}->{'__Remedy_ARSTools_Version'} < 1.15){ |
403
|
|
|
|
|
|
|
warn("LoadARSConfig: re-generating config generated with earlier version of Remedy::ARSTools") if $self->{'Debug'}; |
404
|
|
|
|
|
|
|
$self->{'staleConfig'} = 1; |
405
|
|
|
|
|
|
|
$self->LoadARSConfig(); |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
warn("LoadARSConfig: loaded config from file") if $self->{'Debug'}; |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
## new for 1.15 - check the loaded config to make sure it has all of the 'Schemas', if not mark the config stale, and refresh it |
410
|
|
|
|
|
|
|
foreach my $schema (@{$self->{'Schemas'}}){ |
411
|
|
|
|
|
|
|
exists($self->{'ARSConfig'}->{$schema}) || do { |
412
|
|
|
|
|
|
|
warn ("LoadARSConfig: loaded cache file missing schema: " . $schema) if ($self->{'Debug'}); |
413
|
|
|
|
|
|
|
$self->{'staleConfig'} = 1; |
414
|
|
|
|
|
|
|
}; |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
if ($self->{'staleConfig'} > 0){ |
417
|
|
|
|
|
|
|
warn ("LoadARSConfig: refreshing cache from server ..."); |
418
|
|
|
|
|
|
|
$self->LoadARSConfig(); |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
return(1); |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
## ARSLogin ####################################### |
429
|
|
|
|
|
|
|
## if not already logged in ... get ars token. |
430
|
|
|
|
|
|
|
## this is a sneaky hack to get around perl compiler |
431
|
|
|
|
|
|
|
## errors thrown on behalf of the function prototypes |
432
|
|
|
|
|
|
|
## in ARSperl, which change based on the version |
433
|
|
|
|
|
|
|
## installed. |
434
|
|
|
|
|
|
|
sub ARSLogin { |
435
|
|
|
|
|
|
|
my $self = shift(); |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
#actually, just distribute the call based on the ARSperl version |
438
|
|
|
|
|
|
|
if ($ARS::VERSION < 1.8001){ |
439
|
|
|
|
|
|
|
return ($self->ARSLoginOld(@_)); |
440
|
|
|
|
|
|
|
}else{ |
441
|
|
|
|
|
|
|
return ($self->ARSLoginNew(@_)); |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
## Query ########################################### |
446
|
|
|
|
|
|
|
## return selected fields from records matching the |
447
|
|
|
|
|
|
|
## given QBE string in the specified schema. |
448
|
|
|
|
|
|
|
## this is also a sneaky hack to call the correct |
449
|
|
|
|
|
|
|
## syntax for ars_GetListEntry based on the ARSperl |
450
|
|
|
|
|
|
|
## version number |
451
|
|
|
|
|
|
|
sub Query { |
452
|
|
|
|
|
|
|
my $self = shift(); |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
#actually, just distribute the call based on the ARSperl version |
455
|
|
|
|
|
|
|
if ($ARS::VERSION < 1.8001){ |
456
|
|
|
|
|
|
|
return ($self->QueryOld(@_)); |
457
|
|
|
|
|
|
|
}else{ |
458
|
|
|
|
|
|
|
return ($self->QueryNew(@_)); |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
## Destroy ######################################## |
465
|
|
|
|
|
|
|
## log off remedy gracefully and destroy object |
466
|
|
|
|
|
|
|
sub Destroy { |
467
|
|
|
|
|
|
|
my $self = shift(); |
468
|
|
|
|
|
|
|
ARS::ars_Logoff($self->{ctrl}) if exists($self->{ctrl}); |
469
|
|
|
|
|
|
|
$self = undef; |
470
|
|
|
|
|
|
|
return (1); |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
## True for perl include ########################## |
477
|
|
|
|
|
|
|
1; |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
__END__ |