File Coverage

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 .= "" . $paramHash{value} . "";
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, or through
1644             the web interface at L. I will be notified, and then you'll
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