File Coverage

blib/lib/Remedy/ARSTools.pm
Criterion Covered Total %
statement 9 11 81.8
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 13 15 86.6


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__