blib/lib/FWS/V2/Format.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 15 | 476 | 3.1 |
branch | 0 | 216 | 0.0 |
condition | 0 | 66 | 0.0 |
subroutine | 5 | 44 | 11.3 |
pod | 35 | 35 | 100.0 |
total | 55 | 837 | 6.5 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package FWS::V2::Format; | ||||||
2 | |||||||
3 | 1 | 1 | 1549 | use 5.006; | |||
1 | 3 | ||||||
1 | 43 | ||||||
4 | 1 | 1 | 5 | use strict; | |||
1 | 2 | ||||||
1 | 30 | ||||||
5 | 1 | 1 | 4 | use warnings; | |||
1 | 2 | ||||||
1 | 29 | ||||||
6 | 1 | 1 | 5 | no warnings 'uninitialized'; | |||
1 | 2 | ||||||
1 | 190 | ||||||
7 | |||||||
8 | =head1 NAME | ||||||
9 | |||||||
10 | FWS::V2::Format - Framework Sites version 2 text and html formatting | ||||||
11 | |||||||
12 | =head1 VERSION | ||||||
13 | |||||||
14 | Version 1.13091122 | ||||||
15 | |||||||
16 | =cut | ||||||
17 | |||||||
18 | our $VERSION = '1.13091122'; | ||||||
19 | |||||||
20 | =head1 SYNOPSIS | ||||||
21 | |||||||
22 | use FWS::V2; | ||||||
23 | |||||||
24 | my $fws = FWS::V2->new(); | ||||||
25 | |||||||
26 | my $tempPassword = $fws->createPassword( lowLength => 6, highLength => 8); | ||||||
27 | |||||||
28 | my $newGUID = $fws->createGUID(); | ||||||
29 | |||||||
30 | |||||||
31 | |||||||
32 | =head1 DESCRIPTION | ||||||
33 | |||||||
34 | Framework Sites version 2 methods that use or manipulate text either for rendering or default population. | ||||||
35 | |||||||
36 | =head1 METHODS | ||||||
37 | |||||||
38 | |||||||
39 | =head2 anOrA | ||||||
40 | |||||||
41 | Return an 'a' or an 'an' based on what the next word is. | ||||||
42 | |||||||
43 | # | ||||||
44 | # retrieve a guid | ||||||
45 | # | ||||||
46 | print "This is " . $fws->anOrA( 'antalope' ) . " antalope or " . $fws->anOrA( 'cantalope' ) . " cantalope.\n': | ||||||
47 | |||||||
48 | # return: This is an antalope or a cantalope. | ||||||
49 | |||||||
50 | =cut | ||||||
51 | |||||||
52 | sub anOrA { | ||||||
53 | 0 | 0 | 1 | my ( $self, $postWord ) = @_; | |||
54 | 0 | 0 | if ( $postWord =~ /^[aeiou]/i ) { return 'an' } else { return 'a' } | ||||
0 | |||||||
0 | |||||||
55 | } | ||||||
56 | |||||||
57 | =head2 createGUID | ||||||
58 | |||||||
59 | Return a non repeatable Globally Unique Identifier to be used to populate the guid field that is default on all FWS tables. | ||||||
60 | |||||||
61 | # | ||||||
62 | # retrieve a guid to use with a new record | ||||||
63 | # | ||||||
64 | my $guid = $fws->createGUID(); | ||||||
65 | |||||||
66 | In version 2 all GUID's have a prefix, if not specified it will be set to 'd'. There should be no reason to use another prefix, but if you wish you can add it as the only parameter it will be used. In newer versions of FWS the prefix will eventually be deprecated and is only still present for compatibility. | ||||||
67 | |||||||
68 | =cut | ||||||
69 | |||||||
70 | sub createGUID { | ||||||
71 | 0 | 0 | 1 | my ( $self, $guid ) = @_; | |||
72 | |||||||
73 | # | ||||||
74 | # Version 2 guids are always prefixed with a character, if you don't pass one | ||||||
75 | # lets make it 'd' | ||||||
76 | # | ||||||
77 | 0 | 0 | if ( !$guid ) { | ||||
78 | 0 | $guid = 'd'; | |||||
79 | } | ||||||
80 | |||||||
81 | 1 | 1 | 808 | use Digest::SHA1 qw(sha1); | |||
1 | 953 | ||||||
1 | 7157 | ||||||
82 | 0 | return $guid . join( '', unpack( 'H8 H4 H4 H4 H12', sha1( shift() . shift() . time() . rand() . $< . $$ ) ) ); | |||||
83 | } | ||||||
84 | |||||||
85 | =head2 activeToggleIcon | ||||||
86 | |||||||
87 | Create a on off admin lightbulb for an item that will work if you are logged in as an edit mode editor role. Pass a data hash, and append ajaxUpdateTable if it is not updating the standard data table. | ||||||
88 | |||||||
89 | =cut | ||||||
90 | |||||||
91 | sub activeToggleIcon { | ||||||
92 | 0 | 0 | 1 | my ( $self, %paramHash ) = @_; | |||
93 | |||||||
94 | 0 | my $table = 'data'; | |||||
95 | 0 | 0 | if ( $paramHash{ajaxUpdateTable} ) { $table = $paramHash{ajaxUpdateTable} } | ||||
0 | |||||||
96 | |||||||
97 | 0 | 0 | if ( !$paramHash{active} ) { | ||||
98 | 0 | return $self->FWSIcon( | |||||
99 | icon => "lightbulb_off_16.png", | ||||||
100 | onClick => "var currentState = 1; if (this.src.substr(this.src.length-9,2) == 'on')" . | ||||||
101 | "{this.src='" . $self->{fileFWSPath} . | ||||||
102 | "/icons/lightbulb_off_16.png'; currentState = 0; } else { this.src='".$self->{fileFWSPath} . | ||||||
103 | "/icons/lightbulb_on_16.png';};\$('').FWSAjax({queryString:'" . | ||||||
104 | "p=fws_dataEdit&value='+currentState+'&guid=" . $paramHash{guid} . | ||||||
105 | "&table=" . $table . "&field=active&pageAction=AJAXUpdate',showLoading:false});", | ||||||
106 | title => "Active Toggle", | ||||||
107 | alt => "Active Toggle", | ||||||
108 | style => $paramHash{style}, | ||||||
109 | width => "16", | ||||||
110 | ); | ||||||
111 | } | ||||||
112 | else { | ||||||
113 | 0 | return $self->FWSIcon( | |||||
114 | icon => "lightbulb_on_16.png", | ||||||
115 | onClick => "var currentState = 1; if (this.src.substr(this.src.length-9,2) == 'on')" . | ||||||
116 | "{this.src='" . $self->{fileFWSPath} . | ||||||
117 | "/icons/lightbulb_off_16.png'; currentState = 0; } else { this.src='" . $self->{fileFWSPath} . | ||||||
118 | "/icons/lightbulb_on_16.png';};\$('').FWSAjax({queryString:'" . | ||||||
119 | "p=fws_dataEdit&value='+currentState+'&guid=" . $paramHash{guid} . | ||||||
120 | "&table=" . $table . "&field=active&pageAction=AJAXUpdate',showLoading:false});", | ||||||
121 | style => $paramHash{style}, | ||||||
122 | title => "Active Toggle", | ||||||
123 | alt => "Active Toggle", | ||||||
124 | width => "16", | ||||||
125 | ); | ||||||
126 | } | ||||||
127 | } | ||||||
128 | |||||||
129 | |||||||
130 | =head2 applyLanguage | ||||||
131 | |||||||
132 | Apply the langague to a hash, so it will return as if the current sessions language is returned as the default keys. | ||||||
133 | |||||||
134 | # | ||||||
135 | # retrieve a guid to use with a new record | ||||||
136 | # | ||||||
137 | %dataHash = $fws->applyLanguage( %dataHash ); | ||||||
138 | |||||||
139 | =cut | ||||||
140 | |||||||
141 | |||||||
142 | sub applyLanguage { | ||||||
143 | 0 | 0 | 1 | my ( $self, %langHash ) = @_; | |||
144 | |||||||
145 | # | ||||||
146 | # init the return hash | ||||||
147 | # | ||||||
148 | 0 | my %returnHash; | |||||
149 | |||||||
150 | # | ||||||
151 | # go though each one | ||||||
152 | # | ||||||
153 | 0 | foreach my $key (keys %langHash) { | |||||
154 | |||||||
155 | # | ||||||
156 | # if it doesn't eend with a language notation, then run the field | ||||||
157 | # | ||||||
158 | 0 | 0 | 0 | if ( $key !~ /_\w\w$/ && $key !~ /_id/i ) { | |||
159 | 0 | $returnHash{$key} = $self->field( $key, %langHash ); | |||||
160 | } | ||||||
161 | else { | ||||||
162 | 0 | $returnHash{$key} = $langHash{$key}; | |||||
163 | } | ||||||
164 | } | ||||||
165 | # | ||||||
166 | # return our hash we created | ||||||
167 | # | ||||||
168 | 0 | return %returnHash; | |||||
169 | } | ||||||
170 | |||||||
171 | |||||||
172 | =head2 captchaHTML | ||||||
173 | |||||||
174 | Return the default captcha html to be used with isCaptchaValid on its return. | ||||||
175 | |||||||
176 | =cut | ||||||
177 | |||||||
178 | sub captchaHTML { | ||||||
179 | 0 | 0 | 1 | my ( $self ) = @_; | |||
180 | 0 | my $publicKey = $self->siteValue( 'captchaPublicKey' ); | |||||
181 | 0 | my $returnHTML; | |||||
182 | 0 | 0 | if ( $publicKey ) { | ||||
183 | 0 | $returnHTML .= "\n"; | |||||
184 | 0 | $returnHTML .= ""; | |||||
185 | 0 | $self->addToHead( "\n" ); | |||||
186 | } | ||||||
187 | 0 | return $returnHTML; | |||||
188 | } | ||||||
189 | |||||||
190 | =head2 CCTypeFromNumber | ||||||
191 | |||||||
192 | This will be moved to legacy. Do not use. | ||||||
193 | |||||||
194 | =cut | ||||||
195 | |||||||
196 | sub CCTypeFromNumber { | ||||||
197 | 0 | 0 | 1 | my ( $self, $format, $CCNumber ) = @_; | |||
198 | |||||||
199 | 0 | 0 | if ( $format eq 'singleChar' ) { | ||||
200 | 0 | 0 | if ( $CCNumber =~ /^4/ ) { return 'V' } | ||||
0 | |||||||
201 | 0 | 0 | if ( $CCNumber =~ /^5/ ) { return 'M' } | ||||
0 | |||||||
202 | 0 | 0 | if ( $CCNumber =~ /^3/ ) { return 'A' } | ||||
0 | |||||||
203 | 0 | 0 | if ( $CCNumber =~ /^6/ ) { return 'D' } | ||||
0 | |||||||
204 | } | ||||||
205 | |||||||
206 | 0 | 0 | if ( $format eq 'word' ) { | ||||
207 | 0 | 0 | if ( $CCNumber =~ /^4/ ) { return 'Visa' } | ||||
0 | |||||||
208 | 0 | 0 | if ( $CCNumber =~ /^5/ ) { return 'Master Card' } | ||||
0 | |||||||
209 | 0 | 0 | if ( $CCNumber =~ /^3/ ) { return 'American Express' } | ||||
0 | |||||||
210 | 0 | 0 | if ( $CCNumber =~ /^6/ ) { return 'Discover' } | ||||
0 | |||||||
211 | } | ||||||
212 | |||||||
213 | 0 | return; | |||||
214 | } | ||||||
215 | |||||||
216 | |||||||
217 | =head2 createPin | ||||||
218 | |||||||
219 | Return a short pin for common data structures. | ||||||
220 | |||||||
221 | # | ||||||
222 | # retrieve a guid to use with a new record | ||||||
223 | # | ||||||
224 | my $pin = $fws->createPin(); | ||||||
225 | |||||||
226 | This pin will be checked against the directory, and profile tables to make sure it is not repeated and by default be 6 characters long with only easy to read character composition (23456789QWERTYUPASDFGHJKLZXCVBNM). | ||||||
227 | |||||||
228 | =cut | ||||||
229 | |||||||
230 | sub createPin { | ||||||
231 | 0 | 0 | 1 | my ( $self, $class ) = @_; | |||
232 | 0 | my $newPin; | |||||
233 | |||||||
234 | # | ||||||
235 | # run a while statement until we get a guid that isn't arelady used | ||||||
236 | # | ||||||
237 | 0 | while ( !$newPin ) { | |||||
238 | |||||||
239 | # | ||||||
240 | # new pin! | ||||||
241 | # | ||||||
242 | 0 | $newPin = $self->createPassword( composition => '23456789QWERTYUPASDFGHJKLZXCVBNM', lowLength => 6, highLength => 6 ); | |||||
243 | |||||||
244 | # | ||||||
245 | # go through all our pins and see if we have a match | ||||||
246 | # | ||||||
247 | 0 | for my $table ( keys %{$self->{dataSchema}} ) { | |||||
0 | |||||||
248 | 0 | 0 | if ( $self->{dataSchema}{$table}{pin}{type} ) { | ||||
249 | 0 | 0 | if ( @{$self->runSQL( SQL => "select 1 from " . $self->safeSQL( $table ) . " where pin='" . $self->safeSQL( $newPin ) . "'" )} ) { | ||||
0 | |||||||
250 | 0 | $newPin = ''; | |||||
251 | } | ||||||
252 | } | ||||||
253 | } | ||||||
254 | } | ||||||
255 | 0 | return $newPin; | |||||
256 | } | ||||||
257 | |||||||
258 | =head2 createPassword | ||||||
259 | |||||||
260 | Return a random password or text key that can be used for temp password or unique configurable small strings. | ||||||
261 | |||||||
262 | # | ||||||
263 | # retrieve a password that is 6-8 characters long and does not contain commonly mistaken letters | ||||||
264 | # | ||||||
265 | my $tempPassword = $fws->createPassword( | ||||||
266 | composition => "abcedef1234567890", | ||||||
267 | lowLength => 6, | ||||||
268 | highLength => 8); | ||||||
269 | |||||||
270 | If no composition is given, a vocal friendly list will be used: qwertyupasdfghjkzxcvbnmQWERTYUPASDFGHJKZXCVBNM23456789 | ||||||
271 | |||||||
272 | =cut | ||||||
273 | |||||||
274 | sub createPassword { | ||||||
275 | 0 | 0 | 1 | my ( $self, %paramHash ) = @_; | |||
276 | |||||||
277 | # | ||||||
278 | # PH for return | ||||||
279 | # | ||||||
280 | 0 | my $returnString; | |||||
281 | |||||||
282 | # | ||||||
283 | # set the composition to the easy say set if its blank | ||||||
284 | # | ||||||
285 | 0 | 0 | $paramHash{composition} ||= "qwertyupasdfghjkzxcvbnmQWERTYUPASDFGHJKZXCVBNM23456789"; | ||||
286 | 0 | 0 | $paramHash{lowLength} ||= 6; | ||||
287 | 0 | 0 | $paramHash{heighLength} ||= 6; | ||||
288 | |||||||
289 | 0 | my @pass = split( //, $paramHash{composition} ); | |||||
290 | 0 | my $length = int( rand( $paramHash{highLength} - $paramHash{lowLength} + 1 ) ) + $paramHash{lowLength}; | |||||
291 | 0 | for( 1 .. $length ) { | |||||
292 | 0 | $returnString .= $pass[int( rand( $#pass ) )]; | |||||
293 | } | ||||||
294 | 0 | return $returnString; | |||||
295 | } | ||||||
296 | |||||||
297 | |||||||
298 | =head2 dialogWindow | ||||||
299 | |||||||
300 | Return a modal window link or onclick javascript. | ||||||
301 | |||||||
302 | Possible Parameters: | ||||||
303 | |||||||
304 | =over 4 | ||||||
305 | |||||||
306 | =item * width | ||||||
307 | |||||||
308 | defaults to 800 (only pass int) | ||||||
309 | |||||||
310 | =item * height | ||||||
311 | |||||||
312 | deafults to jquery dialog deafult | ||||||
313 | |||||||
314 | =item * id | ||||||
315 | |||||||
316 | The id of the div you wish to populate the modals content with (Can not be used with queryString) | ||||||
317 | |||||||
318 | =item * queryString | ||||||
319 | |||||||
320 | The query after the queryHead used to populate the modal (Can not be used with id) | ||||||
321 | |||||||
322 | =item * linkText | ||||||
323 | |||||||
324 | If linkText is passed the return will the a the linkText wrappered in an anchor tag with the modal onclick | ||||||
325 | |||||||
326 | =item * subModal | ||||||
327 | |||||||
328 | Set this to 1 if you are passing queryString and wish to replace the current contents of the modal with the new query. This will only work if it is called from within another modal | ||||||
329 | |||||||
330 | =item * loadingContent | ||||||
331 | |||||||
332 | HTML passed as the "now loading..." type text as HTML. This is javascript wrappered with single tics escape them if you need to use them: \' | ||||||
333 | |||||||
334 | =back | ||||||
335 | |||||||
336 | =cut | ||||||
337 | |||||||
338 | |||||||
339 | sub dialogWindow { | ||||||
340 | 0 | 0 | 1 | my ( $self, %paramHash ) = @_; | |||
341 | |||||||
342 | # | ||||||
343 | # Determine Auto Resize Settings default it to true if it is blank | ||||||
344 | # | ||||||
345 | 0 | 0 | $paramHash{autoResize} = 'true' if ( !$paramHash{autoResize} ); | ||||
346 | |||||||
347 | # | ||||||
348 | # set defaults and fix up the width | ||||||
349 | # | ||||||
350 | 0 | $self->jqueryEnable( 'ui-1.8.9' ); | |||||
351 | 0 | $self->jqueryEnable( 'ui.dialog-1.8.9' ); | |||||
352 | 0 | $self->jqueryEnable( 'ui.position-1.8.9' ); | |||||
353 | 0 | 0 | if ( !defined $paramHash{width} ) { $paramHash{width} = '800' } | ||||
0 | |||||||
354 | 0 | my $returnHTML = "var jsAutoResize = '" . $paramHash{autoResize} . "';"; | |||||
355 | |||||||
356 | # | ||||||
357 | # build the ajax load without the jquery pre object because we could use it two different ways | ||||||
358 | # | ||||||
359 | 0 | my $ajaxLoad = "load('" . $self->{scriptName} . $self->{queryHead} . $paramHash{queryString} . "',function(){"; | |||||
360 | 0 | 0 | if ( $self->{adminLoginId} ) { $ajaxLoad .= "FWSUIInit();" } | ||||
0 | |||||||
361 | 0 | $ajaxLoad .= "if (jsAutoResize.length) { \$.modal.update(); } });"; | |||||
362 | |||||||
363 | # | ||||||
364 | # create someting small and unique so we can use it as a reference | ||||||
365 | # | ||||||
366 | 0 | my $uniqueId = '_' . $self->createPassword( composition => 'qwertyupasdfghjkzxcvbnmQWERTYUPASDFGHJKZXCVBNM', lowLength => 6, highLength => 6 ); | |||||
367 | |||||||
368 | 0 | 0 | $paramHash{loadingContent} ||= " Loading, please wait..."; | ||||
369 | |||||||
370 | # | ||||||
371 | # return the ajax against he modal wrapper if we are just refreshing with new content | ||||||
372 | # | ||||||
373 | |||||||
374 | 0 | 0 | if ( $paramHash{subModal} ) { | ||||
375 | 0 | $returnHTML .= "\$('.simplemodal-data').html( '".$paramHash{loadingContent} ."' );\$('.simplemodal-data')." . $ajaxLoad; | |||||
376 | } | ||||||
377 | |||||||
378 | # | ||||||
379 | # this is not a subModal do the whole gig | ||||||
380 | # | ||||||
381 | else { | ||||||
382 | 0 | 0 | $returnHTML .= "\$('" . ( $paramHash{id} ? "#" . $paramHash{id} : "').html( '" . $paramHash{loadingContent} . "' )").".modal({ dataId: 'modal_" . $uniqueId . "',"; | ||||
383 | |||||||
384 | # | ||||||
385 | # Set the hit and autoresize | ||||||
386 | # | ||||||
387 | 0 | 0 | if ( defined $paramHash{height} ) { $returnHTML .= "minHeight: " . $paramHash{height} . ",maxHeight: " . $paramHash{height} . "," } | ||||
0 | |||||||
388 | 0 | $returnHTML .= "autoResize: " . $paramHash{autoResize} . ","; | |||||
389 | |||||||
390 | # | ||||||
391 | # because we do NOT have an ID, lets build the onShow loader | ||||||
392 | # | ||||||
393 | 0 | 0 | if ( !$paramHash{id} ) { $returnHTML .= "onShow: function (dialog) { \$('#modal_" . $uniqueId . "')." . $ajaxLoad . " }," } | ||||
0 | |||||||
394 | |||||||
395 | # | ||||||
396 | # create the oncloase to clean up any mce thingies | ||||||
397 | # | ||||||
398 | 0 | $returnHTML .= "onClose: function(dialog) { FWSCloseMCE(); \$.modal.close(); },"; | |||||
399 | 0 | $returnHTML .= "minWidth:" . $paramHash{width}; | |||||
400 | 0 | $returnHTML .= "}); "; | |||||
401 | } | ||||||
402 | |||||||
403 | # | ||||||
404 | # return the link wrapperd onclick or just the onclick | ||||||
405 | # | ||||||
406 | 0 | 0 | if ( $paramHash{linkHTML} ) { | ||||
407 | 0 | return "" . $paramHash{linkHTML} . ""; | |||||
408 | } | ||||||
409 | 0 | return $returnHTML; | |||||
410 | } | ||||||
411 | |||||||
412 | |||||||
413 | =head2 splitDirectory | ||||||
414 | |||||||
415 | Return directory with the last part of the directory split into two parts. If a directory passed into it ends with a slash, then it will be removed. | ||||||
416 | |||||||
417 | # | ||||||
418 | # this will return /first/part/su/supertsplitter | ||||||
419 | # | ||||||
420 | print $fws->splitDirectory( directory => '/first/part/supersplitter' ); | ||||||
421 | |||||||
422 | =cut | ||||||
423 | |||||||
424 | sub splitDirectory { | ||||||
425 | 0 | 0 | 1 | my ( $self, %paramHash ) = @_; | |||
426 | |||||||
427 | # | ||||||
428 | # set the default length to 2 | ||||||
429 | # | ||||||
430 | 0 | 0 | $paramHash{splitLength} = $paramHash{splitLength} ||= 2; | ||||
431 | |||||||
432 | # | ||||||
433 | # managable parts | ||||||
434 | # | ||||||
435 | 0 | my @dirParts = split( /\//, $paramHash{directory} ); | |||||
436 | |||||||
437 | # | ||||||
438 | # take the one off the ened | ||||||
439 | # | ||||||
440 | 0 | my $lastDirPart = pop( @dirParts ); | |||||
441 | |||||||
442 | 0 | return join( '/', @dirParts ) . '/' . substr( $lastDirPart, 0, $paramHash{splitLength} ) . '/' . $lastDirPart; | |||||
443 | } | ||||||
444 | |||||||
445 | |||||||
446 | =head2 fieldHash | ||||||
447 | |||||||
448 | Return a hash of formValues passed to the current post that are not used for the FWS core. | ||||||
449 | |||||||
450 | my %formFieldsPopulated = $fws->fieldHash(); | ||||||
451 | |||||||
452 | =cut | ||||||
453 | |||||||
454 | sub fieldHash { | ||||||
455 | 0 | 0 | 1 | my ( $self, %fieldHash ) = @_; | |||
456 | |||||||
457 | # | ||||||
458 | # put the fields in the screen and block out the ones we don't want to pass though | ||||||
459 | # | ||||||
460 | 0 | my @formArray = $self->formArray(); | |||||
461 | 0 | foreach my $fieldName ( @formArray ) { | |||||
462 | 0 | 0 | 0 | if ( $fieldName !~ /^(amp|id|pageAction|killSession|page|a|noSession|session|l|p|s|b|editMode|bs)$/ && $fieldName !~ /FWS_/i ) { | |||
463 | 0 | $fieldHash{$fieldName} = $self->formValue( $fieldName ); | |||||
464 | } | ||||||
465 | } | ||||||
466 | 0 | return %fieldHash; | |||||
467 | } | ||||||
468 | |||||||
469 | |||||||
470 | =head2 fontCSS | ||||||
471 | |||||||
472 | Return css that will set the default FWS font for inline use before CSS is capable of being applied. | ||||||
473 | |||||||
474 | =cut | ||||||
475 | |||||||
476 | sub fontCSS { | ||||||
477 | 0 | 0 | 1 | return "font-size:12px;font-family: Tahoma, serifSansSerifMonospace;"; | |||
478 | } | ||||||
479 | |||||||
480 | |||||||
481 | =head2 formatDate | ||||||
482 | |||||||
483 | Return the date time in a given format. By passing epochTime, SQLTime you can do a time conversion from that date/time to what ever format is set to. If you do not pass epoch or SQL time the server time will be used. | ||||||
484 | |||||||
485 | # | ||||||
486 | # get the current Date in SQL format | ||||||
487 | # | ||||||
488 | my $currentDate = $fws->formatDate( format => 'date' ); | ||||||
489 | |||||||
490 | # | ||||||
491 | # convert SQL formated date time to a human form | ||||||
492 | # | ||||||
493 | my $humanDate = $fws->formatDate( SQLTime => '2012-10-12 10:09:33', format => 'date' ); | ||||||
494 | |||||||
495 | By passing minuteMod, monthMod or dayMod you can adjust the month forward or backwards by the given number of months or days | ||||||
496 | |||||||
497 | # | ||||||
498 | # 3 months from today (negative numbers are ok) | ||||||
499 | # | ||||||
500 | my $threeMonths = $fws->formatDate( format => 'date', monthMod => 3 ); | ||||||
501 | |||||||
502 | Multilingual support: French date formats will be used for 'fancyDate' and 'date' if the language() is set to FR. | ||||||
503 | |||||||
504 | Possible Parameters: | ||||||
505 | |||||||
506 | =over 4 | ||||||
507 | |||||||
508 | =item * format | ||||||
509 | |||||||
510 | Format type to return. This is the only required field | ||||||
511 | |||||||
512 | =item * epochTime | ||||||
513 | |||||||
514 | epoch time which could be created with time() | ||||||
515 | |||||||
516 | =item * monthMod | ||||||
517 | |||||||
518 | Modify the current month ahead or behind. (Note: If your current day is 31st, and you mod to a month that has less than 31 days it will move to the highest day of that month) | ||||||
519 | |||||||
520 | =item * dayMod | ||||||
521 | |||||||
522 | Modify the current day ahead or behind. | ||||||
523 | |||||||
524 | =item * minuteMod | ||||||
525 | |||||||
526 | Modify the current minute ahead or behind. | ||||||
527 | |||||||
528 | =item * dateSeparator | ||||||
529 | |||||||
530 | This will default to '-', but can be changed to anything. (Note: Do not use this if you are returing SQLTime format) | ||||||
531 | |||||||
532 | =item * GMTOffset | ||||||
533 | |||||||
534 | Time zone modifier. Example: CST would be -5 | ||||||
535 | |||||||
536 | =item * numberTime | ||||||
537 | |||||||
538 | Use an number translated time format (It looks like SQL without sperators) YYYYMMDDHHMMSS. HHMMSS will default to 000000 if not passed. | ||||||
539 | |||||||
540 | =item * SQLTime | ||||||
541 | |||||||
542 | Use an SQL time format as the incomming date and time. | ||||||
543 | |||||||
544 | =item * ISO8601 | ||||||
545 | |||||||
546 | Use GMT based ISO8601 formated time as the incomming date and time. | ||||||
547 | |||||||
548 | =back | ||||||
549 | |||||||
550 | The following types of formats are valid: | ||||||
551 | |||||||
552 | =over 4 | ||||||
553 | |||||||
554 | =item * date | ||||||
555 | |||||||
556 | mm-dd-yyyy | ||||||
557 | |||||||
558 | =item * time | ||||||
559 | |||||||
560 | hh:mmAM XXX | ||||||
561 | |||||||
562 | =item * shortDate | ||||||
563 | |||||||
564 | MMM DD YYYY (MMM is the three letter acrynomn for the month in caps) | ||||||
565 | |||||||
566 | =item * fancyDate | ||||||
567 | |||||||
568 | weekdayName, monthName dd[st|nd|rd] of yyyy | ||||||
569 | |||||||
570 | =item * cookie | ||||||
571 | |||||||
572 | cookie compatible date/time | ||||||
573 | |||||||
574 | =item * apache | ||||||
575 | |||||||
576 | apache web server compatible date/time | ||||||
577 | |||||||
578 | =item * number | ||||||
579 | |||||||
580 | yyyymmddhhmmss | ||||||
581 | |||||||
582 | =item * dateTime | ||||||
583 | |||||||
584 | mm-dd-yyyy hh:mmAM XXX | ||||||
585 | |||||||
586 | =item * dateTimeFull | ||||||
587 | |||||||
588 | mm-dd-yyyy hh:mm:ss XXX | ||||||
589 | |||||||
590 | =item * SQL | ||||||
591 | |||||||
592 | yyyy-mm-dd hh:mm:ss | ||||||
593 | |||||||
594 | =item * epoch | ||||||
595 | |||||||
596 | Standard epoch number | ||||||
597 | |||||||
598 | =item * yearFirstDate | ||||||
599 | |||||||
600 | yyyy-mm-dd | ||||||
601 | |||||||
602 | =item * year | ||||||
603 | |||||||
604 | yyyy | ||||||
605 | |||||||
606 | =item * month | ||||||
607 | |||||||
608 | mm | ||||||
609 | |||||||
610 | =item * day | ||||||
611 | |||||||
612 | dd | ||||||
613 | |||||||
614 | =item * ISO8601 | ||||||
615 | |||||||
616 | YYYY-MM-DDTHH:MM:SSZ (The Z and the T are literal. This format will always return GMT, but when epoch, and SQLTime are passed, they should passed as server time because they will be converted to GMT on the based on $fws->{GMTOffset} site setting) | ||||||
617 | |||||||
618 | =back | ||||||
619 | |||||||
620 | =cut | ||||||
621 | |||||||
622 | sub formatDate { | ||||||
623 | 0 | 0 | 1 | my ( $self, %paramHash ) = @_; | |||
624 | 0 | 0 | $paramHash{format} ||= 'dateTime'; | ||||
625 | 0 | 0 | $paramHash{monthMod} ||= 0; | ||||
626 | 0 | 0 | $paramHash{dayMod} ||= 0; | ||||
627 | 0 | 0 | $paramHash{minuteMod} ||= 0; | ||||
628 | 0 | 0 | $paramHash{epochTime} ||= time(); | ||||
629 | 0 | 0 | $paramHash{dateSeparator} ||= '-'; | ||||
630 | |||||||
631 | # | ||||||
632 | # set defaults | ||||||
633 | # | ||||||
634 | 0 | 0 | $paramHash{GMTOffset} ||= 0; | ||||
635 | |||||||
636 | # | ||||||
637 | # set up the ISO8601 date time and make it SQL with the GMTOffset and then process form there | ||||||
638 | # | ||||||
639 | 0 | 0 | if ( $paramHash{ISO8601} ) { | ||||
640 | 0 | $paramHash{GMTOffset} = $self->{GMTOffset}; | |||||
641 | 0 | $paramHash{SQLTime} = $paramHash{ISO8601}; | |||||
642 | 0 | $paramHash{SQLTime} =~ s/T/ /sg; | |||||
643 | 0 | $paramHash{SQLTime} =~ s/Z//sg; | |||||
644 | } | ||||||
645 | |||||||
646 | # | ||||||
647 | # pase numbers or sql times | ||||||
648 | # | ||||||
649 | 0 | 0 | 0 | if ( defined $paramHash{numberTime} || defined $paramHash{SQLTime}) { | |||
650 | |||||||
651 | # | ||||||
652 | # do sql by default, but overwrite with numberTime if thats what it is | ||||||
653 | # | ||||||
654 | 0 | my @timeSplit = split( /[ \-:]/, $paramHash{SQLTime} ); | |||||
655 | |||||||
656 | 0 | 0 | if ( defined $paramHash{numberTime} ) { | ||||
657 | 0 | $timeSplit[0] = substr( $paramHash{numberTime} ,0,4 ); | |||||
658 | 0 | $timeSplit[1] = substr( $paramHash{numberTime} ,4,2 ); | |||||
659 | 0 | $timeSplit[2] = substr( $paramHash{numberTime} ,6,2 ); | |||||
660 | 0 | $timeSplit[3] = substr( $paramHash{numberTime} ,8,2 ); | |||||
661 | 0 | $timeSplit[4] = substr( $paramHash{numberTime} ,10,2 ); | |||||
662 | 0 | $timeSplit[5] = substr( $paramHash{numberTime} ,12,2 ); | |||||
663 | } | ||||||
664 | |||||||
665 | # | ||||||
666 | # fix anything that could rock the boat older versions of perl need this for | ||||||
667 | # timelocal to work, 1902 -> 2037 is safe | ||||||
668 | # | ||||||
669 | 0 | 0 | if ( $timeSplit[0] < 1902) {$timeSplit[0] = '1902';} | ||||
0 | |||||||
670 | 0 | 0 | if ( $timeSplit[0] > 2037) {$timeSplit[0] = '2037';} | ||||
0 | |||||||
671 | 0 | 0 | 0 | if ( $timeSplit[1] eq '' || $timeSplit[1] == 0) {$timeSplit[1] = '1'} | |||
0 | |||||||
672 | 0 | 0 | 0 | if ( $timeSplit[2] eq '' || $timeSplit[2] == 0) {$timeSplit[2] = '1'} | |||
0 | |||||||
673 | 0 | 0 | if ( $timeSplit[3] eq '') {$timeSplit[3] = '0'} | ||||
0 | |||||||
674 | 0 | 0 | if ( $timeSplit[4] eq '') {$timeSplit[4] = '0'} | ||||
0 | |||||||
675 | 0 | 0 | if ( $timeSplit[5] eq '') {$timeSplit[5] = '0'} | ||||
0 | |||||||
676 | |||||||
677 | # | ||||||
678 | # fix the month and make it epoch to use for the rest of the script | ||||||
679 | # | ||||||
680 | 0 | $timeSplit[1]--; | |||||
681 | 0 | require Time::Local; | |||||
682 | 0 | Time::Local->import(); | |||||
683 | 0 | $paramHash{epochTime} = timelocal( reverse( @timeSplit ) ); | |||||
684 | } | ||||||
685 | |||||||
686 | # | ||||||
687 | # offset the time if reqested to | ||||||
688 | # | ||||||
689 | 0 | $paramHash{epochTime} += ( $paramHash{GMTOffset} * 3600 ); | |||||
690 | |||||||
691 | # | ||||||
692 | # move the day around if passed | ||||||
693 | # | ||||||
694 | 0 | $paramHash{epochTime} += ( $paramHash{dayMod} * 86400 ); | |||||
695 | |||||||
696 | # | ||||||
697 | # move the minute around if passed | ||||||
698 | # | ||||||
699 | 0 | $paramHash{epochTime} += ( $paramHash{minuteMod} * 60 ); | |||||
700 | |||||||
701 | # | ||||||
702 | # get the localtime | ||||||
703 | # | ||||||
704 | 0 | my ( $sec, $min, $hr, $mday, $mon, $annum, $wday, $yday, $isdst ) = localtime( $paramHash{epochTime} ); | |||||
705 | |||||||
706 | # | ||||||
707 | # we want months to go from 1-12 with the mod adjustment | ||||||
708 | # | ||||||
709 | 0 | $mon += $paramHash{monthMod} + 1; | |||||
710 | |||||||
711 | # | ||||||
712 | # and we want to use four-digit years | ||||||
713 | # | ||||||
714 | 0 | my $year = 1900 + $annum; | |||||
715 | |||||||
716 | # | ||||||
717 | # min and second is always leading zero | ||||||
718 | # | ||||||
719 | 0 | $min = ( "0" x ( 2 - length( $min ) ) ) . $min; | |||||
720 | 0 | $sec = ( "0" x ( 2 - length( $sec ) ) ) . $sec; | |||||
721 | |||||||
722 | # | ||||||
723 | # lets grab minute before we PM/AM it | ||||||
724 | # | ||||||
725 | 0 | my $minute = $min; | |||||
726 | |||||||
727 | # | ||||||
728 | #grab the hour before we am/pm it | ||||||
729 | # | ||||||
730 | 0 | my $hour = $hr; | |||||
731 | |||||||
732 | # | ||||||
733 | # turn military time time to AM/PM time | ||||||
734 | # hr is the AM PM version hour is military | ||||||
735 | # | ||||||
736 | 0 | 0 | if ( $hr > 12 ) { | ||||
737 | 0 | $hr = $hr-12; | |||||
738 | 0 | $min .= "PM"; | |||||
739 | } | ||||||
740 | else { | ||||||
741 | 0 | 0 | if ( $hr == 12 ) { $min .= "PM" } | ||||
0 | |||||||
742 | 0 | else { $min .= "AM" } | |||||
743 | } | ||||||
744 | |||||||
745 | # | ||||||
746 | # if the $month is less than 1 then shift them off to the year slots | ||||||
747 | # if the monthmod is more than 12 shift them off to the year slots positivly | ||||||
748 | # | ||||||
749 | 0 | while ( $mon < 1 ) { | |||||
750 | 0 | $mon += 12; | |||||
751 | 0 | $year--; | |||||
752 | } | ||||||
753 | 0 | while ( $mon > 12 ) { | |||||
754 | 0 | $mon -= 12; | |||||
755 | 0 | $year++; | |||||
756 | } | ||||||
757 | |||||||
758 | # | ||||||
759 | # adjust the number of months by the mod | ||||||
760 | # | ||||||
761 | 0 | my $month = ( "0" x (2 - length( $mon ) ) ) . $mon; | |||||
762 | |||||||
763 | # | ||||||
764 | # leading zero our minute | ||||||
765 | # | ||||||
766 | 0 | $hour = ( "0" x (2 - length( $hour ) ) ) . $hour; | |||||
767 | 0 | my $monthDay = ( "0" x ( 2 - length( $mday ) ) ) . $mday; | |||||
768 | |||||||
769 | # | ||||||
770 | # this is what we will return | ||||||
771 | # | ||||||
772 | 0 | my $showDateTime; | |||||
773 | |||||||
774 | 0 | 0 | if ( $paramHash{format} =~ /^number$/i ) { | ||||
775 | 0 | $showDateTime = $year.$month.$monthDay.$hour.$minute.$sec; | |||||
776 | } | ||||||
777 | |||||||
778 | 0 | 0 | if ( $paramHash{format} =~ /^shortDate$/i ) { | ||||
779 | 0 | my @monthName = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ); | |||||
780 | 0 | $showDateTime = $monthName[$mon-1] . ' ' . $monthDay . ' ' . $year; | |||||
781 | } | ||||||
782 | |||||||
783 | 0 | 0 | if ( $paramHash{format} =~ /^cookie$/i ) { | ||||
784 | 0 | my @dayName = qw( Sun Mon Tue Wed Thu Fri Sat ); | |||||
785 | 0 | my @monthName = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ); | |||||
786 | 0 | $showDateTime = $dayName[$wday] . ', ' . $monthDay . $paramHash{dateSeparator} . $monthName[$mon-1] . $paramHash{dateSeparator} . $year . ' ' . $hour . ':' . $minute . ':' . $sec . ' GMT'; | |||||
787 | } | ||||||
788 | |||||||
789 | 0 | 0 | if ( $paramHash{format} =~ /^ISO8601$/i ) { | ||||
790 | 0 | 0 | $showDateTime = sprintf( "%04d-%02d-%02dT%02d:%02d:%02dZ", sub { ( $_[5]+1900, $_[4] + 1, $_[3], $_[2], $_[1], $_[0] ) }->( gmtime( $paramHash{epochTime} ) ) ); | ||||
0 | |||||||
791 | } | ||||||
792 | |||||||
793 | |||||||
794 | 0 | 0 | if ( $paramHash{format} =~ /^fancyDate$/i ) { | ||||
795 | 0 | my @dayName = qw( Sunday Monday Tuesday Wednesday Thursday Friday Saturday ); | |||||
796 | 0 | my @monthName = qw( January Febuary March April May June July August September October November December ); | |||||
797 | |||||||
798 | # | ||||||
799 | # date names in french | ||||||
800 | # | ||||||
801 | 0 | 0 | if ( $self->language() =~ /fr/i ) { @dayName = qw( Dimanche Lundi Mardi Vendredi Jeudi Vendredi Samedi ) } | ||||
0 | |||||||
802 | 0 | 0 | if ( $self->language() =~ /fr/i ) { @monthName = qw( janvier fevrier mars avril mai juin juillet a^out septembre octobre novembre decembre ) } | ||||
0 | |||||||
803 | |||||||
804 | # | ||||||
805 | # English th/nd/st rules | ||||||
806 | # | ||||||
807 | 0 | my $numberCap = 'th'; | |||||
808 | 0 | $monthDay =~ s/^0//sg; | |||||
809 | 0 | 0 | 0 | if ( $monthDay =~ /2$/ && $monthDay ne '12' ) { $numberCap = "nd" } | |||
0 | |||||||
810 | 0 | 0 | 0 | if ( $monthDay =~ /3$/ && $monthDay ne '13' ) { $numberCap = "rd" } | |||
0 | |||||||
811 | 0 | 0 | 0 | if ( $monthDay =~ /1$/i && $monthDay ne '11' ) { $numberCap = "st" } | |||
0 | |||||||
812 | |||||||
813 | # | ||||||
814 | # English date format | ||||||
815 | # | ||||||
816 | 0 | $showDateTime = $dayName[$wday] . ', ' . $monthName[$mon-1] . ' ' . $monthDay . $numberCap . ',' . ' ' . $year; | |||||
817 | |||||||
818 | # | ||||||
819 | # French date format | ||||||
820 | # | ||||||
821 | 0 | 0 | if ( $self->language() =~ /fr/i ) { $showDateTime = $dayName[$wday] . ' le ' . $monthDay . ' ' . $monthName[$mon-1] . ' ' . $year } | ||||
0 | |||||||
822 | } | ||||||
823 | |||||||
824 | 0 | 0 | if ( $paramHash{format} =~ /^apache$/i ) { | ||||
825 | 0 | my @monthName = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ); | |||||
826 | 0 | my @dayName = qw( Sun Mon Tue Wed Thu Fri Sat ); | |||||
827 | 0 | my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime( $paramHash{epochTime} ); | |||||
828 | 0 | $year = $year + 1900; | |||||
829 | 0 | $showDateTime = $dayName[$wday] . ', ' . $mday . ' ' . $monthName[$mon] . ' ' . $year . ' ' . $hour . ':' . $minute . ':' . $sec . ' GMT'; | |||||
830 | } | ||||||
831 | |||||||
832 | 0 | 0 | if ( $paramHash{format} =~ /^(odbc|SQL)$/i ) { | ||||
833 | 0 | $showDateTime = $year . $paramHash{dateSeparator} . $month . $paramHash{dateSeparator} . $monthDay . " " . $hour . ":" . $minute . ":" . $sec; | |||||
834 | } | ||||||
835 | |||||||
836 | 0 | 0 | if ( $paramHash{format} =~ /^date$/i ) { | ||||
837 | # | ||||||
838 | # english date | ||||||
839 | # | ||||||
840 | 0 | $showDateTime = $month . $paramHash{dateSeparator} . $monthDay . $paramHash{dateSeparator} . $year; | |||||
841 | |||||||
842 | # | ||||||
843 | # french date | ||||||
844 | # | ||||||
845 | 0 | 0 | if ( $self->language() =~ /fr/i ) { $showDateTime = $monthDay . $paramHash{dateSeparator} . $month . $paramHash{dateSeparator} . $year } | ||||
0 | |||||||
846 | } | ||||||
847 | |||||||
848 | 0 | 0 | if ( $paramHash{format} =~ /^month$/i ) { $showDateTime = $month } | ||||
0 | |||||||
849 | 0 | 0 | if ( $paramHash{format} =~ /^year$/i ) { $showDateTime = $year } | ||||
0 | |||||||
850 | 0 | 0 | if ( $paramHash{format} =~ /^day$/i ) { $showDateTime = $monthDay } | ||||
0 | |||||||
851 | |||||||
852 | # TODO Need to make timzone text fws configurable | ||||||
853 | 0 | 0 | if ( $paramHash{format} =~ /^time$/i ) { $showDateTime = $hr . ":" . $min . " EST" } | ||||
0 | |||||||
854 | |||||||
855 | # TODO Need to make timzone text fws configurable | ||||||
856 | 0 | 0 | if ( $paramHash{format} =~ /^dateTime$/i ) { | ||||
857 | 0 | $showDateTime = $month . $paramHash{dateSeparator} . $monthDay . $paramHash{dateSeparator} . $year . " " . $hr . ":" . $min . " EST"; | |||||
858 | } | ||||||
859 | |||||||
860 | # TODO Need to make timzone text fws configurable | ||||||
861 | 0 | 0 | if ( $paramHash{format} =~ /^dateTimeFull$/i ) { | ||||
862 | 0 | $showDateTime = $month . $paramHash{dateSeparator} . $monthDay . $paramHash{dateSeparator} . $year . " " . $hour . ":" . $minute . ":" . $sec." EST"; | |||||
863 | } | ||||||
864 | |||||||
865 | 0 | 0 | if ( $paramHash{format} =~ /^yearFirstDate$/i ) { | ||||
866 | 0 | $showDateTime = $year . $paramHash{dateSeparator} . $month . $paramHash{dateSeparator} . $monthDay; | |||||
867 | } | ||||||
868 | |||||||
869 | 0 | 0 | if ( $paramHash{format} =~ /^firstOfMonth$/i ) { | ||||
870 | 0 | $showDateTime = $month . $paramHash{dateSeparator} . "01" . $paramHash{dateSeparator} . $year; | |||||
871 | } | ||||||
872 | |||||||
873 | 0 | 0 | if ( $paramHash{format} =~ /^epoch$/i ) { | ||||
874 | 0 | $showDateTime = $paramHash{epochTime}; | |||||
875 | } | ||||||
876 | |||||||
877 | 0 | return $showDateTime; | |||||
878 | } | ||||||
879 | |||||||
880 | =head2 field | ||||||
881 | |||||||
882 | Return a field based on dynamic language and falling back to the default if the language specific value isn't available. | ||||||
883 | |||||||
884 | print $fws->field( 'title', %dataHash ); | ||||||
885 | |||||||
886 | =cut | ||||||
887 | |||||||
888 | sub field { | ||||||
889 | 0 | 0 | 1 | my ( $self, $fieldName, %dataHash ) = @_; | |||
890 | |||||||
891 | # | ||||||
892 | # the datafields have a couple of issues with core field names that do not match its language field | ||||||
893 | # here are the conversions | ||||||
894 | # | ||||||
895 | 0 | $fieldName =~ s/^navigationName/nav_name/s; | |||||
896 | |||||||
897 | # | ||||||
898 | # check to see if a language specific one exists | ||||||
899 | # | ||||||
900 | 0 | 0 | if ( $dataHash{$fieldName . '_' . $self->language()} ) { | ||||
901 | 0 | $dataHash{$fieldName} = $dataHash{$fieldName . '_' . $self->language() } | |||||
902 | } | ||||||
903 | else { | ||||||
904 | # | ||||||
905 | # put the navigationName back if we didn't have to switch | ||||||
906 | # | ||||||
907 | 0 | $fieldName =~ s/^nav_name/navigationName/s; | |||||
908 | } | ||||||
909 | |||||||
910 | # | ||||||
911 | # return either the default, or the language specific one | ||||||
912 | # | ||||||
913 | 0 | return $dataHash{$fieldName}; | |||||
914 | } | ||||||
915 | |||||||
916 | =head2 formatCurrency | ||||||
917 | |||||||
918 | Return a number in USD Format. | ||||||
919 | |||||||
920 | print $fws->formatCurrency(33.55); | ||||||
921 | |||||||
922 | =cut | ||||||
923 | |||||||
924 | sub formatCurrency { | ||||||
925 | 0 | 0 | 1 | my ( $self, $amount ) = @_; | |||
926 | #TODO convert this method to use paramHash with international support yet still legacy to work in this fasion | ||||||
927 | 0 | my $negative = ''; | |||||
928 | 0 | 0 | if ( $amount =~ /^-/ ) { $negative = '-' } | ||||
0 | |||||||
929 | 0 | $amount =~ s/[^\d.]+//g; | |||||
930 | 0 | $amount = $amount + 0; | |||||
931 | 0 | 0 | if ( $amount == 0 ) { $amount = "0.00" } | ||||
0 | |||||||
932 | 0 | else { $amount = sprintf ( "%.2f", $amount ) } | |||||
933 | 0 | $amount =~ s/\G(\d{1,3})(?=(?:\d\d\d)+(?:\.|$))/$1,/g; | |||||
934 | 0 | return "\$" . $negative . $amount; | |||||
935 | } | ||||||
936 | |||||||
937 | |||||||
938 | =head2 formatPhone | ||||||
939 | |||||||
940 | Return a phone number in a specific format. | ||||||
941 | |||||||
942 | print $fws->formatPhone( format => 'full', phone => '555-367-5309' ); | ||||||
943 | |||||||
944 | |||||||
945 | Valid formats: | ||||||
946 | |||||||
947 | number: 1234567890 | ||||||
948 | |||||||
949 | full: (123) 456-7890 | ||||||
950 | |||||||
951 | dots: 123.456.7890 | ||||||
952 | |||||||
953 | =cut | ||||||
954 | |||||||
955 | sub formatPhone { | ||||||
956 | 0 | 0 | 1 | my ( $self, %paramHash ) = @_; | |||
957 | 0 | my $returnPhone = $paramHash{phone}; | |||||
958 | 0 | $paramHash{phone} =~ s/[\D]//sg; | |||||
959 | 0 | $paramHash{phone} = substr( $paramHash{phone}, -10 ); | |||||
960 | 0 | 0 | if ( length( $paramHash{phone} ) != 10) { $returnPhone = '' } else { | ||||
0 | |||||||
961 | 0 | 0 | if ( $paramHash{format} eq 'number' ) { | ||||
962 | 0 | $returnPhone = $paramHash{phone}; | |||||
963 | } | ||||||
964 | 0 | 0 | if ( $paramHash{format} eq 'full' ) { | ||||
965 | 0 | $returnPhone = '(' . substr( $paramHash{phone}, 0, 3 ) . ') ' . substr( $paramHash{phone}, 3, 3 ) . '-' . substr( $paramHash{phone}, 6, 4 ); | |||||
966 | } | ||||||
967 | 0 | 0 | if ( $paramHash{format} eq 'dots' ) { | ||||
968 | 0 | $returnPhone = substr( $paramHash{phone}, 0, 3 ) . '.' . substr( $paramHash{phone}, 3, 3 ) . '.' . substr( $paramHash{phone}, 6, 4 ); | |||||
969 | } | ||||||
970 | } | ||||||
971 | 0 | return $returnPhone; | |||||
972 | } | ||||||
973 | |||||||
974 | |||||||
975 | =head2 FWSButton | ||||||
976 | |||||||
977 | Create a button that is default to JQuery UI class structure. You can pass style, class, name, id, value and onClick keys. | ||||||
978 | |||||||
979 | =cut | ||||||
980 | |||||||
981 | sub FWSButton{ | ||||||
982 | 0 | 0 | 1 | my ( $self, %paramHash ) = @_; | |||
983 | 0 | my $buttonHTML = " | |||||
984 | 0 | 0 | if ( $paramHash{style} ) { $buttonHTML .= " style=\"" . $paramHash{style} . "\" " } | ||||
0 | |||||||
985 | 0 | 0 | if ( $paramHash{name} ) { $buttonHTML .= " name=\"" . $paramHash{name} . "\" " } | ||||
0 | |||||||
986 | 0 | 0 | if ( $paramHash{id} ) { $buttonHTML .= " id=\"" . $paramHash{id} . "\" " } | ||||
0 | |||||||
987 | 0 | 0 | if ( $paramHash{onClick} ) { $buttonHTML .= " onclick=\"" . $paramHash{onClick} . "\"" } | ||||
0 | |||||||
988 | 0 | $buttonHTML .= ">"; | |||||
989 | 0 | $buttonHTML .= " | ";|||||
990 | 0 | $buttonHTML .= ""; | |||||
991 | |||||||
992 | 0 | return $buttonHTML; | |||||
993 | } | ||||||
994 | |||||||
995 | |||||||
996 | =head2 FWSHint | ||||||
997 | |||||||
998 | Return a FWS Hint HTML for roll over hint icons or links. | ||||||
999 | |||||||
1000 | =cut | ||||||
1001 | |||||||
1002 | sub FWSHint { | ||||||
1003 | 0 | 0 | 1 | my ( $self, %paramHash ) = @_; | |||
1004 | # | ||||||
1005 | # add the jquery | ||||||
1006 | # | ||||||
1007 | 0 | $self->jqueryEnable( 'easyToolTip-1.0' ); | |||||
1008 | |||||||
1009 | # | ||||||
1010 | # if no id is givin, that means we are posting an image | ||||||
1011 | # | ||||||
1012 | 0 | my $returnHTML; | |||||
1013 | 0 | 0 | if ( !$paramHash{id} ) { | ||||
1014 | 0 | my $imgPath = $self->fileWebPath()."/fws/jquery/easyToolTip-1.0/"; | |||||
1015 | 0 | $paramHash{id} = 'hint_' . $self->createPassword( composition => 'qwertyupasdfghjkzxcvbnmQWERTYUPASDFGHJKZXCVBNM', lowLength => 4, highLength => 4 ); | |||||
1016 | 0 | $returnHTML .= ""; | |||||
1017 | } | ||||||
1018 | |||||||
1019 | # | ||||||
1020 | # create the JS | ||||||
1021 | # | ||||||
1022 | 0 | my $headHTML = "\n"; | |||||
1027 | |||||||
1028 | 0 | return $returnHTML . $headHTML; | |||||
1029 | } | ||||||
1030 | |||||||
1031 | |||||||
1032 | =head2 FWSIcon | ||||||
1033 | |||||||
1034 | Return just the file name when given a full file path | ||||||
1035 | |||||||
1036 | $valueHash{html} .= $fws->FWSIcon( icon => 'blank_16.png' ); | ||||||
1037 | |||||||
1038 | You can pass the following keys: | ||||||
1039 | |||||||
1040 | icon | ||||||
1041 | class | ||||||
1042 | id | ||||||
1043 | width | ||||||
1044 | alt | ||||||
1045 | onClick | ||||||
1046 | |||||||
1047 | =cut | ||||||
1048 | |||||||
1049 | sub FWSIcon { | ||||||
1050 | 0 | 0 | 1 | my ( $self, %paramHash ) = @_; | |||
1051 | 0 | 0 | $paramHash{icon} ||= 'blank.png'; | ||||
1052 | 0 | 0 | $paramHash{alt} ||= '\'\''; | ||||
1053 | 0 | 0 | if ( $paramHash{class} ) { $paramHash{class} = ' class="' . $paramHash{class} . '"' } | ||||
0 | |||||||
1054 | 0 | 0 | if ( $paramHash{id} ) { $paramHash{id} = ' id="' . $paramHash{id} . '"' } | ||||
0 | |||||||
1055 | 0 | 0 | if ( $paramHash{width} ) { $paramHash{style} .= "width:" . $paramHash{width} . "px" } | ||||
0 | |||||||
1056 | 0 | 0 | if ( $paramHash{onClick} ) { | ||||
1057 | 0 | $paramHash{onClick} = " onclick=\"" . $paramHash{onClick} . "\""; | |||||
1058 | 0 | $paramHash{style} = 'cursor:pointer;' . $paramHash{style}; | |||||
1059 | } | ||||||
1060 | 0 | return "{fileFWSPath} . "/icons/" . $paramHash{icon} . "\" alt=\"" . $paramHash{alt} . "\"" . $paramHash{id} . $paramHash{class} . $paramHash{onClick} . " style=\"border:none;" . $paramHash{style} . "\"/>"; | |||||
1061 | } | ||||||
1062 | |||||||
1063 | |||||||
1064 | =head2 justFileName | ||||||
1065 | |||||||
1066 | Return just the file name when given a full file path | ||||||
1067 | |||||||
1068 | my $fileName = $fws->justFileName( '/this/is/not/going/to/be/here/justTheFileName.jpg' ); | ||||||
1069 | |||||||
1070 | =cut | ||||||
1071 | |||||||
1072 | sub justFileName { | ||||||
1073 | 0 | 0 | 1 | my ( $self, $justFileName ) = @_; | |||
1074 | |||||||
1075 | # | ||||||
1076 | # change the \ to /'s | ||||||
1077 | # | ||||||
1078 | 0 | $justFileName =~ s/\\/\//g; | |||||
1079 | |||||||
1080 | # | ||||||
1081 | # split it up and pop off the last one | ||||||
1082 | # | ||||||
1083 | 0 | my @fileNameArray = split( /\//, $justFileName ); | |||||
1084 | 0 | $justFileName = pop( @fileNameArray ); | |||||
1085 | |||||||
1086 | 0 | return $justFileName | |||||
1087 | } | ||||||
1088 | |||||||
1089 | =head2 jqueryEnable | ||||||
1090 | |||||||
1091 | Add FWS core distribution jQuery modules and corresponding CSS files to the CSS and JS cached files. These are located in the /fws/jquery directory. The naming convention for jQuery files are normalized and only the module name and version is required. | ||||||
1092 | |||||||
1093 | # | ||||||
1094 | # if the module you were loadings file name is: | ||||||
1095 | # jquery-WHATEVERTHEMODULEIS-1.1.1.min.js | ||||||
1096 | # it would be loaded via jqueryEnable as follows: | ||||||
1097 | # | ||||||
1098 | $fws->jqueryEnable( 'WHATEVERTHEMODULEIS-1.1.1' ); | ||||||
1099 | |||||||
1100 | This method ensures jQuery files are only loaded once, and the act of any jQuery module being enabled will auto-activate the core jQuery library. They will be loaded in the order they were called from any element in the rendering process. | ||||||
1101 | |||||||
1102 | =cut | ||||||
1103 | |||||||
1104 | sub jqueryEnable { | ||||||
1105 | 0 | 0 | 1 | my ( $self, $jqueryEnable ) = @_; | |||
1106 | |||||||
1107 | |||||||
1108 | # | ||||||
1109 | # make sure this is something before we continue | ||||||
1110 | # | ||||||
1111 | 0 | 0 | if ( $jqueryEnable ) { | ||||
1112 | |||||||
1113 | # | ||||||
1114 | # get the current hash | ||||||
1115 | # | ||||||
1116 | 0 | my %jqueryHash = %{$self->{_jqueryHash}}; | |||||
0 | |||||||
1117 | |||||||
1118 | # | ||||||
1119 | # if its already there lets just leave it alone | ||||||
1120 | # | ||||||
1121 | 0 | 0 | if ( !$jqueryHash{$jqueryEnable} ) { | ||||
1122 | |||||||
1123 | # | ||||||
1124 | # set the number, but lets make sure its greater than 1 | ||||||
1125 | # so we can do boolean tests against it | ||||||
1126 | # | ||||||
1127 | 0 | $jqueryHash{$jqueryEnable} = ( keys %jqueryHash ) + 1; | |||||
1128 | |||||||
1129 | } | ||||||
1130 | |||||||
1131 | # | ||||||
1132 | # pass the new hash back into the jqueryHash | ||||||
1133 | # | ||||||
1134 | 0 | %{$self->{_jqueryHash}} = %jqueryHash; | |||||
0 | |||||||
1135 | } | ||||||
1136 | |||||||
1137 | 0 | return; | |||||
1138 | } | ||||||
1139 | |||||||
1140 | |||||||
1141 | =head2 loadingImage | ||||||
1142 | |||||||
1143 | Return the web path for the default loading image spinny. | ||||||
1144 | |||||||
1145 | =cut | ||||||
1146 | |||||||
1147 | sub loadingImage { | ||||||
1148 | 0 | 0 | 1 | my ( $self ) = @_; | |||
1149 | 0 | return $self->{fileFWSPath} . "/saving.gif"; | |||||
1150 | } | ||||||
1151 | |||||||
1152 | |||||||
1153 | =head2 logoutOnClick | ||||||
1154 | |||||||
1155 | Return the on click javascript for a logout button. You can pass landingPage key if you want it to land somewhere besides the current page. This is also trigger the facebook logout. | ||||||
1156 | |||||||
1157 | =cut | ||||||
1158 | |||||||
1159 | sub logoutOnClick { | ||||||
1160 | 0 | 0 | 1 | my ( $self, %paramHash ) = @_; | |||
1161 | |||||||
1162 | 0 | my $logoutHTML; | |||||
1163 | |||||||
1164 | # | ||||||
1165 | # set the landing page you will fall once this happens | ||||||
1166 | # | ||||||
1167 | 0 | my $landingPage = $self->formValue( 'p' ); | |||||
1168 | 0 | 0 | if ( $paramHash{landingPage} ) { $landingPage = $paramHash{landingPage} } | ||||
0 | |||||||
1169 | |||||||
1170 | # | ||||||
1171 | # logout string | ||||||
1172 | # | ||||||
1173 | 0 | $logoutHTML .= "location.href='" . $self->{scriptName} . "?s=" . $self->{siteId} . "&p=" . $landingPage . "&pageAction=logout';"; | |||||
1174 | |||||||
1175 | # | ||||||
1176 | # if we are running facebook, we need to run logout(); | ||||||
1177 | # | ||||||
1178 | 0 | 0 | if ( $self->siteValue( 'facebookAppId' ) ) { | ||||
1179 | 0 | $logoutHTML = "FB.getLoginStatus( function(response) { if (response.authResponse) {FB.logout(function(response) {" . $logoutHTML . "});} else { " . $logoutHTML . "}});return false;"; | |||||
1180 | } | ||||||
1181 | |||||||
1182 | 0 | return $logoutHTML; | |||||
1183 | } | ||||||
1184 | |||||||
1185 | |||||||
1186 | =head2 navigationLink | ||||||
1187 | |||||||
1188 | Return a wrapped link of data hash that can be linked to. This supports friendlies, forced or not, and url linking. | ||||||
1189 | |||||||
1190 | =cut | ||||||
1191 | |||||||
1192 | sub navigationLink { | ||||||
1193 | 0 | 0 | 1 | my ( $self, %hrefHash ) = @_; | |||
1194 | 0 | my $href; | |||||
1195 | # | ||||||
1196 | # if it is a page create this or we just want the href then do this | ||||||
1197 | # | ||||||
1198 | 0 | 0 | 0 | if ( $hrefHash{type} eq 'page' || $hrefHash{hrefOnly} ) { | |||
1199 | # | ||||||
1200 | # if there is a friendly for the URL use it, if not do the page=id stuff. | ||||||
1201 | # | ||||||
1202 | 0 | 0 | 0 | if ( $hrefHash{friendlyURL} && !$self->siteValue( 'noFriendlies' ) ) { | |||
1203 | 0 | $href .= '/' . $hrefHash{friendlyURL}; | |||||
1204 | } | ||||||
1205 | else { | ||||||
1206 | 0 | $href .= $self->{scriptName} . '?s=' . $self->{siteId} . '&p=' . $hrefHash{guid}; | |||||
1207 | } | ||||||
1208 | } | ||||||
1209 | |||||||
1210 | # | ||||||
1211 | # we only want the href, reguardless of antying. give and get out | ||||||
1212 | # | ||||||
1213 | 0 | 0 | if ( $hrefHash{hrefOnly} ) { | ||||
1214 | 0 | return $href; | |||||
1215 | }; | ||||||
1216 | |||||||
1217 | # | ||||||
1218 | # URL | ||||||
1219 | # | ||||||
1220 | 0 | 0 | if ( $hrefHash{type} eq 'url' ) { $href = " | ||||
0 | |||||||
1221 | |||||||
1222 | # | ||||||
1223 | # finish grooming the href if its for a page. | ||||||
1224 | # | ||||||
1225 | 0 | 0 | if ( $hrefHash{type} eq 'page' ) { | ||||
1226 | 0 | $href = " | |||||
1227 | } | ||||||
1228 | |||||||
1229 | 0 | 0 | 0 | if ( $hrefHash{type} eq "page" || $hrefHash{type} eq "url") { | |||
1230 | |||||||
1231 | # | ||||||
1232 | # if we are on the page we are printing add "currentPage" | ||||||
1233 | # | ||||||
1234 | 0 | 0 | if ( $hrefHash{guid} eq $self->formValue( 'FWS_pageId' ) ) { | ||||
1235 | 0 | $href .= ' class="currentPage"'; | |||||
1236 | } | ||||||
1237 | |||||||
1238 | # | ||||||
1239 | # End the href part of the anchor | ||||||
1240 | # | ||||||
1241 | 0 | $href .= ">"; | |||||
1242 | |||||||
1243 | # | ||||||
1244 | # html friendly the text for the between the a's | ||||||
1245 | # | ||||||
1246 | 0 | $hrefHash{name} =~ s/&/&/sg; | |||||
1247 | 0 | $hrefHash{name} =~ s/ | |||||
1248 | 0 | $hrefHash{name} =~ s/>/>/sg; | |||||
1249 | |||||||
1250 | # | ||||||
1251 | # bilingual the name, and navName; | ||||||
1252 | # | ||||||
1253 | 0 | $hrefHash{navigationName} = $self->field( 'navigationName', %hrefHash ); | |||||
1254 | |||||||
1255 | # | ||||||
1256 | # add the text for the name, and close the anchor | ||||||
1257 | # | ||||||
1258 | 0 | 0 | $href .= ( $hrefHash{navigationName} ) ? $hrefHash{navigationName} : $hrefHash{name}; | ||||
1259 | |||||||
1260 | 0 | $href .= ""; | |||||
1261 | } | ||||||
1262 | 0 | return $href; | |||||
1263 | } | ||||||
1264 | |||||||
1265 | |||||||
1266 | =head2 popupWindow | ||||||
1267 | |||||||
1268 | Create a link to a popup window or just the onclick. Passing queryString is requried and pass linkHTML if you would like it to be a link. | ||||||
1269 | |||||||
1270 | $valueHash{html} .= $fws->popupWindow(queryString=>'p=somePage',$linkHTML=>'Click Here to go to some page'); | ||||||
1271 | |||||||
1272 | NOTE: This should only be used in the context of the FWS Administration, and is only here as a reference for modifiers of the admin. | ||||||
1273 | |||||||
1274 | =cut | ||||||
1275 | |||||||
1276 | sub popupWindow { | ||||||
1277 | 0 | 0 | 1 | my ( $self, %paramHash ) = @_; | |||
1278 | 0 | my $returnHTML = "window.open('" . $self->{scriptName} . $self->{queryHead} . $paramHash{queryString} . "','_blank');"; | |||||
1279 | 0 | 0 | if ( $paramHash{linkHTML} ) { | ||||
1280 | 0 | return "" . $paramHash{linkHTML} . ""; | |||||
1281 | } | ||||||
1282 | 0 | return $returnHTML; | |||||
1283 | } | ||||||
1284 | |||||||
1285 | =head2 removeHTML | ||||||
1286 | |||||||
1287 | Return a string minus anything that is in < >. | ||||||
1288 | |||||||
1289 | $safeForText = $fws->removeHTML( 'This is the text that will return without the anchor' ); | ||||||
1290 | |||||||
1291 | =cut | ||||||
1292 | |||||||
1293 | sub removeHTML { | ||||||
1294 | 0 | 0 | 1 | my ( $self, $theString ) = @_; | |||
1295 | 0 | $theString =~ s///gs; | |||||
1296 | 0 | $theString =~ s/<.*?>//gs; | |||||
1297 | 0 | return $theString; | |||||
1298 | } | ||||||
1299 | |||||||
1300 | =head2 startElement | ||||||
1301 | |||||||
1302 | Return a the complement to endElement having the default title control and class labeling. | ||||||
1303 | |||||||
1304 | $valueHash{html} .= $fws->startElement( %dataHash ); | ||||||
1305 | $valueHash{html} .= $fws->endElement( %dataHash ); | ||||||
1306 | |||||||
1307 | If there is no dataHash to pass, you can set its the keys elementClass, title, and disableTitle to control its appearence. | ||||||
1308 | |||||||
1309 | =cut | ||||||
1310 | |||||||
1311 | sub startElement { | ||||||
1312 | 0 | 0 | 1 | my ( $self, %dataHash ) = @_; | |||
1313 | |||||||
1314 | 0 | my $elementClass = $self->formValue( 'FWS_elementClassPrefix' ); | |||||
1315 | 0 | 0 | if ( $dataHash{elementClass} ) { $elementClass = $dataHash{elementClass} } | ||||
0 | |||||||
1316 | |||||||
1317 | # | ||||||
1318 | # start two divs for positioning and backgrounds | ||||||
1319 | # | ||||||
1320 | 0 | my $html = " "; |
|||||
1321 | |||||||
1322 | # | ||||||
1323 | # Title Field/Table | ||||||
1324 | # | ||||||
1325 | 0 | 0 | if ( !$dataHash{disableTitle} ) { | ||||
1326 | 0 | $html .= ""; |
|||||
1327 | 0 | $html .= $self->field( 'title', %dataHash ); | |||||
1328 | 0 | $html .= ""; | |||||
1329 | } | ||||||
1330 | |||||||
1331 | 0 | $html .= " "; |
|||||
1332 | |||||||
1333 | # | ||||||
1334 | # wrap the element | ||||||
1335 | # | ||||||
1336 | 0 | return $html; | |||||
1337 | } | ||||||
1338 | |||||||
1339 | =head2 stateDropDown | ||||||
1340 | |||||||
1341 | Return a dropdown for all US States, passining it (current, class, id, name, style, topOption) TopOption if passed will be the text that is displayed for the option, but the value will be blank. | ||||||
1342 | |||||||
1343 | =cut | ||||||
1344 | |||||||
1345 | sub stateDropDown { | ||||||
1346 | 0 | 0 | 1 | my ( $self, %paramHash ) = @_; | |||
1347 | |||||||
1348 | # | ||||||
1349 | # create a array we will process of states | ||||||
1350 | # | ||||||
1351 | 0 | my @stateArray = ( 'AL', 'Alabama', 'AK', 'Alaska', 'AZ', 'Arizona', 'AR', 'Arkansas', 'CA', 'California', 'CO', 'Colorado', 'CT', 'Connecticut', 'DE', 'Delaware', 'DC', 'District of Columbia', 'FL', 'Florida', 'GA', 'Georgia', 'HI', 'Hawaii', 'ID', 'Idaho', 'IL', 'Illinois', 'IN', 'Indiana', 'IA', 'Iowa', 'KS', 'Kansas', 'KY', 'Kentucky', 'LA', 'Louisiana', 'ME', 'Maine', 'MD', 'Maryland', 'MA', 'Massachusetts', 'MI', 'Michigan', 'MN', 'Minnesota', 'MS', 'Mississippi', 'MO', 'Missouri', 'MT', 'Montana', 'NE', 'Nebraska', 'NV', 'Nevada', 'NH', 'New Hampshire', 'NJ', 'New Jersey', 'NM', 'New Mexico', 'NY', 'New York', 'NC', 'North Carolina', 'ND', 'North Dakota', 'OH', 'Ohio', 'OK', 'Oklahoma', 'OR', 'Oregon', 'PA', 'Pennsylvania', 'RI', 'Rhode Island', 'SC', 'South Carolina', 'SD', 'South Dakota', 'TN', 'Tennessee', 'TX', 'Texas', 'UT', 'Utah', 'VT', 'Vermont', 'VA', 'Virginia', 'WA', 'Washington', 'WV', 'West Virginia', 'WI', 'Wisconsin', 'WY', 'Wyoming'); | |||||
1352 | |||||||
1353 | # | ||||||
1354 | # preformat anything that will be in the html that is passed | ||||||
1355 | # | ||||||
1356 | 0 | 0 | if ( $paramHash{class} ) { $paramHash{class} = 'class="' . $paramHash{class} . '" ' } | ||||
0 | |||||||
1357 | 0 | 0 | if ( $paramHash{style} ) { $paramHash{style} = 'style="' . $paramHash{style} . '" ' } | ||||
0 | |||||||
1358 | 0 | 0 | if ( $paramHash{id} ) { $paramHash{id} = 'id="' . $paramHash{id} . '" ' } | ||||
0 | |||||||
1359 | 0 | 0 | if ( $paramHash{name} ) { $paramHash{name} = 'name="' . $paramHash{name} . '" ' } | ||||
0 | |||||||
1360 | 0 | 0 | if ( $paramHash{topOption} ) { $paramHash{topOption} = '' } | ||||
0 | |||||||
1361 | |||||||
1362 | # | ||||||
1363 | # start off the select with the top opction if present | ||||||
1364 | # | ||||||
1365 | 0 | my $returnHTML = ' | |||||
1366 | |||||||
1367 | # | ||||||
1368 | # loop though the array creating each one, with the selected if the current matches | ||||||
1369 | # | ||||||
1370 | 0 | while ( @stateArray ) { | |||||
1371 | 0 | my $stateAbbr = shift( @stateArray ); | |||||
1372 | 0 | my $stateName = shift( @stateArray ); | |||||
1373 | 0 | $returnHTML .= ' | |||||
1374 | 0 | 0 | if ( $paramHash{current} =~ /$stateAbbr/i ) { $returnHTML .= 'selected="selected" ' } | ||||
0 | |||||||
1375 | 0 | $returnHTML .= 'value="' . $stateAbbr . '">' . $stateName . ''; | |||||
1376 | } | ||||||
1377 | |||||||
1378 | # | ||||||
1379 | # Close the select, and return our HTML for the select | ||||||
1380 | # | ||||||
1381 | 0 | $returnHTML .= ''; | |||||
1382 | 0 | return $returnHTML; | |||||
1383 | } | ||||||
1384 | |||||||
1385 | |||||||
1386 | =head2 SQLDate | ||||||
1387 | |||||||
1388 | Return a date string in SQL format if it was passed ass SQL format already, or convert it if it was sent as mm-dd-yyyy. | ||||||
1389 | |||||||
1390 | my $SQLDate = $fws->SQLDate( '2012-02-03' ); | ||||||
1391 | |||||||
1392 | =cut | ||||||
1393 | |||||||
1394 | sub SQLDate { | ||||||
1395 | #TODO Depricate SQLDate this and make it part of formatDate | ||||||
1396 | 0 | 0 | 1 | my ( $self, $date ) = @_; | |||
1397 | 0 | my @dateSplit = split(/\D/,$date); | |||||
1398 | 0 | 0 | if ( length( $dateSplit[2]) == 4 ) { | ||||
1399 | 0 | $date = $dateSplit[2] . '-' . $dateSplit[0] . '-' . $dateSplit[1]; | |||||
1400 | } | ||||||
1401 | else { | ||||||
1402 | 0 | $date = $dateSplit[0] . '-' . $dateSplit[1] . '-'.$dateSplit[2]; | |||||
1403 | } | ||||||
1404 | 0 | return $self->safeSQL( $date ); | |||||
1405 | } | ||||||
1406 | |||||||
1407 | =head2 truncateContent | ||||||
1408 | |||||||
1409 | Return content based on nearest ended word to the length parameter. | ||||||
1410 | |||||||
1411 | print $fws->truncateContent( | ||||||
1412 | content => 'this is some long content I want just a preview of.', | ||||||
1413 | length => 10, | ||||||
1414 | postText => '...', | ||||||
1415 | ); | ||||||
1416 | |||||||
1417 | =cut | ||||||
1418 | |||||||
1419 | |||||||
1420 | |||||||
1421 | sub truncateContent { | ||||||
1422 | 0 | 0 | 1 | my ( $self, %paramHash ) = @_; | |||
1423 | |||||||
1424 | # | ||||||
1425 | # add a space to make the logic easier, we will eat this after the fact if its still sitting around | ||||||
1426 | # | ||||||
1427 | 0 | $paramHash{content} .= ' '; | |||||
1428 | 0 | my @charArray = split( //, $paramHash{content} ); | |||||
1429 | 0 | my $count = 0; | |||||
1430 | 0 | my $newString; | |||||
1431 | my $currentWord; | ||||||
1432 | |||||||
1433 | # | ||||||
1434 | # loop though the array, adding to the newstring if there is a friendly space | ||||||
1435 | # | ||||||
1436 | 0 | while ( @charArray ) { | |||||
1437 | 0 | $count++; | |||||
1438 | 0 | my $currentChar = shift( @charArray ); | |||||
1439 | 0 | 0 | if ( $count < $paramHash{length} ) { | ||||
1440 | 0 | $currentWord .= $currentChar; | |||||
1441 | 0 | 0 | if ( $currentChar eq ' ' ) { | ||||
1442 | 0 | $newString .= $currentWord; | |||||
1443 | 0 | $currentWord = ''; | |||||
1444 | } | ||||||
1445 | } | ||||||
1446 | } | ||||||
1447 | |||||||
1448 | # | ||||||
1449 | # if there is no friendly spaces, just chop at the maxLength | ||||||
1450 | # | ||||||
1451 | 0 | 0 | if ( $newString eq '' ) { | ||||
1452 | 0 | $newString = substr( $paramHash{content}, 0, $paramHash{length} ); | |||||
1453 | } | ||||||
1454 | |||||||
1455 | # | ||||||
1456 | # eat the post space if there is any. | ||||||
1457 | # | ||||||
1458 | 0 | $newString =~ s/\s+$//sg; | |||||
1459 | |||||||
1460 | # | ||||||
1461 | # add posttext if there is a chop | ||||||
1462 | # | ||||||
1463 | 0 | 0 | if ( $paramHash{content} ne $newString ) { $newString .= $paramHash{postText} } | ||||
0 | |||||||
1464 | |||||||
1465 | # | ||||||
1466 | # return our newly created pontentialy shorter string | ||||||
1467 | # | ||||||
1468 | 0 | return $newString; | |||||
1469 | } | ||||||
1470 | |||||||
1471 | |||||||
1472 | =head2 urlEncode | ||||||
1473 | |||||||
1474 | Encode a string to make it browser url friendly. | ||||||
1475 | |||||||
1476 | print $fws->urlEncode( $someString ); | ||||||
1477 | |||||||
1478 | =cut | ||||||
1479 | |||||||
1480 | sub urlEncode { | ||||||
1481 | 0 | 0 | 1 | my ( $self, $url ) = @_; | |||
1482 | 0 | $url =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg; | |||||
0 | |||||||
1483 | 0 | return $url; | |||||
1484 | } | ||||||
1485 | |||||||
1486 | =head2 urlDecode | ||||||
1487 | |||||||
1488 | Decode a string to make it potentially browser url unfriendly. | ||||||
1489 | |||||||
1490 | print $fws->urlEncode( $someString ); | ||||||
1491 | |||||||
1492 | =cut | ||||||
1493 | |||||||
1494 | sub urlDecode { | ||||||
1495 | 0 | 0 | 1 | my ( $self, $url ) = @_; | |||
1496 | 0 | $url =~ s/\+/ /sg; | |||||
1497 | 0 | $url =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; | |||||
0 | |||||||
1498 | 0 | return $url; | |||||
1499 | } | ||||||
1500 | |||||||
1501 | |||||||
1502 | =head2 endElement | ||||||
1503 | |||||||
1504 | Return the complement to startElement() having the default by placing the appropriate close divs created in startElement(). | ||||||
1505 | |||||||
1506 | $valueHash{html} .= $fws->startElement( %dataHash ); | ||||||
1507 | $valueHash{html} .= $fws->endElement( %dataHash ); | ||||||
1508 | |||||||
1509 | =cut | ||||||
1510 | |||||||
1511 | sub endElement { | ||||||
1512 | 0 | 0 | 1 | my ( $self ) = @_; | |||
1513 | 0 | return ""; | |||||
1514 | } | ||||||
1515 | |||||||
1516 | |||||||
1517 | =head2 convertUnicode | ||||||
1518 | |||||||
1519 | Convert from unicode charcters from web services to a standard character. | ||||||
1520 | |||||||
1521 | =cut | ||||||
1522 | |||||||
1523 | sub convertUnicode { | ||||||
1524 | 0 | 0 | 1 | my ( $self, $conversionString ) = @_; | |||
1525 | 0 | $conversionString =~ s/((?:\A|\G|[^\\]))\\u([\da-fA-F]{4})/$1.hex2chr($2)/gse; | |||||
0 | |||||||
1526 | 0 | return $conversionString; | |||||
1527 | } | ||||||
1528 | |||||||
1529 | |||||||
1530 | =head2 hex2chr | ||||||
1531 | |||||||
1532 | Convert hex to its ascii character. | ||||||
1533 | |||||||
1534 | =cut | ||||||
1535 | |||||||
1536 | sub hex2chr { | ||||||
1537 | 0 | 0 | 1 | my( $hex ) = @_; | |||
1538 | 0 | 0 | 0 | if ( hex( $hex ) >= 0 and hex( $hex ) < 65536) { return ( chr( hex( $hex ) ) ); } | |||
0 | |||||||
1539 | } | ||||||
1540 | |||||||
1541 | |||||||
1542 | sub _jsEnable { | ||||||
1543 | 0 | 0 | my ( $self, $jsEnable, $modifier ) = @_; | ||||
1544 | |||||||
1545 | # | ||||||
1546 | # get the current hash | ||||||
1547 | # | ||||||
1548 | 0 | my %jsHash = %{$self->{_jsHash}}; | |||||
0 | |||||||
1549 | |||||||
1550 | # | ||||||
1551 | # always add one to modifier to its never 0 | ||||||
1552 | # | ||||||
1553 | 0 | $modifier++; | |||||
1554 | |||||||
1555 | # | ||||||
1556 | # set the number to at least one | ||||||
1557 | # | ||||||
1558 | |||||||
1559 | # | ||||||
1560 | # if its already there lets just leave it alone | ||||||
1561 | # | ||||||
1562 | 0 | 0 | if ( !$jsHash{$jsEnable} ) { $jsHash{$jsEnable} = ( keys %jsHash ) + $modifier } | ||||
0 | |||||||
1563 | |||||||
1564 | # | ||||||
1565 | # pass the new hash back into the jsHash | ||||||
1566 | # | ||||||
1567 | 0 | %{$self->{_jsHash}} = %jsHash; | |||||
0 | |||||||
1568 | |||||||
1569 | 0 | return %jsHash; | |||||
1570 | } | ||||||
1571 | |||||||
1572 | |||||||
1573 | sub _cssEnable { | ||||||
1574 | 0 | 0 | my ( $self, $cssEnable, $modifier ) = @_; | ||||
1575 | |||||||
1576 | # | ||||||
1577 | # get the current hash | ||||||
1578 | # | ||||||
1579 | 0 | my %cssHash = %{$self->{_cssHash}}; | |||||
0 | |||||||
1580 | |||||||
1581 | # | ||||||
1582 | # always add one to modifier to its never 0 | ||||||
1583 | # | ||||||
1584 | 0 | $modifier++; | |||||
1585 | |||||||
1586 | # | ||||||
1587 | # if its already there lets just leave it alone | ||||||
1588 | # | ||||||
1589 | 0 | 0 | if ( !$cssHash{$cssEnable} ) { $cssHash{$cssEnable} = ( keys %cssHash ) + $modifier } | ||||
0 | |||||||
1590 | |||||||
1591 | # | ||||||
1592 | # pass the new hash back into the cssHash | ||||||
1593 | # | ||||||
1594 | 0 | %{$self->{_cssHash}} = %cssHash; | |||||
0 | |||||||
1595 | |||||||
1596 | 0 | return %cssHash; | |||||
1597 | } | ||||||
1598 | |||||||
1599 | |||||||
1600 | sub _minCSS { | ||||||
1601 | 0 | 0 | my ( $self ) = @_; | ||||
1602 | # | ||||||
1603 | # when showing pre-installation screens this is the CSS that will make login's and panels show up correctly | ||||||
1604 | # this is only used for adminLogin and for fws_systemInfo | ||||||
1605 | # | ||||||
1606 | 0 | return ''; | |||||
1633 | |||||||
1634 | } | ||||||
1635 | |||||||
1636 | |||||||
1637 | =head1 AUTHOR | ||||||
1638 | |||||||
1639 | Nate Lewis, C<< |
||||||
1640 | |||||||
1641 | =head1 BUGS | ||||||
1642 | |||||||
1643 | Please report any bugs or feature requests to C |
||||||
1644 | the web interface at L |
||||||
1645 | automatically be notified of progress on your bug as I make changes. | ||||||
1646 | |||||||
1647 | |||||||
1648 | |||||||
1649 | |||||||
1650 | =head1 SUPPORT | ||||||
1651 | |||||||
1652 | You can find documentation for this module with the perldoc command. | ||||||
1653 | |||||||
1654 | perldoc FWS::V2::Format | ||||||
1655 | |||||||
1656 | |||||||
1657 | You can also look for information at: | ||||||
1658 | |||||||
1659 | =over 4 | ||||||
1660 | |||||||
1661 | =item * RT: CPAN's request tracker (report bugs here) | ||||||
1662 | |||||||
1663 | L |
||||||
1664 | |||||||
1665 | =item * AnnoCPAN: Annotated CPAN documentation | ||||||
1666 | |||||||
1667 | L |
||||||
1668 | |||||||
1669 | =item * CPAN Ratings | ||||||
1670 | |||||||
1671 | L |
||||||
1672 | |||||||
1673 | =item * Search CPAN | ||||||
1674 | |||||||
1675 | L |
||||||
1676 | |||||||
1677 | =back | ||||||
1678 | |||||||
1679 | |||||||
1680 | =head1 LICENSE AND COPYRIGHT | ||||||
1681 | |||||||
1682 | Copyright 2013 Nate Lewis. | ||||||
1683 | |||||||
1684 | This program is free software; you can redistribute it and/or modify it | ||||||
1685 | under the terms of either: the GNU General Public License as published | ||||||
1686 | by the Free Software Foundation; or the Artistic License. | ||||||
1687 | |||||||
1688 | See http://dev.perl.org/licenses/ for more information. | ||||||
1689 | |||||||
1690 | |||||||
1691 | =cut | ||||||
1692 | |||||||
1693 | 1; # End of FWS::V2::Format |