1------------------------------------------------------------------------------ 2-- Templates Parser -- 3-- -- 4-- Copyright (C) 2003-2013, AdaCore -- 5-- -- 6-- This library is free software; you can redistribute it and/or modify -- 7-- it under terms of the GNU General Public License as published by the -- 8-- Free Software Foundation; either version 3, or (at your option) any -- 9-- later version. This library is distributed in the hope that it will be -- 10-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of -- 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12-- -- 13-- As a special exception under Section 7 of GPL version 3, you are -- 14-- granted additional permissions described in the GCC Runtime Library -- 15-- Exception, version 3.1, as published by the Free Software Foundation. -- 16-- -- 17-- You should have received a copy of the GNU General Public License and -- 18-- a copy of the GCC Runtime Library Exception along with this program; -- 19-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20-- <http://www.gnu.org/licenses/>. -- 21-- -- 22-- As a special exception, if other files instantiate generics from this -- 23-- unit, or you link this unit with other files to produce an executable, -- 24-- this unit does not by itself cause the resulting executable to be -- 25-- covered by the GNU General Public License. This exception does not -- 26-- however invalidate any other reasons why the executable file might be -- 27-- covered by the GNU Public License. -- 28------------------------------------------------------------------------------ 29 30pragma Ada_2012; 31 32pragma Wide_Character_Encoding (Brackets); 33 34with Ada.Containers.Indefinite_Hashed_Maps; 35with Ada.Strings.Fixed; 36with Ada.Strings.Hash; 37 38with Templates_Parser.Configuration; 39with Templates_Parser.Utils; 40 41separate (Templates_Parser) 42package body Filter is 43 44 -- User's defined filter 45 46 package Filter_Map is 47 new Containers.Indefinite_Hashed_Maps 48 (String, User_CB, Strings.Hash, "=", "="); 49 50 User_Filters : Filter_Map.Map; 51 52 -- Filter tokens 53 54 Multiply_Token : aliased constant String := """*"""; 55 Plus_Token : aliased constant String := """+"""; 56 Minus_Token : aliased constant String := """-"""; 57 Divide_Token : aliased constant String := """/"""; 58 Abs_Token : aliased constant String := "ABS"; 59 Add_Token : aliased constant String := "ADD"; 60 Add_Param_Token : aliased constant String := "ADD_PARAM"; 61 BR_2_EOL_Token : aliased constant String := "BR_2_EOL"; 62 BR_2_LF_Token : aliased constant String := "BR_2_LF"; 63 Capitalize_Token : aliased constant String := "CAPITALIZE"; 64 Clean_Text_Token : aliased constant String := "CLEAN_TEXT"; 65 Coma_2_Point_Token : aliased constant String := "COMA_2_POINT"; 66 Contract_Token : aliased constant String := "CONTRACT"; 67 Del_Param_Token : aliased constant String := "DEL_PARAM"; 68 Div_Token : aliased constant String := "DIV"; 69 Exist_Token : aliased constant String := "EXIST"; 70 File_Exists_Token : aliased constant String := "FILE_EXISTS"; 71 Format_Date_Token : aliased constant String := "FORMAT_DATE"; 72 Format_Number_Token : aliased constant String := "FORMAT_NUMBER"; 73 Is_Empty_Token : aliased constant String := "IS_EMPTY"; 74 LF_2_BR_Token : aliased constant String := "LF_2_BR"; 75 Lower_Token : aliased constant String := "LOWER"; 76 Match_Token : aliased constant String := "MATCH"; 77 Max_Token : aliased constant String := "MAX"; 78 Min_Token : aliased constant String := "MIN"; 79 Modulo_Token : aliased constant String := "MOD"; 80 Mult_Token : aliased constant String := "MULT"; 81 Neg_Token : aliased constant String := "NEG"; 82 No_Digit_Token : aliased constant String := "NO_DIGIT"; 83 No_Dynamic_Token : aliased constant String := "NO_DYNAMIC"; 84 No_Letter_Token : aliased constant String := "NO_LETTER"; 85 No_Space_Token : aliased constant String := "NO_SPACE"; 86 Oui_Non_Token : aliased constant String := "OUI_NON"; 87 Point_2_Coma_Token : aliased constant String := "POINT_2_COMA"; 88 Repeat_Token : aliased constant String := "REPEAT"; 89 Replace_Token : aliased constant String := "REPLACE"; 90 Replace_All_Token : aliased constant String := "REPLACE_ALL"; 91 Replace_Param_Token : aliased constant String := "REPLACE_PARAM"; 92 Reverse_Token : aliased constant String := "REVERSE"; 93 Size_Token : aliased constant String := "SIZE"; 94 Slice_Token : aliased constant String := "SLICE"; 95 Sub_Token : aliased constant String := "SUB"; 96 Trim_Token : aliased constant String := "TRIM"; 97 Upper_Token : aliased constant String := "UPPER"; 98 User_Defined_Token : aliased constant String := "USER_DEFINED"; 99 Web_Encode_Token : aliased constant String := "WEB_ENCODE"; 100 Web_Escape_Token : aliased constant String := "WEB_ESCAPE"; 101 Web_NBSP_Token : aliased constant String := "WEB_NBSP"; 102 Wrap_Token : aliased constant String := "WRAP"; 103 Yes_No_Token : aliased constant String := "YES_NO"; 104 105 -- Filters Table 106 107 Table : constant array (Mode) of Filter_Record 108 := (Multiply => 109 (Multiply_Token'Access, Multiply'Access), 110 111 Plus => 112 (Plus_Token'Access, Plus'Access), 113 114 Minus => 115 (Minus_Token'Access, Minus'Access), 116 117 Divide => 118 (Divide_Token'Access, Divide'Access), 119 120 Absolute => 121 (Abs_Token'Access, Absolute'Access), 122 123 Add => 124 (Add_Token'Access, Plus'Access), 125 126 Add_Param => 127 (Add_Param_Token'Access, Add_Param'Access), 128 129 BR_2_EOL => 130 (BR_2_EOL_Token'Access, BR_2_EOL'Access), 131 132 BR_2_LF => 133 (BR_2_LF_Token'Access, BR_2_LF'Access), 134 135 Capitalize => 136 (Capitalize_Token'Access, Capitalize'Access), 137 138 Clean_Text => 139 (Clean_Text_Token'Access, Clean_Text'Access), 140 141 Coma_2_Point => 142 (Coma_2_Point_Token'Access, Coma_2_Point'Access), 143 144 Contract => 145 (Contract_Token'Access, Contract'Access), 146 147 Del_Param => 148 (Del_Param_Token'Access, Del_Param'Access), 149 150 Div => 151 (Div_Token'Access, Divide'Access), 152 153 Exist => 154 (Exist_Token'Access, Exist'Access), 155 156 File_Exists => 157 (File_Exists_Token'Access, File_Exists'Access), 158 159 Format_Date => 160 (Format_Date_Token'Access, Format_Date'Access), 161 162 Format_Number => 163 (Format_Number_Token'Access, Format_Number'Access), 164 165 Is_Empty => 166 (Is_Empty_Token'Access, Is_Empty'Access), 167 168 LF_2_BR => 169 (LF_2_BR_Token'Access, LF_2_BR'Access), 170 171 Lower => 172 (Lower_Token'Access, Lower'Access), 173 174 Match => 175 (Match_Token'Access, Match'Access), 176 177 Max => 178 (Max_Token'Access, Max'Access), 179 180 Min => 181 (Min_Token'Access, Min'Access), 182 183 Modulo => 184 (Modulo_Token'Access, Modulo'Access), 185 186 Mult => 187 (Mult_Token'Access, Multiply'Access), 188 189 Neg => 190 (Neg_Token'Access, Neg'Access), 191 192 No_Digit => 193 (No_Digit_Token'Access, No_Digit'Access), 194 195 No_Dynamic => 196 (No_Dynamic_Token'Access, No_Dynamic'Access), 197 198 No_Letter => 199 (No_Letter_Token'Access, No_Letter'Access), 200 201 No_Space => 202 (No_Space_Token'Access, No_Space'Access), 203 204 Oui_Non => 205 (Oui_Non_Token'Access, Oui_Non'Access), 206 207 Point_2_Coma => 208 (Point_2_Coma_Token'Access, Point_2_Coma'Access), 209 210 Repeat => 211 (Repeat_Token'Access, Repeat'Access), 212 213 Replace => 214 (Replace_Token'Access, Replace'Access), 215 216 Replace_All => 217 (Replace_All_Token'Access, Replace_All'Access), 218 219 Replace_Param => 220 (Replace_Param_Token'Access, Replace_Param'Access), 221 222 Invert => 223 (Reverse_Token'Access, Reverse_Data'Access), 224 225 Size => 226 (Size_Token'Access, Size'Access), 227 228 Slice => 229 (Slice_Token'Access, Slice'Access), 230 231 Sub => 232 (Sub_Token'Access, Minus'Access), 233 234 Trim => 235 (Trim_Token'Access, Trim'Access), 236 237 Upper => 238 (Upper_Token'Access, Upper'Access), 239 240 User_Defined => 241 (User_Defined_Token'Access, User_Defined'Access), 242 243 Web_Encode => 244 (Web_Encode_Token'Access, Web_Encode'Access), 245 246 Web_Escape => 247 (Web_Escape_Token'Access, Web_Escape'Access), 248 249 Web_NBSP => 250 (Web_NBSP_Token'Access, Web_NBSP'Access), 251 252 Wrap => 253 (Wrap_Token'Access, Wrap'Access), 254 255 Yes_No => 256 (Yes_No_Token'Access, Yes_No'Access) 257 ); 258 259 function Replace_One_Or_All 260 (S : String; 261 P : Parameter_Data; 262 T : Translate_Set; 263 I : Parameter_Set; 264 One : Boolean) return String; 265 -- Routine used to implement the REPLACE (One set to True) and REPLACE_ALL 266 -- filters. 267 268 function Value 269 (Str : String; 270 Translations : Translate_Set; 271 I_Params : Parameter_Set) return String; 272 -- Returns the value for Str, or if Str is a tag, returns it's value 273 274 function BR_2_EOL (S : String; EOL : String) return String; 275 -- Returns a string where all occurences of <BR> HTML tag have been 276 -- replaced by EOL, assuming EOL is "LF", "CR", "LFCR" or "CRLF". 277 278 -------------- 279 -- Absolute -- 280 -------------- 281 282 function Absolute 283 (S : String; 284 C : not null access Filter_Context; 285 P : Parameter_Data := No_Parameter) return String 286 is 287 pragma Unreferenced (C); 288 begin 289 Check_Null_Parameter (P); 290 291 if S = "" or else not Is_Number (S) then 292 return ""; 293 else 294 return Utils.Image (abs Integer'Value (S)); 295 end if; 296 end Absolute; 297 298 --------------- 299 -- Add_Param -- 300 --------------- 301 302 function Add_Param 303 (S : String; 304 C : not null access Filter_Context; 305 P : Parameter_Data := No_Parameter) return String 306 is 307 function Get (Str : String) return String with Inline; 308 -- Returns the parameter key=value to be added 309 310 --------- 311 -- Get -- 312 --------- 313 314 function Get (Str : String) return String is 315 P : constant Natural := Strings.Fixed.Index (Str, "="); 316 begin 317 if P = 0 then 318 return Str; 319 else 320 return Str (Str'First .. P) 321 & Value (Str (P + 1 .. Str'Last), 322 C.Translations, C.I_Parameters); 323 end if; 324 end Get; 325 326 Param : constant String := Get (To_String (P.S)); 327 328 begin 329 if Strings.Fixed.Index (S, "?") = 0 then 330 -- No parameter yet 331 return S & '?' & Param; 332 333 elsif S (S'Last) = '?' or else S (S'Last) = '&' then 334 return S & Param; 335 336 else 337 return S & '&' & Param; 338 end if; 339 end Add_Param; 340 341 -------------- 342 -- BR_2_EOL -- 343 -------------- 344 345 function BR_2_EOL (S : String; EOL : String) return String is 346 Result : String (S'Range); 347 K : Positive := Result'First; 348 J : Positive := S'First; 349 begin 350 if S = "" then 351 return ""; 352 end if; 353 354 loop 355 if S (J) = '<' 356 and then J + 3 <= S'Last 357 and then Characters.Handling.To_Lower (S (J .. J + 2)) = "<br" 358 and then 359 (S (J + 3) = '>' 360 or else (J + 4 <= S'Last and then S (J + 3 .. J + 4) = "/>")) 361 then 362 Result (K .. K + EOL'Length - 1) := EOL; 363 K := K + EOL'Length; 364 if S (J + 3) = '>' then 365 J := J + 4; 366 else 367 J := J + 5; 368 end if; 369 else 370 Result (K) := S (J); 371 K := K + 1; 372 J := J + 1; 373 end if; 374 375 exit when J > S'Last; 376 end loop; 377 378 return Result (Result'First .. K - 1); 379 end BR_2_EOL; 380 381 function BR_2_EOL 382 (S : String; 383 C : not null access Filter_Context; 384 P : Parameter_Data := No_Parameter) return String 385 is 386 pragma Unreferenced (C); 387 V_Str : constant String := To_String (P.S); 388 EOL : String (1 .. V_Str'Length / 2); 389 begin 390 if V_Str = "LF" then 391 EOL (EOL'First) := ASCII.LF; 392 elsif V_Str = "CRLF" then 393 EOL := ASCII.CR & ASCII.LF; 394 elsif V_Str = "CR" then 395 EOL (EOL'First) := ASCII.CR; 396 elsif V_Str = "LFCR" then 397 EOL := ASCII.LF & ASCII.CR; 398 else 399 raise Template_Error with "unknown parameter for BR_2_EOL filter"; 400 end if; 401 402 return BR_2_EOL (S, EOL); 403 end BR_2_EOL; 404 405 ------------- 406 -- BR_2_LF -- 407 ------------- 408 409 function BR_2_LF 410 (S : String; 411 C : not null access Filter_Context; 412 P : Parameter_Data := No_Parameter) return String 413 is 414 pragma Unreferenced (C); 415 begin 416 Check_Null_Parameter (P); 417 418 return BR_2_EOL (S, String'(1 => ASCII.LF)); 419 end BR_2_LF; 420 421 ---------------- 422 -- Capitalize -- 423 ---------------- 424 425 function Capitalize 426 (S : String; 427 C : not null access Filter_Context; 428 P : Parameter_Data := No_Parameter) return String 429 is 430 pragma Unreferenced (C); 431 Result : String (S'Range); 432 Upper : Boolean := True; 433 begin 434 Check_Null_Parameter (P); 435 436 for K in Result'Range loop 437 if Upper then 438 Result (K) := Characters.Handling.To_Upper (S (K)); 439 Upper := False; 440 else 441 Result (K) := Characters.Handling.To_Lower (S (K)); 442 if Result (K) = ' ' or else Result (K) = '_' then 443 Upper := True; 444 end if; 445 end if; 446 end loop; 447 return Result; 448 end Capitalize; 449 450 -------------------------- 451 -- Check_Null_Parameter -- 452 -------------------------- 453 454 procedure Check_Null_Parameter (P : Parameter_Data) is 455 begin 456 if P /= No_Parameter then 457 raise Template_Error with "no parameter allowed in this filter"; 458 end if; 459 end Check_Null_Parameter; 460 461 ---------------- 462 -- Clean_Text -- 463 ---------------- 464 465 function Clean_Text 466 (S : String; 467 C : not null access Filter_Context; 468 P : Parameter_Data := No_Parameter) return String 469 is 470 pragma Unreferenced (C); 471 use type Strings.Maps.Character_Set; 472 473 Result : String (S'Range); 474 475 Clean_Set : constant Strings.Maps.Character_Set := 476 Strings.Maps.Constants.Letter_Set 477 or Strings.Maps.Constants.Decimal_Digit_Set 478 or Strings.Maps.To_Set (" ��������"); 479 480 begin 481 Check_Null_Parameter (P); 482 483 for K in S'Range loop 484 if Strings.Maps.Is_In (S (K), Clean_Set) then 485 Result (K) := S (K); 486 else 487 Result (K) := ' '; 488 end if; 489 end loop; 490 return Result; 491 end Clean_Text; 492 493 ------------------ 494 -- Coma_2_Point -- 495 ------------------ 496 497 function Coma_2_Point 498 (S : String; 499 C : not null access Filter_Context; 500 P : Parameter_Data := No_Parameter) return String 501 is 502 pragma Unreferenced (C); 503 Result : String := S; 504 begin 505 Check_Null_Parameter (P); 506 507 for K in Result'Range loop 508 if Result (K) = ',' then 509 Result (K) := '.'; 510 end if; 511 end loop; 512 513 return Result; 514 end Coma_2_Point; 515 516 -------------- 517 -- Contract -- 518 -------------- 519 520 function Contract 521 (S : String; 522 C : not null access Filter_Context; 523 P : Parameter_Data := No_Parameter) return String 524 is 525 pragma Unreferenced (C); 526 use type Strings.Maps.Character_Set; 527 528 Result : String (S'Range); 529 R : Natural := 0; 530 Space : Boolean := False; 531 532 begin 533 Check_Null_Parameter (P); 534 535 for K in S'Range loop 536 537 if S (K) = ' ' then 538 539 if Space = False then 540 Space := True; 541 542 R := R + 1; 543 Result (R) := ' '; 544 end if; 545 546 else 547 Space := False; 548 549 R := R + 1; 550 Result (R) := S (K); 551 end if; 552 553 end loop; 554 555 if R = 0 then 556 return ""; 557 else 558 return Result (Result'First .. R); 559 end if; 560 end Contract; 561 562 --------------- 563 -- Del_Param -- 564 --------------- 565 566 function Del_Param 567 (S : String; 568 C : not null access Filter_Context; 569 P : Parameter_Data := No_Parameter) return String 570 is 571 pragma Unreferenced (C); 572 Param : constant String := To_String (P.S); 573 E : constant Natural := Strings.Fixed.Index (S, "?"); 574 Len : constant Natural := Param'Length; 575 576 begin 577 if E = 0 then 578 -- No parameter, return original string 579 return S; 580 581 else 582 declare 583 Pos : constant Natural := Strings.Fixed.Index (S, Param); 584 First, Last : Natural; 585 begin 586 if Pos < E 587 or else 588 (Pos + Len <= S'Last 589 and then S (Pos + Len) /= '=' 590 and then S (Pos + Len) /= '&') 591 then 592 -- The parameter is not present, return original string 593 return S; 594 595 else 596 First := Pos; 597 Last := Pos; 598 599 while Last < S'Last and then S (Last) /= '&' loop 600 Last := Last + 1; 601 end loop; 602 603 if Last = S'Last then 604 -- This is the last parameter, remove the parameter with 605 -- leading parameter separator (? or &) 606 First := Pos - 1; 607 end if; 608 609 return S (S'First .. First - 1) & S (Last + 1 .. S'Last); 610 end if; 611 end; 612 end if; 613 end Del_Param; 614 615 ------------ 616 -- Divide -- 617 ------------ 618 619 function Divide 620 (S : String; 621 C : not null access Filter_Context; 622 P : Parameter_Data := No_Parameter) return String 623 is 624 N, V : Integer; 625 begin 626 declare 627 V_Str : constant String := To_String (P.S); 628 begin 629 if Is_Number (V_Str) then 630 N := Integer'Value (V_Str); 631 else 632 N := Integer'Value (Value (V_Str, C.Translations, C.I_Parameters)); 633 end if; 634 exception 635 when Constraint_Error => 636 raise Template_Error with """/"" filter parameter error"; 637 end; 638 639 begin 640 V := Integer'Value (S); 641 return Utils.Image (V / N); 642 exception 643 when others => 644 return ""; 645 end; 646 end Divide; 647 648 ----------- 649 -- Exist -- 650 ----------- 651 652 function Exist 653 (S : String; 654 C : not null access Filter_Context; 655 P : Parameter_Data := No_Parameter) return String 656 is 657 pragma Unreferenced (C); 658 begin 659 Check_Null_Parameter (P); 660 661 if S /= "" then 662 return "TRUE"; 663 else 664 return "FALSE"; 665 end if; 666 end Exist; 667 668 ----------------- 669 -- File_Exists -- 670 ----------------- 671 672 function File_Exists 673 (S : String; 674 C : not null access Filter_Context; 675 P : Parameter_Data := No_Parameter) return String 676 is 677 pragma Unreferenced (C); 678 begin 679 Check_Null_Parameter (P); 680 681 if Configuration.Is_Regular_File (S) then 682 return "TRUE"; 683 else 684 return "FALSE"; 685 end if; 686 end File_Exists; 687 688 ----------------- 689 -- Format_Date -- 690 ----------------- 691 692 function Format_Date 693 (S : String; 694 C : not null access Filter_Context; 695 P : Parameter_Data := No_Parameter) return String 696 is 697 Date_Only : constant := 10; 698 Date_Time : constant := 19; 699 Param : constant GNAT.Calendar.Time_IO.Picture_String := 700 GNAT.Calendar.Time_IO.Picture_String 701 (Value (To_String (P.S), 702 C.Translations, C.I_Parameters)); 703 F : constant Positive := S'First; 704 705 Year : Calendar.Year_Number; 706 Month : Calendar.Month_Number; 707 Day : Calendar.Day_Number; 708 Hour : GNAT.Calendar.Hour_Number := 0; 709 Minute : GNAT.Calendar.Minute_Number := 0; 710 Second : GNAT.Calendar.Second_Number := 0; 711 Time : Calendar.Time; 712 begin 713 if S'Length >= Date_Only then 714 Year := Calendar.Year_Number'Value (S (F .. F + 3)); 715 Month := Calendar.Month_Number'Value (S (F + 5 .. F + 6)); 716 Day := Calendar.Day_Number'Value (S (F + 8 .. F + 9)); 717 718 if S (F + 4) /= '-' or else S (F + 7) /= '-' then 719 return S; 720 end if; 721 722 else 723 return S; 724 end if; 725 726 if S'Length = Date_Time then 727 Hour := GNAT.Calendar.Hour_Number'Value (S (F + 11 .. F + 12)); 728 Minute := GNAT.Calendar.Minute_Number'Value (S (F + 14 .. F + 15)); 729 Second := GNAT.Calendar.Second_Number'Value (S (F + 17 .. F + 18)); 730 731 if S (F + 13) /= ':' or else S (F + 16) /= ':' then 732 return S; 733 end if; 734 end if; 735 736 Time := GNAT.Calendar.Time_Of (Year, Month, Day, Hour, Minute, Second); 737 738 return GNAT.Calendar.Time_IO.Image (Time, Param); 739 end Format_Date; 740 741 ------------------- 742 -- Format_Number -- 743 ------------------- 744 745 function Format_Number 746 (S : String; 747 C : not null access Filter_Context; 748 P : Parameter_Data := No_Parameter) return String 749 is 750 TS : constant String := Strings.Fixed.Trim (S, Both); 751 Separator : Character := ' '; 752 753 function Is_Number return Boolean; 754 -- Returns true if S is a number 755 756 Point : Natural := 0; 757 758 --------------- 759 -- Is_Number -- 760 --------------- 761 762 function Is_Number return Boolean is 763 begin 764 for K in TS'Range loop 765 if TS (K) = '.' then 766 Point := K; 767 768 elsif not Characters.Handling.Is_Digit (TS (K)) then 769 return False; 770 end if; 771 end loop; 772 773 return True; 774 end Is_Number; 775 776 Result : String (1 .. TS'Length * 2); 777 K : Natural := Result'Last; 778 779 N : Natural; 780 Count : Natural := 0; 781 782 begin 783 if P.Mode = Str then 784 declare 785 Param : constant String := 786 Value (To_String (P.S), C.Translations, C.I_Parameters); 787 begin 788 Separator := Param (Param'First); 789 end; 790 end if; 791 792 if Is_Number then 793 794 if Point = 0 then 795 N := TS'Last; 796 else 797 N := Point - 1; 798 end if; 799 800 for P in reverse TS'First .. N loop 801 Result (K) := TS (P); 802 K := K - 1; 803 Count := Count + 1; 804 805 if Count mod 3 = 0 and then P /= TS'First then 806 Result (K) := Separator; 807 K := K - 1; 808 end if; 809 end loop; 810 811 if Point = 0 then 812 return Result (K + 1 .. Result'Last); 813 814 else 815 return Result (K + 1 .. Result'Last) & TS (Point .. TS'Last); 816 end if; 817 818 else 819 return S; 820 end if; 821 end Format_Number; 822 823 ------------------ 824 -- Free_Filters -- 825 ------------------ 826 827 procedure Free_Filters is 828 procedure Unchecked_Free is new Ada.Unchecked_Deallocation 829 (User_Filter'Class, User_Filter_Access); 830 C : Filter_Map.Cursor := Filter_Map.First (User_Filters); 831 U : User_CB; 832 begin 833 while Filter_Map.Has_Element (C) loop 834 if Filter_Map.Element (C).Typ = As_Tagged then 835 U := Filter_Map.Element (C); 836 Unchecked_Free (U.CBT); 837 end if; 838 Filter_Map.Next (C); 839 end loop; 840 Filter_Map.Clear (User_Filters); 841 end Free_Filters; 842 843 ------------ 844 -- Handle -- 845 ------------ 846 847 function Handle (Name : String) return Callback is 848 Mode : constant Filter.Mode := Mode_Value (Name); 849 begin 850 return Table (Mode).Handle; 851 end Handle; 852 853 function Handle (Mode : Filter.Mode) return Callback is 854 begin 855 return Table (Mode).Handle; 856 end Handle; 857 858 ----------- 859 -- Image -- 860 ----------- 861 862 function Image (P : Parameter_Data) return String is 863 begin 864 if P = No_Parameter then 865 return ""; 866 867 else 868 case P.Mode is 869 when Str => return '(' & To_String (P.S) & ')'; 870 when Regexp => return '(' & To_String (P.R_Str) & ')'; 871 when Regpat => return 872 '(' & To_String (P.P_Str) & '/' & To_String (P.Param) & ')'; 873 when Slice => 874 return '(' & Utils.Image (P.First) 875 & " .. " & Utils.Image (P.Last) & ')'; 876 when User_Callback => 877 return '(' & To_String (P.P) & ')'; 878 end case; 879 end if; 880 end Image; 881 882 -------------- 883 -- Is_Empty -- 884 -------------- 885 886 function Is_Empty 887 (S : String; 888 C : not null access Filter_Context; 889 P : Parameter_Data := No_Parameter) return String 890 is 891 pragma Unreferenced (C); 892 begin 893 Check_Null_Parameter (P); 894 895 if S = "" then 896 return "TRUE"; 897 else 898 return "FALSE"; 899 end if; 900 end Is_Empty; 901 902 ------------------- 903 -- Is_No_Dynamic -- 904 ------------------- 905 906 function Is_No_Dynamic (Filters : Set_Access) return Boolean is 907 begin 908 return Filters /= null 909 and then Filters (Filters'First).Handle = No_Dynamic'Access; 910 end Is_No_Dynamic; 911 912 ------------- 913 -- LF_2_BR -- 914 ------------- 915 916 function LF_2_BR 917 (S : String; 918 C : not null access Filter_Context; 919 P : Parameter_Data := No_Parameter) return String 920 is 921 pragma Unreferenced (C); 922 N : constant Natural 923 := Fixed.Count (S, Strings.Maps.To_Set (ASCII.LF)); 924 begin 925 Check_Null_Parameter (P); 926 927 if N = 0 then 928 -- No LF, return the original string 929 return S; 930 end if; 931 932 declare 933 Result : String (1 .. S'Length + N * 4); 934 K : Positive := S'First; 935 begin 936 for J in S'Range loop 937 if S (J) = ASCII.LF then 938 Result (K .. K + 4) := "<br/>"; 939 K := K + 5; 940 else 941 Result (K) := S (J); 942 K := K + 1; 943 end if; 944 end loop; 945 946 return Result (1 .. K - 1); 947 end; 948 end LF_2_BR; 949 950 ----------- 951 -- Lower -- 952 ----------- 953 954 function Lower 955 (S : String; 956 C : not null access Filter_Context; 957 P : Parameter_Data := No_Parameter) return String 958 is 959 pragma Unreferenced (C); 960 begin 961 Check_Null_Parameter (P); 962 963 return Characters.Handling.To_Lower (S); 964 end Lower; 965 966 ----------- 967 -- Match -- 968 ------------ 969 970 function Match 971 (S : String; 972 C : not null access Filter_Context; 973 P : Parameter_Data := No_Parameter) return String 974 is 975 pragma Unreferenced (C); 976 use type GNAT.Regpat.Match_Location; 977 978 Matches : GNAT.Regpat.Match_Array (0 .. 0); 979 begin 980 if P = No_Parameter then 981 raise Template_Error with "missing parameter for MATCH filter"; 982 end if; 983 984 GNAT.Regpat.Match (P.Regexp.all, S, Matches); 985 986 if Matches (0) = GNAT.Regpat.No_Match then 987 return "FALSE"; 988 else 989 return "TRUE"; 990 end if; 991 end Match; 992 993 --------- 994 -- Max -- 995 --------- 996 997 function Max 998 (S : String; 999 C : not null access Filter_Context; 1000 P : Parameter_Data := No_Parameter) return String 1001 is 1002 pragma Unreferenced (C); 1003 V_Str : constant String := To_String (P.S); 1004 begin 1005 if Is_Number (V_Str) and then Is_Number (S) then 1006 return Utils.Image 1007 (Integer'Max (Integer'Value (V_Str), Integer'Value (S))); 1008 else 1009 return ""; 1010 end if; 1011 end Max; 1012 1013 --------- 1014 -- Min -- 1015 --------- 1016 1017 function Min 1018 (S : String; 1019 C : not null access Filter_Context; 1020 P : Parameter_Data := No_Parameter) return String 1021 is 1022 pragma Unreferenced (C); 1023 V_Str : constant String := To_String (P.S); 1024 begin 1025 if Is_Number (V_Str) and then Is_Number (S) then 1026 return Utils.Image 1027 (Integer'Min (Integer'Value (V_Str), Integer'Value (S))); 1028 else 1029 return ""; 1030 end if; 1031 end Min; 1032 1033 ----------- 1034 -- Minus -- 1035 ----------- 1036 1037 function Minus 1038 (S : String; 1039 C : not null access Filter_Context; 1040 P : Parameter_Data := No_Parameter) return String 1041 is 1042 N, V : Integer; 1043 begin 1044 declare 1045 V_Str : constant String := To_String (P.S); 1046 begin 1047 if Is_Number (V_Str) then 1048 N := Integer'Value (V_Str); 1049 else 1050 N := Integer'Value (Value (V_Str, C.Translations, C.I_Parameters)); 1051 end if; 1052 exception 1053 when Constraint_Error => 1054 raise Template_Error with """-"" filter parameter error"; 1055 end; 1056 1057 begin 1058 V := Integer'Value (S); 1059 return Utils.Image (V - N); 1060 exception 1061 when others => 1062 return ""; 1063 end; 1064 end Minus; 1065 1066 ---------------- 1067 -- Mode_Value -- 1068 ---------------- 1069 1070 function Mode_Value (Name : String) return Mode is 1071 F, L, K : Mode; 1072 begin 1073 F := Mode'First; 1074 L := Mode'Last; 1075 1076 loop 1077 K := Mode'Val ((Mode'Pos (F) + Mode'Pos (L)) / 2); 1078 1079 if Table (K).Name.all = Name then 1080 return K; 1081 1082 else 1083 exit when F = K and then L = K; 1084 1085 if Table (K).Name.all < Name then 1086 F := K; 1087 if F /= Mode'Last then 1088 F := Mode'Succ (F); 1089 end if; 1090 1091 exit when Table (F).Name.all > Name; 1092 1093 else 1094 L := K; 1095 if L /= Mode'First then 1096 L := Mode'Pred (L); 1097 end if; 1098 1099 exit when Table (L).Name.all < Name; 1100 end if; 1101 end if; 1102 end loop; 1103 1104 -- Not found in the table of built-in filters, look for a user's one 1105 1106 if User_Filters.Contains (Name) then 1107 return User_Defined; 1108 end if; 1109 1110 raise Internal_Error with "Unknown filter " & Name; 1111 end Mode_Value; 1112 1113 ------------ 1114 -- Modulo -- 1115 ------------ 1116 1117 function Modulo 1118 (S : String; 1119 C : not null access Filter_Context; 1120 P : Parameter_Data := No_Parameter) return String 1121 is 1122 N, V : Integer; 1123 begin 1124 declare 1125 V_Str : constant String := To_String (P.S); 1126 begin 1127 if Is_Number (V_Str) then 1128 N := Integer'Value (V_Str); 1129 else 1130 N := Integer'Value (Value (V_Str, C.Translations, C.I_Parameters)); 1131 end if; 1132 exception 1133 when Constraint_Error => 1134 raise Template_Error with "modulo filter parameter error"; 1135 end; 1136 1137 begin 1138 V := Integer'Value (S); 1139 return Utils.Image (V mod N); 1140 exception 1141 when others => 1142 return ""; 1143 end; 1144 end Modulo; 1145 1146 -------------- 1147 -- Multiply -- 1148 -------------- 1149 1150 function Multiply 1151 (S : String; 1152 C : not null access Filter_Context; 1153 P : Parameter_Data := No_Parameter) return String 1154 is 1155 N, V : Integer; 1156 begin 1157 declare 1158 V_Str : constant String := To_String (P.S); 1159 begin 1160 if Is_Number (V_Str) then 1161 N := Integer'Value (V_Str); 1162 else 1163 N := Integer'Value (Value (V_Str, C.Translations, C.I_Parameters)); 1164 end if; 1165 exception 1166 when Constraint_Error => 1167 raise Template_Error with """*"" filter parameter error"; 1168 end; 1169 1170 begin 1171 V := Integer'Value (S); 1172 return Utils.Image (V * N); 1173 exception 1174 when others => 1175 return ""; 1176 end; 1177 end Multiply; 1178 1179 ---------- 1180 -- Name -- 1181 ---------- 1182 1183 function Name (Handle : Callback) return String is 1184 begin 1185 for K in Table'Range loop 1186 if Table (K).Handle = Handle then 1187 return Table (K).Name.all; 1188 end if; 1189 end loop; 1190 1191 raise Internal_Error with "Unknown filter handle"; 1192 end Name; 1193 1194 --------- 1195 -- Neg -- 1196 --------- 1197 1198 function Neg 1199 (S : String; 1200 C : not null access Filter_Context; 1201 P : Parameter_Data := No_Parameter) return String 1202 is 1203 pragma Unreferenced (C); 1204 begin 1205 Check_Null_Parameter (P); 1206 1207 if S = "" or else not Is_Number (S) then 1208 return ""; 1209 else 1210 return Utils.Image (Integer'Value (S) * (-1)); 1211 end if; 1212 end Neg; 1213 1214 -------------- 1215 -- No_Digit -- 1216 -------------- 1217 1218 function No_Digit 1219 (S : String; 1220 C : not null access Filter_Context; 1221 P : Parameter_Data := No_Parameter) return String 1222 is 1223 pragma Unreferenced (C); 1224 Result : String := S; 1225 begin 1226 Check_Null_Parameter (P); 1227 1228 for K in S'Range loop 1229 if Strings.Maps.Is_In 1230 (S (K), Strings.Maps.Constants.Decimal_Digit_Set) 1231 then 1232 Result (K) := ' '; 1233 end if; 1234 end loop; 1235 1236 return Result; 1237 end No_Digit; 1238 1239 ---------------- 1240 -- No_Dynamic -- 1241 ---------------- 1242 1243 function No_Dynamic 1244 (S : String; 1245 C : not null access Filter_Context; 1246 P : Parameter_Data := No_Parameter) return String 1247 is 1248 pragma Unreferenced (C); 1249 begin 1250 Check_Null_Parameter (P); 1251 return S; 1252 end No_Dynamic; 1253 1254 --------------- 1255 -- No_Letter -- 1256 --------------- 1257 1258 function No_Letter 1259 (S : String; 1260 C : not null access Filter_Context; 1261 P : Parameter_Data := No_Parameter) return String 1262 is 1263 pragma Unreferenced (C); 1264 Result : String := S; 1265 begin 1266 Check_Null_Parameter (P); 1267 1268 for K in S'Range loop 1269 if Strings.Maps.Is_In (S (K), Strings.Maps.Constants.Letter_Set) then 1270 Result (K) := ' '; 1271 end if; 1272 end loop; 1273 1274 return Result; 1275 end No_Letter; 1276 1277 -------------- 1278 -- No_Space -- 1279 -------------- 1280 1281 function No_Space 1282 (S : String; 1283 C : not null access Filter_Context; 1284 P : Parameter_Data := No_Parameter) return String 1285 is 1286 pragma Unreferenced (C); 1287 Result : String (S'Range); 1288 L : Natural := Result'First - 1; 1289 begin 1290 Check_Null_Parameter (P); 1291 1292 for K in S'Range loop 1293 if not (S (K) = ' ') then 1294 L := L + 1; 1295 Result (L) := S (K); 1296 end if; 1297 end loop; 1298 1299 return Result (Result'First .. L); 1300 end No_Space; 1301 1302 ------------- 1303 -- Oui_Non -- 1304 ------------- 1305 1306 function Oui_Non 1307 (S : String; 1308 C : not null access Filter_Context; 1309 P : Parameter_Data := No_Parameter) return String 1310 is 1311 pragma Unreferenced (C); 1312 begin 1313 Check_Null_Parameter (P); 1314 1315 if S = "TRUE" then 1316 return "OUI"; 1317 1318 elsif S = "true" then 1319 return "oui"; 1320 1321 elsif S = "True" then 1322 return "Oui"; 1323 1324 elsif S = "FALSE" then 1325 return "NON"; 1326 1327 elsif S = "false" then 1328 return "non"; 1329 1330 elsif S = "False" then 1331 return "Non"; 1332 1333 else 1334 return S; 1335 end if; 1336 end Oui_Non; 1337 1338 --------------- 1339 -- Parameter -- 1340 --------------- 1341 1342 function Parameter (Mode : Filter.Mode) return Parameter_Mode is 1343 begin 1344 case Mode is 1345 when Match => return Regexp; 1346 when Replace | Replace_All => return Regpat; 1347 when Slice => return Slice; 1348 when User_Defined => return User_Callback; 1349 when others => return Str; 1350 end case; 1351 end Parameter; 1352 1353 ---------- 1354 -- Plus -- 1355 ---------- 1356 1357 function Plus 1358 (S : String; 1359 C : not null access Filter_Context; 1360 P : Parameter_Data := No_Parameter) return String 1361 is 1362 N, V : Integer; 1363 begin 1364 declare 1365 V_Str : constant String := To_String (P.S); 1366 begin 1367 if Is_Number (V_Str) then 1368 N := Integer'Value (V_Str); 1369 else 1370 N := Integer'Value (Value (V_Str, C.Translations, C.I_Parameters)); 1371 end if; 1372 exception 1373 when Constraint_Error => 1374 raise Template_Error with """+"" filter parameter error"; 1375 end; 1376 1377 begin 1378 V := Integer'Value (S); 1379 return Utils.Image (V + N); 1380 exception 1381 when others => 1382 return ""; 1383 end; 1384 end Plus; 1385 1386 ------------------ 1387 -- Point_2_Coma -- 1388 ------------------ 1389 1390 function Point_2_Coma 1391 (S : String; 1392 C : not null access Filter_Context; 1393 P : Parameter_Data := No_Parameter) return String 1394 is 1395 pragma Unreferenced (C); 1396 Result : String := S; 1397 begin 1398 Check_Null_Parameter (P); 1399 1400 for K in Result'Range loop 1401 if Result (K) = '.' then 1402 Result (K) := ','; 1403 end if; 1404 end loop; 1405 1406 return Result; 1407 end Point_2_Coma; 1408 1409 -------------- 1410 -- Register -- 1411 -------------- 1412 1413 procedure Register 1414 (Name : String; 1415 Handler : Templates_Parser.Callback) 1416 is 1417 Position : Filter_Map.Cursor; 1418 Success : Boolean; 1419 begin 1420 User_Filters.Insert (Name, (With_Param, Handler), Position, Success); 1421 end Register; 1422 1423 procedure Register 1424 (Name : String; 1425 Handler : Callback_No_Param) 1426 is 1427 Position : Filter_Map.Cursor; 1428 Success : Boolean; 1429 begin 1430 User_Filters.Insert (Name, (No_Param, Handler), Position, Success); 1431 end Register; 1432 1433 procedure Register 1434 (Name : String; 1435 Handler : not null access User_Filter'Class) 1436 is 1437 Position : Filter_Map.Cursor; 1438 Success : Boolean; 1439 begin 1440 User_Filters.Insert 1441 (Name, (As_Tagged, User_Filter_Access (Handler)), Position, Success); 1442 end Register; 1443 1444 ------------- 1445 -- Release -- 1446 ------------- 1447 1448 procedure Release (P : in out Parameter_Data) is 1449 procedure Unchecked_Free is new Ada.Unchecked_Deallocation 1450 (GNAT.Regpat.Pattern_Matcher, Pattern_Matcher_Access); 1451 begin 1452 if P.Mode = Regpat then 1453 Unchecked_Free (P.Regpat); 1454 elsif P.Mode = Regexp then 1455 Unchecked_Free (P.Regexp); 1456 end if; 1457 end Release; 1458 1459 procedure Release (S : in out Set) is 1460 begin 1461 for K in S'Range loop 1462 Release (S (K).Parameters); 1463 end loop; 1464 end Release; 1465 1466 ------------ 1467 -- Repeat -- 1468 ------------ 1469 1470 function Repeat 1471 (S : String; 1472 C : not null access Filter_Context; 1473 P : Parameter_Data := No_Parameter) return String 1474 is 1475 N : Natural; 1476 Pattern : Unbounded_String; 1477 begin 1478 declare 1479 V_Str : constant String := To_String (P.S); 1480 begin 1481 if Is_Number (V_Str) then 1482 -- REPEAT(N):STR 1483 N := Natural'Value (V_Str); 1484 Pattern := To_Unbounded_String (S); 1485 1486 else 1487 declare 1488 N_Str : constant String := 1489 Value (V_Str, C.Translations, C.I_Parameters); 1490 begin 1491 if Is_Number (N_Str) then 1492 -- REPEAT(N_VAR):STR 1493 N := Natural'Value (N_Str); 1494 Pattern := To_Unbounded_String (S); 1495 else 1496 -- REPEAT(STR):N 1497 N := Natural'Value (S); 1498 Pattern := P.S; 1499 end if; 1500 end; 1501 end if; 1502 1503 declare 1504 S : constant String := To_String (Pattern); 1505 R : String (1 .. N * S'Length); 1506 begin 1507 for K in 1 .. N loop 1508 R (1 + (K - 1) * S'Length .. S'Length * K) := S; 1509 end loop; 1510 1511 return R; 1512 end; 1513 end; 1514 exception 1515 when Constraint_Error => 1516 raise Template_Error with "repeat filter parameter error"; 1517 end Repeat; 1518 1519 ------------- 1520 -- Replace -- 1521 ------------- 1522 1523 function Replace 1524 (S : String; 1525 C : not null access Filter_Context; 1526 P : Parameter_Data := No_Parameter) return String 1527 is 1528 begin 1529 return Replace_One_Or_All 1530 (S, P, C.Translations, C.I_Parameters, One => True); 1531 end Replace; 1532 1533 ----------------- 1534 -- Replace_All -- 1535 ----------------- 1536 1537 function Replace_All 1538 (S : String; 1539 C : not null access Filter_Context; 1540 P : Parameter_Data := No_Parameter) return String 1541 is 1542 begin 1543 return Replace_One_Or_All 1544 (S, P, C.Translations, C.I_Parameters, One => False); 1545 end Replace_All; 1546 1547 ------------------------ 1548 -- Replace_One_Or_All -- 1549 ------------------------ 1550 1551 function Replace_One_Or_All 1552 (S : String; 1553 P : Parameter_Data; 1554 T : Translate_Set; 1555 I : Parameter_Set; 1556 One : Boolean) return String 1557 is 1558 use Ada.Strings.Fixed; 1559 use type GNAT.Regpat.Match_Location; 1560 1561 Param : constant String := Value (To_String (P.Param), T, I); 1562 1563 Matches : GNAT.Regpat.Match_Array 1564 (0 .. GNAT.Regpat.Paren_Count (P.Regpat.all)); 1565 1566 Result : Unbounded_String; 1567 Temp : Unbounded_String; 1568 N : Natural; 1569 Current : Natural := S'First; 1570 Matched : Boolean := False; 1571 begin 1572 1573 loop 1574 GNAT.Regpat.Match (P.Regpat.all, S (Current .. S'Last), Matches); 1575 exit when Matches (0) = GNAT.Regpat.No_Match; 1576 1577 Matched := True; 1578 Temp := To_Unbounded_String (Param); 1579 1580 -- Replace each occurrence of \n in Temp by the corresponding match 1581 1582 for K in 1 .. Matches'Last loop 1583 -- We only accept \1 ... \9 because we want to be able to write 1584 -- such a replacement string "\10123456789\2" 1585 exit when K = 10 or else Matches (K) = GNAT.Regpat.No_Match; 1586 1587 N := 1; 1588 1589 loop 1590 N := Index 1591 (Slice (Temp, N, Length (Temp)), '\' & Utils.Image (K)); 1592 1593 exit when N = 0; 1594 1595 Replace_Slice 1596 (Temp, N, N + 1, 1597 By => S (Matches (K).First .. Matches (K).Last)); 1598 1599 -- Position N just after the inserted replacement text 1600 N := N + Matches (K).Last - Matches (K).First + 1; 1601 end loop; 1602 end loop; 1603 1604 -- Prepend the beginning of string before the match 1605 Result := Result 1606 & To_Unbounded_String (S (Current .. Matches (0).First - 1)) 1607 & Temp; 1608 1609 -- Position the cursor just after the current match 1610 Current := Matches (0).Last + 1; 1611 1612 exit when One; 1613 end loop; 1614 1615 if Matched then 1616 return To_String (Result) & S (Current .. S'Last); 1617 else 1618 -- No match, returns the initial string 1619 return S; 1620 end if; 1621 exception 1622 when Constraint_Error => 1623 raise Template_Error with "replace filter parameter error"; 1624 end Replace_One_Or_All; 1625 1626 ------------------- 1627 -- Replace_Param -- 1628 ------------------- 1629 1630 function Replace_Param 1631 (S : String; 1632 C : not null access Filter_Context; 1633 P : Parameter_Data := No_Parameter) return String 1634 is 1635 Param : constant String := To_String (P.S); 1636 Pos : constant Natural := Strings.Fixed.Index (Param, "="); 1637 1638 begin 1639 if Pos = 0 then 1640 raise Template_Error with "Replace_Param error"; 1641 1642 else 1643 declare 1644 Key : constant String := Param (Param'First .. Pos - 1); 1645 begin 1646 return Add_Param 1647 (Del_Param (S, C, (Str, To_Unbounded_String (Key))), 1648 C, P); 1649 end; 1650 end if; 1651 end Replace_Param; 1652 1653 ------------------ 1654 -- Reverse_Data -- 1655 ------------------ 1656 1657 function Reverse_Data 1658 (S : String; 1659 C : not null access Filter_Context; 1660 P : Parameter_Data := No_Parameter) return String 1661 is 1662 pragma Unreferenced (C); 1663 Result : String (S'Range); 1664 begin 1665 Check_Null_Parameter (P); 1666 1667 for K in S'Range loop 1668 Result (Result'Last - K + Result'First) := S (K); 1669 end loop; 1670 return Result; 1671 end Reverse_Data; 1672 1673 ---------- 1674 -- Size -- 1675 ---------- 1676 1677 function Size 1678 (S : String; 1679 C : not null access Filter_Context; 1680 P : Parameter_Data := No_Parameter) return String 1681 is 1682 pragma Unreferenced (C); 1683 begin 1684 Check_Null_Parameter (P); 1685 1686 return Utils.Image (S'Length); 1687 end Size; 1688 1689 ----------- 1690 -- Slice -- 1691 ----------- 1692 1693 function Slice 1694 (S : String; 1695 C : not null access Filter_Context; 1696 P : Parameter_Data := No_Parameter) return String 1697 is 1698 pragma Unreferenced (C); 1699 First, Last : Integer; 1700 begin 1701 if S'Length = 0 then 1702 return ""; 1703 else 1704 if P.First <= 0 then 1705 First := Integer'Max (S'First, S'Last + P.First); 1706 else 1707 First := S'First + P.First - 1; 1708 end if; 1709 1710 if P.Last <= 0 then 1711 Last := S'Last + P.Last; 1712 else 1713 Last := Integer'Min (S'Last, S'First + P.Last - 1); 1714 end if; 1715 1716 if First > S'Last then 1717 return ""; 1718 end if; 1719 1720 return S (First .. Last); 1721 end if; 1722 end Slice; 1723 1724 ---------- 1725 -- Trim -- 1726 ---------- 1727 1728 function Trim 1729 (S : String; 1730 C : not null access Filter_Context; 1731 P : Parameter_Data := No_Parameter) return String 1732 is 1733 pragma Unreferenced (C); 1734 begin 1735 Check_Null_Parameter (P); 1736 1737 return Ada.Strings.Fixed.Trim (S, Ada.Strings.Both); 1738 end Trim; 1739 1740 ----------- 1741 -- Upper -- 1742 ----------- 1743 1744 function Upper 1745 (S : String; 1746 C : not null access Filter_Context; 1747 P : Parameter_Data := No_Parameter) return String 1748 is 1749 pragma Unreferenced (C); 1750 begin 1751 Check_Null_Parameter (P); 1752 1753 return Characters.Handling.To_Upper (S); 1754 end Upper; 1755 1756 ------------------ 1757 -- User_Defined -- 1758 ------------------ 1759 1760 function User_Defined 1761 (S : String; 1762 C : not null access Filter_Context; 1763 P : Parameter_Data := No_Parameter) return String is 1764 begin 1765 case P.Handler.Typ is 1766 when With_Param => 1767 return P.Handler.CBP 1768 (S, To_String (P.P), (C.Translations, C.Lazy_Tag)); 1769 1770 when No_Param => 1771 if P.P /= Null_Unbounded_String then 1772 raise Template_Error with "no parameter allowed in this filter"; 1773 else 1774 return P.Handler.CB (S, (C.Translations, C.Lazy_Tag)); 1775 end if; 1776 1777 when As_Tagged => 1778 if P.Handler.CBT /= null then 1779 return Execute 1780 (P.Handler.CBT, 1781 Value => S, 1782 Parameters => To_String (P.P), 1783 Context => (C.Translations, C.Lazy_Tag)); 1784 else 1785 return ""; 1786 end if; 1787 end case; 1788 end User_Defined; 1789 1790 ----------------- 1791 -- User_Handle -- 1792 ----------------- 1793 1794 function User_Handle (Name : String) return User_CB is 1795 begin 1796 return User_Filters.Element (Name); 1797 end User_Handle; 1798 1799 ----------- 1800 -- Value -- 1801 ----------- 1802 1803 function Value 1804 (Str : String; 1805 Translations : Translate_Set; 1806 I_Params : Parameter_Set) return String 1807 is 1808 Pos : Association_Map.Cursor; 1809 begin 1810 if Str'Length > 0 1811 and then Str (Str'First) = '$' 1812 and then Is_Number (Str (Str'First + 1 .. Str'Last)) 1813 then 1814 -- This is an include parameter 1815 1816 declare 1817 N : constant Natural := 1818 Natural'Value (Str (Str'First + 1 .. Str'Last)); 1819 begin 1820 return To_String (I_Params (N + 1)); 1821 end; 1822 1823 elsif Translations = Null_Set then 1824 return Str; 1825 1826 else 1827 Pos := Translations.Set.Find (Str); 1828 1829 if Association_Map.Has_Element (Pos) then 1830 declare 1831 Tk : constant Association := Association_Map.Element (Pos); 1832 begin 1833 if Tk.Kind = Std then 1834 return To_String (Tk.Value); 1835 end if; 1836 end; 1837 end if; 1838 1839 return Str; 1840 end if; 1841 end Value; 1842 1843 ---------------- 1844 -- Web_Encode -- 1845 ---------------- 1846 1847 function Web_Encode 1848 (S : String; 1849 C : not null access Filter_Context; 1850 P : Parameter_Data := No_Parameter) return String 1851 is 1852 pragma Unreferenced (C); 1853 C_Inf : constant Natural := Character'Pos ('<'); 1854 C_Sup : constant Natural := Character'Pos ('>'); 1855 C_And : constant Natural := Character'Pos ('&'); 1856 C_Quo : constant Natural := Character'Pos ('"'); 1857 1858 Result : Unbounded_String; 1859 Last : Integer := S'First; 1860 Code : Natural; 1861 1862 procedure Append_To_Result 1863 (Str : String; 1864 From : Integer; 1865 To : Integer); 1866 -- Append S (From .. To) to Result if not empty concatenated with Str 1867 -- and update Last. 1868 1869 ---------------------- 1870 -- Append_To_Result -- 1871 ---------------------- 1872 1873 procedure Append_To_Result 1874 (Str : String; 1875 From : Integer; 1876 To : Integer) is 1877 begin 1878 if From <= To then 1879 Append (Result, S (From .. To) & Str); 1880 else 1881 Append (Result, Str); 1882 end if; 1883 1884 Last := To + 2; 1885 end Append_To_Result; 1886 1887 begin 1888 Check_Null_Parameter (P); 1889 1890 for K in S'Range loop 1891 Code := Character'Pos (S (K)); 1892 1893 if Code not in 32 .. 127 1894 or else Code = C_Inf or else Code = C_Sup 1895 or else Code = C_And or else Code = C_Quo 1896 then 1897 declare 1898 I_Code : constant String := Utils.Image (Code); 1899 begin 1900 Append_To_Result ("&#" & I_Code & ";", Last, K - 1); 1901 end; 1902 end if; 1903 end loop; 1904 1905 if Last <= S'Last then 1906 Append (Result, S (Last .. S'Last)); 1907 end if; 1908 1909 return To_String (Result); 1910 end Web_Encode; 1911 1912 ---------------- 1913 -- Web_Escape -- 1914 ---------------- 1915 1916 function Web_Escape 1917 (S : String; 1918 C : not null access Filter_Context; 1919 P : Parameter_Data := No_Parameter) return String 1920 is 1921 pragma Unreferenced (C); 1922 begin 1923 Check_Null_Parameter (P); 1924 return Utils.Web_Escape (S); 1925 end Web_Escape; 1926 1927 -------------- 1928 -- Web_NBSP -- 1929 -------------- 1930 1931 function Web_NBSP 1932 (S : String; 1933 C : not null access Filter_Context; 1934 P : Parameter_Data := No_Parameter) return String 1935 is 1936 pragma Unreferenced (C); 1937 Nbsp_Token : constant String := " "; 1938 Max_Escape_Sequence : constant Positive := Nbsp_Token'Length; 1939 Result : String (1 .. S'Length * Max_Escape_Sequence); 1940 Last : Natural := 0; 1941 begin 1942 Check_Null_Parameter (P); 1943 1944 for I in S'Range loop 1945 Last := Last + 1; 1946 1947 if S (I) = ' ' then 1948 Result (Last .. Last + Nbsp_Token'Length - 1) := Nbsp_Token; 1949 Last := Last + Nbsp_Token'Length - 1; 1950 else 1951 Result (Last) := S (I); 1952 end if; 1953 1954 end loop; 1955 1956 return Result (1 .. Last); 1957 end Web_NBSP; 1958 1959 ---------- 1960 -- Wrap -- 1961 ---------- 1962 1963 function Wrap 1964 (S : String; 1965 C : not null access Filter_Context; 1966 P : Parameter_Data := No_Parameter) return String 1967 is 1968 pragma Unreferenced (C); 1969 Max_Line_Length : constant Positive := Positive'Value (To_String (P.S)); 1970 Last : Natural := S'First; 1971 First : Natural := S'First; 1972 Last_Space_Init : constant Integer := S'First - 1; 1973 Last_Space : Integer := Last_Space_Init; 1974 Result : Unbounded_String; 1975 begin 1976 while Last <= S'Last loop 1977 if S (Last) = ' ' then 1978 Last_Space := Last; 1979 end if; 1980 1981 if S (Last) = ASCII.LF then 1982 -- End of the line 1983 1984 Append (Result, S (First .. Last)); 1985 First := Last + 1; 1986 Last := First; 1987 Last_Space := Last_Space_Init; 1988 1989 elsif Last - First >= Max_Line_Length then 1990 -- The line must be wrapped 1991 1992 if Last_Space in First .. Last then 1993 -- Split the line before the last word 1994 1995 Append (Result, S (First .. Last_Space - 1) & ASCII.LF); 1996 First := Last_Space + 1; 1997 Last := First; 1998 else 1999 -- There is only one word on the line: cut it 2000 2001 Append (Result, S (First .. Last - 1) & ASCII.LF); 2002 First := Last; 2003 end if; 2004 2005 Last_Space := Last_Space_Init; 2006 2007 else 2008 -- Go to the next character 2009 2010 Last := Last + 1; 2011 end if; 2012 end loop; 2013 2014 Append (Result, S (First .. S'Last)); 2015 2016 return To_String (Result); 2017 exception 2018 when Constraint_Error => 2019 raise Template_Error with "wrap filter parameter error"; 2020 end Wrap; 2021 2022 ------------ 2023 -- Yes_No -- 2024 ------------ 2025 2026 function Yes_No 2027 (S : String; 2028 C : not null access Filter_Context; 2029 P : Parameter_Data := No_Parameter) return String 2030 is 2031 pragma Unreferenced (C); 2032 begin 2033 Check_Null_Parameter (P); 2034 2035 if S = "TRUE" then 2036 return "YES"; 2037 2038 elsif S = "true" then 2039 return "yes"; 2040 2041 elsif S = "True" then 2042 return "Yes"; 2043 2044 elsif S = "FALSE" then 2045 return "NO"; 2046 2047 elsif S = "false" then 2048 return "no"; 2049 2050 elsif S = "False" then 2051 return "No"; 2052 2053 else 2054 return S; 2055 end if; 2056 end Yes_No; 2057 2058end Filter; 2059