From 7525bed2d315a25ac2caf95ff0bf44c905d58a7e Mon Sep 17 00:00:00 2001 From: Andreas Mair Date: Sun, 6 Mar 2005 08:11:12 +0100 Subject: 2005-03-06: 0.97-am1 "initial release" This is mainly the lastest vdradmin (v0.97) with different patches applied: - vdradmin-0.97 has been taken from linvdr-0.7. - xpix's BigPatch_0.9pre5 (ported from vdradmin-0.95 to vdradmin-0.97 (see HISTORY.bigpatch). - included changes from vdradmin-0.95-ct-10 (see HISTORY.ct). - included vdradmin-0.95_0.9_pre5_fb1.diff (see HISTORY.macfly). - included vdradmin-0.96-rename.diff which also needs an applied "vdr-aio21_svdrprename.patch" patch (don't know the author right now). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit My own changes: - included missing "Was läuft heute?" template (found at www.vdr-portal.de). - fixed some rendering problems with "New Timer" and "New Autotimer" on KDE's Konqueror. - Beautified recordings listing (at least in my eyes ;-) - Added "Size" selectbox to TV template. --- COPYING | 339 ++ HISTORY | 359 ++ HISTORY.am | 19 + HISTORY.bigpatch | 99 + HISTORY.ct | Bin 0 -> 670 bytes HISTORY.macfly | 34 + INSTALL | 50 + Makefile | 26 + contrib/README.vdr-aio21_svdrprename.patch | 3 + contrib/findunusedimage.sh | 8 + contrib/gentoo.rc.vdradmind | 20 + contrib/vdr-1.2.0-recordings-length.diff | 15 + contrib/vdr-aio21_svdrprename.patch | 65 + lib/HTML/Template.pm | 3265 +++++++++++ lib/HTML/Template/Expr.pm | 688 +++ lib/MIME/Base64.pm | 202 + lib/Parse/RecDescent.pm | 3045 ++++++++++ lib/Template.pm | 950 +++ lib/Template/Base.pm | 290 + lib/Template/Config.pm | 457 ++ lib/Template/Constants.pm | 277 + lib/Template/Context.pm | 1549 +++++ lib/Template/Directive.pm | 1004 ++++ lib/Template/Document.pm | 482 ++ lib/Template/Exception.pm | 244 + lib/Template/Filters.pm | 1438 +++++ lib/Template/Grammar.pm | 6174 ++++++++++++++++++++ lib/Template/Iterator.pm | 446 ++ lib/Template/Namespace/Constants.pm | 195 + lib/Template/Parser.pm | 1434 +++++ lib/Template/Plugin.pm | 399 ++ lib/Template/Plugin/Date.pm | 361 ++ lib/Template/Plugins.pm | 1031 ++++ lib/Template/Provider.pm | 1433 +++++ lib/Template/Service.pm | 765 +++ lib/Template/Stash.pm | 1000 ++++ lib/Template/Stash/Context.pm | 781 +++ lib/Template/Stash/XS.pm | 176 + lib/Template/Test.pm | 701 +++ lib/Template/View.pm | 754 +++ lib/Text/Balanced.pm | 2301 ++++++++ template/Deutsch/at_new.html | 155 + template/Deutsch/at_timer_list.html | 163 + template/Deutsch/bilder/auge.jpg | Bin 0 -> 1922 bytes template/Deutsch/bilder/back.gif | Bin 0 -> 1631 bytes template/Deutsch/bilder/back.png | Bin 0 -> 709 bytes template/Deutsch/bilder/background.gif | Bin 0 -> 264 bytes template/Deutsch/bilder/cback.png | Bin 0 -> 250 bytes template/Deutsch/bilder/delete.gif | Bin 0 -> 576 bytes template/Deutsch/bilder/edit.gif | Bin 0 -> 324 bytes template/Deutsch/bilder/favicon.ico | Bin 0 -> 11478 bytes template/Deutsch/bilder/fern_01.jpg | Bin 0 -> 1031 bytes template/Deutsch/bilder/fern_02.jpg | Bin 0 -> 1215 bytes template/Deutsch/bilder/fern_03.jpg | Bin 0 -> 1371 bytes template/Deutsch/bilder/fern_04.jpg | Bin 0 -> 678 bytes template/Deutsch/bilder/fern_05.jpg | Bin 0 -> 1094 bytes template/Deutsch/bilder/fern_06.jpg | Bin 0 -> 1108 bytes template/Deutsch/bilder/fern_07.jpg | Bin 0 -> 1111 bytes template/Deutsch/bilder/fern_08.jpg | Bin 0 -> 1094 bytes template/Deutsch/bilder/fern_09.jpg | Bin 0 -> 1109 bytes template/Deutsch/bilder/fern_10.jpg | Bin 0 -> 1104 bytes template/Deutsch/bilder/fern_11.jpg | Bin 0 -> 1101 bytes template/Deutsch/bilder/fern_12.jpg | Bin 0 -> 1117 bytes template/Deutsch/bilder/fern_13.jpg | Bin 0 -> 1107 bytes template/Deutsch/bilder/fern_14.jpg | Bin 0 -> 959 bytes template/Deutsch/bilder/fern_15.jpg | Bin 0 -> 1114 bytes template/Deutsch/bilder/fern_16.jpg | Bin 0 -> 945 bytes template/Deutsch/bilder/fern_17.jpg | Bin 0 -> 874 bytes template/Deutsch/bilder/fern_18.jpg | Bin 0 -> 1322 bytes template/Deutsch/bilder/fern_19.jpg | Bin 0 -> 1264 bytes template/Deutsch/bilder/fern_20.jpg | Bin 0 -> 577 bytes template/Deutsch/bilder/fern_21.jpg | Bin 0 -> 581 bytes template/Deutsch/bilder/fern_22.jpg | Bin 0 -> 1087 bytes template/Deutsch/bilder/fern_23.jpg | Bin 0 -> 998 bytes template/Deutsch/bilder/fern_24.jpg | Bin 0 -> 1031 bytes template/Deutsch/bilder/fern_25.jpg | Bin 0 -> 1013 bytes template/Deutsch/bilder/fern_26.jpg | Bin 0 -> 1047 bytes template/Deutsch/bilder/fern_27.jpg | Bin 0 -> 947 bytes template/Deutsch/bilder/fern_28.jpg | Bin 0 -> 1036 bytes template/Deutsch/bilder/fern_29.jpg | Bin 0 -> 919 bytes template/Deutsch/bilder/fern_30.jpg | Bin 0 -> 677 bytes template/Deutsch/bilder/fern_31.jpg | Bin 0 -> 1078 bytes template/Deutsch/bilder/fern_32.jpg | Bin 0 -> 1171 bytes template/Deutsch/bilder/fern_33.jpg | Bin 0 -> 1095 bytes template/Deutsch/bilder/fern_34.jpg | Bin 0 -> 986 bytes template/Deutsch/bilder/fern_35.jpg | Bin 0 -> 942 bytes template/Deutsch/bilder/fern_36.jpg | Bin 0 -> 1092 bytes template/Deutsch/bilder/fern_37.jpg | Bin 0 -> 912 bytes template/Deutsch/bilder/fern_38.jpg | Bin 0 -> 1224 bytes template/Deutsch/bilder/fern_39.jpg | Bin 0 -> 1386 bytes template/Deutsch/bilder/fern_40.jpg | Bin 0 -> 1431 bytes template/Deutsch/bilder/fern_41.jpg | Bin 0 -> 1021 bytes template/Deutsch/bilder/fern_42.jpg | Bin 0 -> 1007 bytes template/Deutsch/bilder/fern_back.jpg | Bin 0 -> 17190 bytes template/Deutsch/bilder/fernseher_unten.gif | Bin 0 -> 11626 bytes template/Deutsch/bilder/folder.gif | Bin 0 -> 1065 bytes template/Deutsch/bilder/frame.png | Bin 0 -> 7307 bytes template/Deutsch/bilder/framed.gif | Bin 0 -> 14603 bytes template/Deutsch/bilder/gbutton_left.gif | Bin 0 -> 364 bytes template/Deutsch/bilder/gbutton_middle.gif | Bin 0 -> 425 bytes template/Deutsch/bilder/gbutton_right.gif | Bin 0 -> 378 bytes template/Deutsch/bilder/help.gif | Bin 0 -> 1787 bytes template/Deutsch/bilder/hilfe.gif | Bin 0 -> 941 bytes template/Deutsch/bilder/info.jpg | Bin 0 -> 1099 bytes template/Deutsch/bilder/info_button.gif | Bin 0 -> 976 bytes template/Deutsch/bilder/info_button_disabled.gif | Bin 0 -> 1527 bytes template/Deutsch/bilder/linvdr.gif | Bin 0 -> 3749 bytes template/Deutsch/bilder/logo.gif | Bin 0 -> 1884 bytes template/Deutsch/bilder/luecke.gif | Bin 0 -> 135 bytes template/Deutsch/bilder/lupe.jpg | Bin 0 -> 1829 bytes template/Deutsch/bilder/mitte.gif | Bin 0 -> 1147 bytes template/Deutsch/bilder/nav_button_back.gif | Bin 0 -> 925 bytes template/Deutsch/bilder/nav_button_back_end.gif | Bin 0 -> 378 bytes template/Deutsch/bilder/nav_button_back_mitte.gif | Bin 0 -> 532 bytes template/Deutsch/bilder/new_auto_timer.gif | Bin 0 -> 1391 bytes template/Deutsch/bilder/new_timer.gif | Bin 0 -> 1281 bytes template/Deutsch/bilder/pfeile_nachlinks.gif | Bin 0 -> 164 bytes template/Deutsch/bilder/pfeile_nachlinks_soft.gif | Bin 0 -> 164 bytes template/Deutsch/bilder/pfeile_nachrechts.gif | Bin 0 -> 177 bytes template/Deutsch/bilder/pfeile_nachrechts_soft.gif | Bin 0 -> 177 bytes template/Deutsch/bilder/poempl_gelb.gif | Bin 0 -> 681 bytes template/Deutsch/bilder/poempl_grau.gif | Bin 0 -> 604 bytes template/Deutsch/bilder/poempl_grau2.gif | Bin 0 -> 373 bytes template/Deutsch/bilder/poempl_gruen.gif | Bin 0 -> 681 bytes template/Deutsch/bilder/poempl_rot.gif | Bin 0 -> 681 bytes template/Deutsch/bilder/rec.gif | Bin 0 -> 1006 bytes template/Deutsch/bilder/rec.jpg | Bin 0 -> 2050 bytes template/Deutsch/bilder/rec_button.gif | Bin 0 -> 982 bytes template/Deutsch/bilder/rec_mitback.gif | Bin 0 -> 2027 bytes template/Deutsch/bilder/rec_mitback2.jpg | Bin 0 -> 1123 bytes template/Deutsch/bilder/remote.swf | Bin 0 -> 88801 bytes template/Deutsch/bilder/sauerei.gif | Bin 0 -> 4692 bytes template/Deutsch/bilder/separator.png | Bin 0 -> 136 bytes template/Deutsch/bilder/sortiert_asc.gif | Bin 0 -> 56 bytes template/Deutsch/bilder/sortiert_desc.gif | Bin 0 -> 55 bytes template/Deutsch/bilder/spacer.gif | Bin 0 -> 43 bytes template/Deutsch/bilder/stream.jpg | Bin 0 -> 756 bytes template/Deutsch/bilder/stream_mitback2.jpg | Bin 0 -> 1183 bytes template/Deutsch/bilder/top.gif | Bin 0 -> 1909 bytes template/Deutsch/bilder/top_nav_aufnahmen.gif | Bin 0 -> 1131 bytes template/Deutsch/bilder/top_nav_fernbedienung.gif | Bin 0 -> 1431 bytes template/Deutsch/bilder/top_nav_konf.gif | Bin 0 -> 1248 bytes template/Deutsch/bilder/top_nav_prguebersicht.gif | Bin 0 -> 1469 bytes template/Deutsch/bilder/top_nav_timer.gif | Bin 0 -> 878 bytes template/Deutsch/bilder/top_nav_wasjetzt.gif | Bin 0 -> 1448 bytes template/Deutsch/bilder/tv_bottom.gif | Bin 0 -> 11626 bytes template/Deutsch/bilder/tv_umschalten_mitback.gif | Bin 0 -> 2377 bytes template/Deutsch/bilder/tv_umschalten_mitback2.jpg | Bin 0 -> 943 bytes template/Deutsch/bilder/uebersicht_links.gif | Bin 0 -> 851 bytes template/Deutsch/bilder/uebersicht_links_dark.gif | Bin 0 -> 851 bytes template/Deutsch/bilder/uebersicht_mitte.gif | Bin 0 -> 69 bytes template/Deutsch/bilder/uebersicht_mitte_dark.gif | Bin 0 -> 69 bytes .../bilder/uebersicht_mitte_dark_selected.gif | Bin 0 -> 69 bytes .../Deutsch/bilder/uebersicht_mitte_selected.gif | Bin 0 -> 69 bytes template/Deutsch/bilder/uebersicht_oben.gif | Bin 0 -> 1986 bytes template/Deutsch/bilder/uebersicht_oben_links.gif | Bin 0 -> 743 bytes .../bilder/uebersicht_oben_links_selected.gif | Bin 0 -> 793 bytes template/Deutsch/bilder/uebersicht_oben_rechts.gif | Bin 0 -> 769 bytes .../Deutsch/bilder/uebersicht_oben_rechts_sele.gif | Bin 0 -> 784 bytes .../Deutsch/bilder/uebersicht_oben_selected.gif | Bin 0 -> 2145 bytes template/Deutsch/bilder/uebersicht_rechts.gif | Bin 0 -> 906 bytes template/Deutsch/bilder/uebersicht_rechts_dark.gif | Bin 0 -> 906 bytes template/Deutsch/bilder/uebersicht_spacer.gif | Bin 0 -> 43 bytes template/Deutsch/bilder/uebersicht_unten.gif | Bin 0 -> 714 bytes template/Deutsch/bilder/uebersicht_unten_links.gif | Bin 0 -> 649 bytes .../Deutsch/bilder/uebersicht_unten_rechts.gif | Bin 0 -> 735 bytes .../Deutsch/bilder/uebersicht_unten_selected.gif | Bin 0 -> 714 bytes template/Deutsch/config.html | 445 ++ template/Deutsch/config.html.orig | 335 ++ template/Deutsch/copper/auge.jpg | Bin 0 -> 1470 bytes template/Deutsch/copper/back.gif | Bin 0 -> 930 bytes template/Deutsch/copper/background.gif | Bin 0 -> 170 bytes template/Deutsch/copper/cback.gif | Bin 0 -> 175 bytes template/Deutsch/copper/cback.png | Bin 0 -> 96 bytes template/Deutsch/copper/delete.gif | Bin 0 -> 571 bytes template/Deutsch/copper/edit.gif | Bin 0 -> 323 bytes template/Deutsch/copper/fern_01.jpg | Bin 0 -> 791 bytes template/Deutsch/copper/fern_02.jpg | Bin 0 -> 905 bytes template/Deutsch/copper/fern_03.jpg | Bin 0 -> 1109 bytes template/Deutsch/copper/fern_04.jpg | Bin 0 -> 437 bytes template/Deutsch/copper/fern_05.jpg | Bin 0 -> 873 bytes template/Deutsch/copper/fern_06.jpg | Bin 0 -> 879 bytes template/Deutsch/copper/fern_07.jpg | Bin 0 -> 900 bytes template/Deutsch/copper/fern_08.jpg | Bin 0 -> 878 bytes template/Deutsch/copper/fern_09.jpg | Bin 0 -> 891 bytes template/Deutsch/copper/fern_10.jpg | Bin 0 -> 887 bytes template/Deutsch/copper/fern_11.jpg | Bin 0 -> 879 bytes template/Deutsch/copper/fern_12.jpg | Bin 0 -> 889 bytes template/Deutsch/copper/fern_13.jpg | Bin 0 -> 882 bytes template/Deutsch/copper/fern_14.jpg | Bin 0 -> 692 bytes template/Deutsch/copper/fern_15.jpg | Bin 0 -> 887 bytes template/Deutsch/copper/fern_16.jpg | Bin 0 -> 669 bytes template/Deutsch/copper/fern_17.jpg | Bin 0 -> 619 bytes template/Deutsch/copper/fern_18.jpg | Bin 0 -> 1068 bytes template/Deutsch/copper/fern_19.jpg | Bin 0 -> 1011 bytes template/Deutsch/copper/fern_20.jpg | Bin 0 -> 356 bytes template/Deutsch/copper/fern_21.jpg | Bin 0 -> 354 bytes template/Deutsch/copper/fern_22.jpg | Bin 0 -> 673 bytes template/Deutsch/copper/fern_23.jpg | Bin 0 -> 646 bytes template/Deutsch/copper/fern_24.jpg | Bin 0 -> 661 bytes template/Deutsch/copper/fern_25.jpg | Bin 0 -> 668 bytes template/Deutsch/copper/fern_26.jpg | Bin 0 -> 794 bytes template/Deutsch/copper/fern_27.jpg | Bin 0 -> 682 bytes template/Deutsch/copper/fern_28.jpg | Bin 0 -> 823 bytes template/Deutsch/copper/fern_29.jpg | Bin 0 -> 669 bytes template/Deutsch/copper/fern_30.jpg | Bin 0 -> 425 bytes template/Deutsch/copper/fern_31.jpg | Bin 0 -> 868 bytes template/Deutsch/copper/fern_32.jpg | Bin 0 -> 941 bytes template/Deutsch/copper/fern_33.jpg | Bin 0 -> 897 bytes template/Deutsch/copper/fern_34.jpg | Bin 0 -> 717 bytes template/Deutsch/copper/fern_35.jpg | Bin 0 -> 686 bytes template/Deutsch/copper/fern_36.jpg | Bin 0 -> 878 bytes template/Deutsch/copper/fern_37.jpg | Bin 0 -> 667 bytes template/Deutsch/copper/fern_38.jpg | Bin 0 -> 928 bytes template/Deutsch/copper/fern_39.jpg | Bin 0 -> 1129 bytes template/Deutsch/copper/fern_40.jpg | Bin 0 -> 1170 bytes template/Deutsch/copper/fern_41.jpg | Bin 0 -> 749 bytes template/Deutsch/copper/fern_42.jpg | Bin 0 -> 751 bytes template/Deutsch/copper/fern_back.jpg | Bin 0 -> 655 bytes template/Deutsch/copper/fernseher_unten.gif | Bin 0 -> 5581 bytes template/Deutsch/copper/folder.gif | Bin 0 -> 661 bytes template/Deutsch/copper/frame.gif | Bin 0 -> 4683 bytes template/Deutsch/copper/framed.gif | Bin 0 -> 10217 bytes template/Deutsch/copper/gbutton_left.gif | Bin 0 -> 363 bytes template/Deutsch/copper/gbutton_middle.gif | Bin 0 -> 425 bytes template/Deutsch/copper/gbutton_right.gif | Bin 0 -> 378 bytes template/Deutsch/copper/help.gif | Bin 0 -> 1292 bytes template/Deutsch/copper/hilfe.gif | Bin 0 -> 341 bytes template/Deutsch/copper/info.jpg | Bin 0 -> 1473 bytes template/Deutsch/copper/info_button.gif | Bin 0 -> 970 bytes template/Deutsch/copper/info_button_disabled.gif | Bin 0 -> 965 bytes template/Deutsch/copper/linvdr.gif | Bin 0 -> 3150 bytes template/Deutsch/copper/logo.gif | Bin 0 -> 1882 bytes template/Deutsch/copper/luecke.gif | Bin 0 -> 114 bytes template/Deutsch/copper/lupe.jpg | Bin 0 -> 1289 bytes template/Deutsch/copper/mitte.gif | Bin 0 -> 1147 bytes template/Deutsch/copper/nav_button_back.gif | Bin 0 -> 918 bytes template/Deutsch/copper/nav_button_back_end.gif | Bin 0 -> 376 bytes template/Deutsch/copper/nav_button_back_mitte.gif | Bin 0 -> 532 bytes template/Deutsch/copper/navi.css | 11 + template/Deutsch/copper/new_auto_timer.gif | Bin 0 -> 1391 bytes template/Deutsch/copper/new_timer.gif | Bin 0 -> 1281 bytes template/Deutsch/copper/pfeile_nachlinks.gif | Bin 0 -> 164 bytes template/Deutsch/copper/pfeile_nachlinks_soft.gif | Bin 0 -> 164 bytes template/Deutsch/copper/pfeile_nachrechts.gif | Bin 0 -> 177 bytes template/Deutsch/copper/pfeile_nachrechts_soft.gif | Bin 0 -> 177 bytes template/Deutsch/copper/poempl_gelb.gif | Bin 0 -> 678 bytes template/Deutsch/copper/poempl_gruen.gif | Bin 0 -> 679 bytes template/Deutsch/copper/poempl_rot.gif | Bin 0 -> 677 bytes template/Deutsch/copper/rec.gif | Bin 0 -> 230 bytes template/Deutsch/copper/rec.jpg | Bin 0 -> 1806 bytes template/Deutsch/copper/rec_button.gif | Bin 0 -> 979 bytes template/Deutsch/copper/rec_mitback.gif | Bin 0 -> 1356 bytes template/Deutsch/copper/sauerei.gif | Bin 0 -> 4692 bytes template/Deutsch/copper/separator.gif | Bin 0 -> 44 bytes template/Deutsch/copper/sortiert_asc.gif | Bin 0 -> 56 bytes template/Deutsch/copper/sortiert_desc.gif | Bin 0 -> 55 bytes template/Deutsch/copper/spacer.gif | Bin 0 -> 43 bytes template/Deutsch/copper/style.css | 28 + template/Deutsch/copper/top.gif | Bin 0 -> 1905 bytes template/Deutsch/copper/top_nav_aufnahmen.gif | Bin 0 -> 1122 bytes template/Deutsch/copper/top_nav_fernbedienung.gif | Bin 0 -> 1421 bytes template/Deutsch/copper/top_nav_konf.gif | Bin 0 -> 1238 bytes template/Deutsch/copper/top_nav_prguebersicht.gif | Bin 0 -> 1467 bytes template/Deutsch/copper/top_nav_timer.gif | Bin 0 -> 871 bytes template/Deutsch/copper/top_nav_wasjetzt.gif | Bin 0 -> 1440 bytes template/Deutsch/copper/tv_bottom.gif | Bin 0 -> 5581 bytes template/Deutsch/copper/tv_umschalten_mitback.gif | Bin 0 -> 2348 bytes template/Deutsch/copper/uebersicht_links.gif | Bin 0 -> 851 bytes template/Deutsch/copper/uebersicht_links_dark.gif | Bin 0 -> 851 bytes template/Deutsch/copper/uebersicht_mitte.gif | Bin 0 -> 69 bytes template/Deutsch/copper/uebersicht_mitte_dark.gif | Bin 0 -> 69 bytes .../Deutsch/copper/uebersicht_mitte_dark_selec.gif | Bin 0 -> 69 bytes .../Deutsch/copper/uebersicht_mitte_selected.gif | Bin 0 -> 69 bytes template/Deutsch/copper/uebersicht_oben.gif | Bin 0 -> 1916 bytes template/Deutsch/copper/uebersicht_oben_links.gif | Bin 0 -> 523 bytes .../Deutsch/copper/uebersicht_oben_links_selec.gif | Bin 0 -> 545 bytes template/Deutsch/copper/uebersicht_oben_rechts.gif | Bin 0 -> 761 bytes .../Deutsch/copper/uebersicht_oben_rechts_sele.gif | Bin 0 -> 748 bytes .../Deutsch/copper/uebersicht_oben_selected.gif | Bin 0 -> 1671 bytes template/Deutsch/copper/uebersicht_rechts.gif | Bin 0 -> 906 bytes template/Deutsch/copper/uebersicht_rechts_dark.gif | Bin 0 -> 906 bytes template/Deutsch/copper/uebersicht_spacer.gif | Bin 0 -> 43 bytes template/Deutsch/copper/uebersicht_unten.gif | Bin 0 -> 714 bytes template/Deutsch/copper/uebersicht_unten_links.gif | Bin 0 -> 441 bytes .../Deutsch/copper/uebersicht_unten_rechts.gif | Bin 0 -> 721 bytes .../Deutsch/copper/uebersicht_unten_selected.gif | Bin 0 -> 714 bytes template/Deutsch/error.html | 18 + template/Deutsch/favicon.ico | Bin 0 -> 3262 bytes template/Deutsch/i18n.pl | 67 + template/Deutsch/index.html | 23 + template/Deutsch/left.html | 143 + template/Deutsch/library.js | 26 + template/Deutsch/navi.css | 11 + template/Deutsch/noauth.html | 13 + template/Deutsch/noperm.html | 12 + template/Deutsch/prog_detail.html | 40 + template/Deutsch/prog_list.html | 95 + template/Deutsch/prog_list2.html | 108 + template/Deutsch/prog_summary.html | 118 + template/Deutsch/prog_timeline.html | 229 + template/Deutsch/rc.html | 110 + template/Deutsch/rec_edit.html | 65 + template/Deutsch/rec_list.html | 132 + template/Deutsch/style.css | 28 + template/Deutsch/timer_list.html | 304 + template/Deutsch/timer_new.html | 181 + template/Deutsch/toolbar.html | 40 + template/Deutsch/tv.html | 153 + template/Deutsch/tv.html.bak | 139 + template/Deutsch/tv_flash.html | 14 + template/English/at_new.html | 158 + template/English/at_timer_list.html | 173 + template/English/bilder/back.gif | Bin 0 -> 1631 bytes template/English/bilder/back.png | Bin 0 -> 709 bytes template/English/bilder/background.gif | Bin 0 -> 264 bytes template/English/bilder/cback.png | Bin 0 -> 250 bytes template/English/bilder/delete.gif | Bin 0 -> 576 bytes template/English/bilder/edit.gif | Bin 0 -> 324 bytes template/English/bilder/favicon.ico | Bin 0 -> 11478 bytes template/English/bilder/fern_01.jpg | Bin 0 -> 1031 bytes template/English/bilder/fern_02.jpg | Bin 0 -> 1215 bytes template/English/bilder/fern_03.jpg | Bin 0 -> 1371 bytes template/English/bilder/fern_04.jpg | Bin 0 -> 678 bytes template/English/bilder/fern_05.jpg | Bin 0 -> 1094 bytes template/English/bilder/fern_06.jpg | Bin 0 -> 1108 bytes template/English/bilder/fern_07.jpg | Bin 0 -> 1111 bytes template/English/bilder/fern_08.jpg | Bin 0 -> 1094 bytes template/English/bilder/fern_09.jpg | Bin 0 -> 1109 bytes template/English/bilder/fern_10.jpg | Bin 0 -> 1104 bytes template/English/bilder/fern_11.jpg | Bin 0 -> 1101 bytes template/English/bilder/fern_12.jpg | Bin 0 -> 1117 bytes template/English/bilder/fern_13.jpg | Bin 0 -> 1107 bytes template/English/bilder/fern_14.jpg | Bin 0 -> 959 bytes template/English/bilder/fern_15.jpg | Bin 0 -> 1114 bytes template/English/bilder/fern_16.jpg | Bin 0 -> 945 bytes template/English/bilder/fern_17.jpg | Bin 0 -> 874 bytes template/English/bilder/fern_18.jpg | Bin 0 -> 1322 bytes template/English/bilder/fern_19.jpg | Bin 0 -> 1264 bytes template/English/bilder/fern_20.jpg | Bin 0 -> 577 bytes template/English/bilder/fern_21.jpg | Bin 0 -> 581 bytes template/English/bilder/fern_22.jpg | Bin 0 -> 1087 bytes template/English/bilder/fern_23.jpg | Bin 0 -> 998 bytes template/English/bilder/fern_24.jpg | Bin 0 -> 1031 bytes template/English/bilder/fern_25.jpg | Bin 0 -> 1013 bytes template/English/bilder/fern_26.jpg | Bin 0 -> 1047 bytes template/English/bilder/fern_27.jpg | Bin 0 -> 947 bytes template/English/bilder/fern_28.jpg | Bin 0 -> 1036 bytes template/English/bilder/fern_29.jpg | Bin 0 -> 919 bytes template/English/bilder/fern_30.jpg | Bin 0 -> 677 bytes template/English/bilder/fern_31.jpg | Bin 0 -> 1078 bytes template/English/bilder/fern_32.jpg | Bin 0 -> 1171 bytes template/English/bilder/fern_33.jpg | Bin 0 -> 1095 bytes template/English/bilder/fern_34.jpg | Bin 0 -> 986 bytes template/English/bilder/fern_35.jpg | Bin 0 -> 942 bytes template/English/bilder/fern_36.jpg | Bin 0 -> 1092 bytes template/English/bilder/fern_37.jpg | Bin 0 -> 912 bytes template/English/bilder/fern_38.jpg | Bin 0 -> 1224 bytes template/English/bilder/fern_39.jpg | Bin 0 -> 1386 bytes template/English/bilder/fern_40.jpg | Bin 0 -> 1431 bytes template/English/bilder/fern_41.jpg | Bin 0 -> 1021 bytes template/English/bilder/fern_42.jpg | Bin 0 -> 1007 bytes template/English/bilder/fern_back.jpg | Bin 0 -> 17190 bytes template/English/bilder/fernseher_unten.gif | Bin 0 -> 11626 bytes template/English/bilder/folder.gif | Bin 0 -> 1065 bytes template/English/bilder/frame.png | Bin 0 -> 7307 bytes template/English/bilder/framed.gif | Bin 0 -> 14603 bytes template/English/bilder/gbutton_left.gif | Bin 0 -> 364 bytes template/English/bilder/gbutton_middle.gif | Bin 0 -> 425 bytes template/English/bilder/gbutton_right.gif | Bin 0 -> 378 bytes template/English/bilder/help.gif | Bin 0 -> 1787 bytes template/English/bilder/hilfe.gif | Bin 0 -> 941 bytes template/English/bilder/info_button.gif | Bin 0 -> 976 bytes template/English/bilder/info_button_disabled.gif | Bin 0 -> 1527 bytes template/English/bilder/linvdr.gif | Bin 0 -> 3749 bytes template/English/bilder/logo.gif | Bin 0 -> 1884 bytes template/English/bilder/mitte.gif | Bin 0 -> 1147 bytes template/English/bilder/nav_button_back.gif | Bin 0 -> 925 bytes template/English/bilder/nav_button_back_end.gif | Bin 0 -> 378 bytes template/English/bilder/nav_button_back_mitte.gif | Bin 0 -> 532 bytes template/English/bilder/new_auto_timer.gif | Bin 0 -> 1391 bytes template/English/bilder/new_timer.gif | Bin 0 -> 1281 bytes template/English/bilder/pfeile_nachlinks.gif | Bin 0 -> 164 bytes template/English/bilder/pfeile_nachlinks_soft.gif | Bin 0 -> 164 bytes template/English/bilder/pfeile_nachrechts.gif | Bin 0 -> 177 bytes template/English/bilder/pfeile_nachrechts_soft.gif | Bin 0 -> 177 bytes template/English/bilder/poempl_gelb.gif | Bin 0 -> 681 bytes template/English/bilder/poempl_gruen.gif | Bin 0 -> 681 bytes template/English/bilder/poempl_rot.gif | Bin 0 -> 681 bytes template/English/bilder/rec.gif | Bin 0 -> 1006 bytes template/English/bilder/rec_button.gif | Bin 0 -> 982 bytes template/English/bilder/rec_mitback.gif | Bin 0 -> 2027 bytes template/English/bilder/remote.swf | Bin 0 -> 88801 bytes template/English/bilder/sauerei.gif | Bin 0 -> 4692 bytes template/English/bilder/separator.png | Bin 0 -> 136 bytes template/English/bilder/sortiert_asc.gif | Bin 0 -> 56 bytes template/English/bilder/sortiert_desc.gif | Bin 0 -> 55 bytes template/English/bilder/spacer.gif | Bin 0 -> 43 bytes template/English/bilder/top.gif | Bin 0 -> 1909 bytes template/English/bilder/top_nav_aufnahmen.gif | Bin 0 -> 1131 bytes template/English/bilder/top_nav_fernbedienung.gif | Bin 0 -> 1431 bytes template/English/bilder/top_nav_konf.gif | Bin 0 -> 1248 bytes template/English/bilder/top_nav_prguebersicht.gif | Bin 0 -> 1469 bytes template/English/bilder/top_nav_timer.gif | Bin 0 -> 878 bytes template/English/bilder/top_nav_wasjetzt.gif | Bin 0 -> 1448 bytes template/English/bilder/tv_bottom.gif | Bin 0 -> 11626 bytes template/English/bilder/tv_umschalten_mitback.gif | Bin 0 -> 2377 bytes template/English/bilder/uebersicht_links.gif | Bin 0 -> 851 bytes template/English/bilder/uebersicht_links_dark.gif | Bin 0 -> 851 bytes template/English/bilder/uebersicht_mitte.gif | Bin 0 -> 69 bytes template/English/bilder/uebersicht_mitte_dark.gif | Bin 0 -> 69 bytes .../bilder/uebersicht_mitte_dark_selected.gif | Bin 0 -> 69 bytes .../English/bilder/uebersicht_mitte_selected.gif | Bin 0 -> 69 bytes template/English/bilder/uebersicht_oben.gif | Bin 0 -> 1986 bytes template/English/bilder/uebersicht_oben_links.gif | Bin 0 -> 743 bytes .../bilder/uebersicht_oben_links_selected.gif | Bin 0 -> 793 bytes template/English/bilder/uebersicht_oben_rechts.gif | Bin 0 -> 769 bytes .../English/bilder/uebersicht_oben_rechts_sele.gif | Bin 0 -> 784 bytes .../English/bilder/uebersicht_oben_selected.gif | Bin 0 -> 2145 bytes template/English/bilder/uebersicht_rechts.gif | Bin 0 -> 906 bytes template/English/bilder/uebersicht_rechts_dark.gif | Bin 0 -> 906 bytes template/English/bilder/uebersicht_spacer.gif | Bin 0 -> 43 bytes template/English/bilder/uebersicht_unten.gif | Bin 0 -> 714 bytes template/English/bilder/uebersicht_unten_links.gif | Bin 0 -> 649 bytes .../English/bilder/uebersicht_unten_rechts.gif | Bin 0 -> 735 bytes .../English/bilder/uebersicht_unten_selected.gif | Bin 0 -> 714 bytes template/English/config.html | 320 + template/English/error.html | 18 + template/English/i18n.pl | 43 + template/English/index.html | 22 + template/English/left.html | 131 + template/English/navi.css | 11 + template/English/noauth.html | 13 + template/English/noperm.html | 12 + template/English/prog_detail.html | 33 + template/English/prog_list.html | 108 + template/English/prog_summary.html | 85 + template/English/rc.html | 110 + template/English/rec_list.html | 123 + template/English/style.css | 28 + template/English/timer_list.html | 161 + template/English/timer_new.html | 172 + template/English/toolbar.html | 40 + template/English/tv.html | 75 + template/French/at_new.html | 158 + template/French/at_timer_list.html | 173 + template/French/bilder/back.gif | Bin 0 -> 1631 bytes template/French/bilder/back.png | Bin 0 -> 709 bytes template/French/bilder/background.gif | Bin 0 -> 264 bytes template/French/bilder/cback.png | Bin 0 -> 250 bytes template/French/bilder/delete.gif | Bin 0 -> 576 bytes template/French/bilder/edit.gif | Bin 0 -> 324 bytes template/French/bilder/favicon.ico | Bin 0 -> 11478 bytes template/French/bilder/fern_01.jpg | Bin 0 -> 1031 bytes template/French/bilder/fern_02.jpg | Bin 0 -> 1215 bytes template/French/bilder/fern_03.jpg | Bin 0 -> 1371 bytes template/French/bilder/fern_04.jpg | Bin 0 -> 678 bytes template/French/bilder/fern_05.jpg | Bin 0 -> 1094 bytes template/French/bilder/fern_06.jpg | Bin 0 -> 1108 bytes template/French/bilder/fern_07.jpg | Bin 0 -> 1111 bytes template/French/bilder/fern_08.jpg | Bin 0 -> 1094 bytes template/French/bilder/fern_09.jpg | Bin 0 -> 1109 bytes template/French/bilder/fern_10.jpg | Bin 0 -> 1104 bytes template/French/bilder/fern_11.jpg | Bin 0 -> 1101 bytes template/French/bilder/fern_12.jpg | Bin 0 -> 1117 bytes template/French/bilder/fern_13.jpg | Bin 0 -> 1107 bytes template/French/bilder/fern_14.jpg | Bin 0 -> 959 bytes template/French/bilder/fern_15.jpg | Bin 0 -> 1114 bytes template/French/bilder/fern_16.jpg | Bin 0 -> 945 bytes template/French/bilder/fern_17.jpg | Bin 0 -> 874 bytes template/French/bilder/fern_18.jpg | Bin 0 -> 1322 bytes template/French/bilder/fern_19.jpg | Bin 0 -> 1264 bytes template/French/bilder/fern_20.jpg | Bin 0 -> 577 bytes template/French/bilder/fern_21.jpg | Bin 0 -> 581 bytes template/French/bilder/fern_22.jpg | Bin 0 -> 1087 bytes template/French/bilder/fern_23.jpg | Bin 0 -> 998 bytes template/French/bilder/fern_24.jpg | Bin 0 -> 1031 bytes template/French/bilder/fern_25.jpg | Bin 0 -> 1013 bytes template/French/bilder/fern_26.jpg | Bin 0 -> 1047 bytes template/French/bilder/fern_27.jpg | Bin 0 -> 947 bytes template/French/bilder/fern_28.jpg | Bin 0 -> 1036 bytes template/French/bilder/fern_29.jpg | Bin 0 -> 919 bytes template/French/bilder/fern_30.jpg | Bin 0 -> 677 bytes template/French/bilder/fern_31.jpg | Bin 0 -> 1078 bytes template/French/bilder/fern_32.jpg | Bin 0 -> 1171 bytes template/French/bilder/fern_33.jpg | Bin 0 -> 1095 bytes template/French/bilder/fern_34.jpg | Bin 0 -> 986 bytes template/French/bilder/fern_35.jpg | Bin 0 -> 942 bytes template/French/bilder/fern_36.jpg | Bin 0 -> 1092 bytes template/French/bilder/fern_37.jpg | Bin 0 -> 912 bytes template/French/bilder/fern_38.jpg | Bin 0 -> 1224 bytes template/French/bilder/fern_39.jpg | Bin 0 -> 1386 bytes template/French/bilder/fern_40.jpg | Bin 0 -> 1431 bytes template/French/bilder/fern_41.jpg | Bin 0 -> 1021 bytes template/French/bilder/fern_42.jpg | Bin 0 -> 1007 bytes template/French/bilder/fern_back.jpg | Bin 0 -> 17190 bytes template/French/bilder/fernseher_unten.gif | Bin 0 -> 11626 bytes template/French/bilder/folder.gif | Bin 0 -> 1065 bytes template/French/bilder/frame.png | Bin 0 -> 7307 bytes template/French/bilder/framed.gif | Bin 0 -> 14603 bytes template/French/bilder/gbutton_left.gif | Bin 0 -> 364 bytes template/French/bilder/gbutton_middle.gif | Bin 0 -> 425 bytes template/French/bilder/gbutton_right.gif | Bin 0 -> 378 bytes template/French/bilder/help.gif | Bin 0 -> 1787 bytes template/French/bilder/hilfe.gif | Bin 0 -> 941 bytes template/French/bilder/info_button.gif | Bin 0 -> 976 bytes template/French/bilder/info_button_disabled.gif | Bin 0 -> 1527 bytes template/French/bilder/linvdr.gif | Bin 0 -> 3749 bytes template/French/bilder/logo.gif | Bin 0 -> 1884 bytes template/French/bilder/mitte.gif | Bin 0 -> 1147 bytes template/French/bilder/nav_button_back.gif | Bin 0 -> 925 bytes template/French/bilder/nav_button_back_end.gif | Bin 0 -> 378 bytes template/French/bilder/nav_button_back_mitte.gif | Bin 0 -> 532 bytes template/French/bilder/new_auto_timer.gif | Bin 0 -> 1391 bytes template/French/bilder/new_timer.gif | Bin 0 -> 1281 bytes template/French/bilder/pfeile_nachlinks.gif | Bin 0 -> 164 bytes template/French/bilder/pfeile_nachlinks_soft.gif | Bin 0 -> 164 bytes template/French/bilder/pfeile_nachrechts.gif | Bin 0 -> 177 bytes template/French/bilder/pfeile_nachrechts_soft.gif | Bin 0 -> 177 bytes template/French/bilder/poempl_gelb.gif | Bin 0 -> 681 bytes template/French/bilder/poempl_gruen.gif | Bin 0 -> 681 bytes template/French/bilder/poempl_rot.gif | Bin 0 -> 681 bytes template/French/bilder/rec.gif | Bin 0 -> 1006 bytes template/French/bilder/rec_button.gif | Bin 0 -> 982 bytes template/French/bilder/rec_mitback.gif | Bin 0 -> 2027 bytes template/French/bilder/remote.swf | Bin 0 -> 88801 bytes template/French/bilder/sauerei.gif | Bin 0 -> 4692 bytes template/French/bilder/separator.png | Bin 0 -> 136 bytes template/French/bilder/sortiert_asc.gif | Bin 0 -> 56 bytes template/French/bilder/sortiert_desc.gif | Bin 0 -> 55 bytes template/French/bilder/spacer.gif | Bin 0 -> 43 bytes template/French/bilder/top.gif | Bin 0 -> 1909 bytes template/French/bilder/top_nav_aufnahmen.gif | Bin 0 -> 1131 bytes template/French/bilder/top_nav_fernbedienung.gif | Bin 0 -> 1431 bytes template/French/bilder/top_nav_konf.gif | Bin 0 -> 1248 bytes template/French/bilder/top_nav_prguebersicht.gif | Bin 0 -> 1469 bytes template/French/bilder/top_nav_timer.gif | Bin 0 -> 878 bytes template/French/bilder/top_nav_wasjetzt.gif | Bin 0 -> 1448 bytes template/French/bilder/tv_bottom.gif | Bin 0 -> 11626 bytes template/French/bilder/tv_umschalten_mitback.gif | Bin 0 -> 2377 bytes template/French/bilder/uebersicht_links.gif | Bin 0 -> 851 bytes template/French/bilder/uebersicht_links_dark.gif | Bin 0 -> 851 bytes template/French/bilder/uebersicht_mitte.gif | Bin 0 -> 69 bytes template/French/bilder/uebersicht_mitte_dark.gif | Bin 0 -> 69 bytes .../bilder/uebersicht_mitte_dark_selected.gif | Bin 0 -> 69 bytes .../French/bilder/uebersicht_mitte_selected.gif | Bin 0 -> 69 bytes template/French/bilder/uebersicht_oben.gif | Bin 0 -> 1986 bytes template/French/bilder/uebersicht_oben_links.gif | Bin 0 -> 743 bytes .../bilder/uebersicht_oben_links_selected.gif | Bin 0 -> 793 bytes template/French/bilder/uebersicht_oben_rechts.gif | Bin 0 -> 769 bytes .../French/bilder/uebersicht_oben_rechts_sele.gif | Bin 0 -> 784 bytes .../French/bilder/uebersicht_oben_selected.gif | Bin 0 -> 2145 bytes template/French/bilder/uebersicht_rechts.gif | Bin 0 -> 906 bytes template/French/bilder/uebersicht_rechts_dark.gif | Bin 0 -> 906 bytes template/French/bilder/uebersicht_spacer.gif | Bin 0 -> 43 bytes template/French/bilder/uebersicht_unten.gif | Bin 0 -> 714 bytes template/French/bilder/uebersicht_unten_links.gif | Bin 0 -> 649 bytes template/French/bilder/uebersicht_unten_rechts.gif | Bin 0 -> 735 bytes .../French/bilder/uebersicht_unten_selected.gif | Bin 0 -> 714 bytes template/French/config.html | 320 + template/French/error.html | 18 + template/French/i18n.pl | 43 + template/French/index.html | 22 + template/French/left.html | 131 + template/French/navi.css | 11 + template/French/noauth.html | 13 + template/French/noperm.html | 12 + template/French/prog_detail.html | 33 + template/French/prog_list.html | 108 + template/French/prog_summary.html | 85 + template/French/rc.html | 110 + template/French/rec_list.html | 123 + template/French/style.css | 28 + template/French/timer_list.html | 161 + template/French/timer_new.html | 172 + template/French/toolbar.html | 40 + template/French/tv.html | 75 + udpc.pl | 1 + udpd.pl | 52 + vdradmind.at | 1 + vdradmind.bl_example | 2 + vdradmind.pl | 3894 ++++++++++++ 582 files changed, 43707 insertions(+) create mode 100644 COPYING create mode 100644 HISTORY create mode 100644 HISTORY.am create mode 100644 HISTORY.bigpatch create mode 100644 HISTORY.ct create mode 100644 HISTORY.macfly create mode 100644 INSTALL create mode 100644 Makefile create mode 100644 contrib/README.vdr-aio21_svdrprename.patch create mode 100755 contrib/findunusedimage.sh create mode 100644 contrib/gentoo.rc.vdradmind create mode 100644 contrib/vdr-1.2.0-recordings-length.diff create mode 100755 contrib/vdr-aio21_svdrprename.patch create mode 100644 lib/HTML/Template.pm create mode 100644 lib/HTML/Template/Expr.pm create mode 100644 lib/MIME/Base64.pm create mode 100644 lib/Parse/RecDescent.pm create mode 100644 lib/Template.pm create mode 100644 lib/Template/Base.pm create mode 100644 lib/Template/Config.pm create mode 100644 lib/Template/Constants.pm create mode 100644 lib/Template/Context.pm create mode 100644 lib/Template/Directive.pm create mode 100644 lib/Template/Document.pm create mode 100644 lib/Template/Exception.pm create mode 100644 lib/Template/Filters.pm create mode 100644 lib/Template/Grammar.pm create mode 100644 lib/Template/Iterator.pm create mode 100644 lib/Template/Namespace/Constants.pm create mode 100644 lib/Template/Parser.pm create mode 100644 lib/Template/Plugin.pm create mode 100644 lib/Template/Plugin/Date.pm create mode 100644 lib/Template/Plugins.pm create mode 100644 lib/Template/Provider.pm create mode 100644 lib/Template/Service.pm create mode 100644 lib/Template/Stash.pm create mode 100644 lib/Template/Stash/Context.pm create mode 100644 lib/Template/Stash/XS.pm create mode 100644 lib/Template/Test.pm create mode 100644 lib/Template/View.pm create mode 100644 lib/Text/Balanced.pm create mode 100644 template/Deutsch/at_new.html create mode 100644 template/Deutsch/at_timer_list.html create mode 100755 template/Deutsch/bilder/auge.jpg create mode 100644 template/Deutsch/bilder/back.gif create mode 100644 template/Deutsch/bilder/back.png create mode 100644 template/Deutsch/bilder/background.gif create mode 100644 template/Deutsch/bilder/cback.png create mode 100644 template/Deutsch/bilder/delete.gif create mode 100644 template/Deutsch/bilder/edit.gif create mode 100644 template/Deutsch/bilder/favicon.ico create mode 100644 template/Deutsch/bilder/fern_01.jpg create mode 100644 template/Deutsch/bilder/fern_02.jpg create mode 100644 template/Deutsch/bilder/fern_03.jpg create mode 100644 template/Deutsch/bilder/fern_04.jpg create mode 100644 template/Deutsch/bilder/fern_05.jpg create mode 100644 template/Deutsch/bilder/fern_06.jpg create mode 100644 template/Deutsch/bilder/fern_07.jpg create mode 100644 template/Deutsch/bilder/fern_08.jpg create mode 100644 template/Deutsch/bilder/fern_09.jpg create mode 100644 template/Deutsch/bilder/fern_10.jpg create mode 100644 template/Deutsch/bilder/fern_11.jpg create mode 100644 template/Deutsch/bilder/fern_12.jpg create mode 100644 template/Deutsch/bilder/fern_13.jpg create mode 100644 template/Deutsch/bilder/fern_14.jpg create mode 100644 template/Deutsch/bilder/fern_15.jpg create mode 100644 template/Deutsch/bilder/fern_16.jpg create mode 100644 template/Deutsch/bilder/fern_17.jpg create mode 100644 template/Deutsch/bilder/fern_18.jpg create mode 100644 template/Deutsch/bilder/fern_19.jpg create mode 100644 template/Deutsch/bilder/fern_20.jpg create mode 100644 template/Deutsch/bilder/fern_21.jpg create mode 100644 template/Deutsch/bilder/fern_22.jpg create mode 100644 template/Deutsch/bilder/fern_23.jpg create mode 100644 template/Deutsch/bilder/fern_24.jpg create mode 100644 template/Deutsch/bilder/fern_25.jpg create mode 100644 template/Deutsch/bilder/fern_26.jpg create mode 100644 template/Deutsch/bilder/fern_27.jpg create mode 100644 template/Deutsch/bilder/fern_28.jpg create mode 100644 template/Deutsch/bilder/fern_29.jpg create mode 100644 template/Deutsch/bilder/fern_30.jpg create mode 100644 template/Deutsch/bilder/fern_31.jpg create mode 100644 template/Deutsch/bilder/fern_32.jpg create mode 100644 template/Deutsch/bilder/fern_33.jpg create mode 100644 template/Deutsch/bilder/fern_34.jpg create mode 100644 template/Deutsch/bilder/fern_35.jpg create mode 100644 template/Deutsch/bilder/fern_36.jpg create mode 100644 template/Deutsch/bilder/fern_37.jpg create mode 100644 template/Deutsch/bilder/fern_38.jpg create mode 100644 template/Deutsch/bilder/fern_39.jpg create mode 100644 template/Deutsch/bilder/fern_40.jpg create mode 100644 template/Deutsch/bilder/fern_41.jpg create mode 100644 template/Deutsch/bilder/fern_42.jpg create mode 100644 template/Deutsch/bilder/fern_back.jpg create mode 100644 template/Deutsch/bilder/fernseher_unten.gif create mode 100644 template/Deutsch/bilder/folder.gif create mode 100644 template/Deutsch/bilder/frame.png create mode 100644 template/Deutsch/bilder/framed.gif create mode 100644 template/Deutsch/bilder/gbutton_left.gif create mode 100644 template/Deutsch/bilder/gbutton_middle.gif create mode 100644 template/Deutsch/bilder/gbutton_right.gif create mode 100644 template/Deutsch/bilder/help.gif create mode 100644 template/Deutsch/bilder/hilfe.gif create mode 100755 template/Deutsch/bilder/info.jpg create mode 100644 template/Deutsch/bilder/info_button.gif create mode 100644 template/Deutsch/bilder/info_button_disabled.gif create mode 100644 template/Deutsch/bilder/linvdr.gif create mode 100644 template/Deutsch/bilder/logo.gif create mode 100755 template/Deutsch/bilder/luecke.gif create mode 100755 template/Deutsch/bilder/lupe.jpg create mode 100644 template/Deutsch/bilder/mitte.gif create mode 100644 template/Deutsch/bilder/nav_button_back.gif create mode 100644 template/Deutsch/bilder/nav_button_back_end.gif create mode 100644 template/Deutsch/bilder/nav_button_back_mitte.gif create mode 100644 template/Deutsch/bilder/new_auto_timer.gif create mode 100644 template/Deutsch/bilder/new_timer.gif create mode 100644 template/Deutsch/bilder/pfeile_nachlinks.gif create mode 100644 template/Deutsch/bilder/pfeile_nachlinks_soft.gif create mode 100644 template/Deutsch/bilder/pfeile_nachrechts.gif create mode 100644 template/Deutsch/bilder/pfeile_nachrechts_soft.gif create mode 100644 template/Deutsch/bilder/poempl_gelb.gif create mode 100755 template/Deutsch/bilder/poempl_grau.gif create mode 100755 template/Deutsch/bilder/poempl_grau2.gif create mode 100644 template/Deutsch/bilder/poempl_gruen.gif create mode 100644 template/Deutsch/bilder/poempl_rot.gif create mode 100644 template/Deutsch/bilder/rec.gif create mode 100755 template/Deutsch/bilder/rec.jpg create mode 100644 template/Deutsch/bilder/rec_button.gif create mode 100644 template/Deutsch/bilder/rec_mitback.gif create mode 100644 template/Deutsch/bilder/rec_mitback2.jpg create mode 100644 template/Deutsch/bilder/remote.swf create mode 100644 template/Deutsch/bilder/sauerei.gif create mode 100644 template/Deutsch/bilder/separator.png create mode 100644 template/Deutsch/bilder/sortiert_asc.gif create mode 100644 template/Deutsch/bilder/sortiert_desc.gif create mode 100644 template/Deutsch/bilder/spacer.gif create mode 100644 template/Deutsch/bilder/stream.jpg create mode 100644 template/Deutsch/bilder/stream_mitback2.jpg create mode 100644 template/Deutsch/bilder/top.gif create mode 100644 template/Deutsch/bilder/top_nav_aufnahmen.gif create mode 100644 template/Deutsch/bilder/top_nav_fernbedienung.gif create mode 100644 template/Deutsch/bilder/top_nav_konf.gif create mode 100644 template/Deutsch/bilder/top_nav_prguebersicht.gif create mode 100644 template/Deutsch/bilder/top_nav_timer.gif create mode 100644 template/Deutsch/bilder/top_nav_wasjetzt.gif create mode 100644 template/Deutsch/bilder/tv_bottom.gif create mode 100644 template/Deutsch/bilder/tv_umschalten_mitback.gif create mode 100644 template/Deutsch/bilder/tv_umschalten_mitback2.jpg create mode 100644 template/Deutsch/bilder/uebersicht_links.gif create mode 100644 template/Deutsch/bilder/uebersicht_links_dark.gif create mode 100644 template/Deutsch/bilder/uebersicht_mitte.gif create mode 100644 template/Deutsch/bilder/uebersicht_mitte_dark.gif create mode 100644 template/Deutsch/bilder/uebersicht_mitte_dark_selected.gif create mode 100644 template/Deutsch/bilder/uebersicht_mitte_selected.gif create mode 100644 template/Deutsch/bilder/uebersicht_oben.gif create mode 100644 template/Deutsch/bilder/uebersicht_oben_links.gif create mode 100644 template/Deutsch/bilder/uebersicht_oben_links_selected.gif create mode 100644 template/Deutsch/bilder/uebersicht_oben_rechts.gif create mode 100644 template/Deutsch/bilder/uebersicht_oben_rechts_sele.gif create mode 100644 template/Deutsch/bilder/uebersicht_oben_selected.gif create mode 100644 template/Deutsch/bilder/uebersicht_rechts.gif create mode 100644 template/Deutsch/bilder/uebersicht_rechts_dark.gif create mode 100644 template/Deutsch/bilder/uebersicht_spacer.gif create mode 100644 template/Deutsch/bilder/uebersicht_unten.gif create mode 100644 template/Deutsch/bilder/uebersicht_unten_links.gif create mode 100644 template/Deutsch/bilder/uebersicht_unten_rechts.gif create mode 100644 template/Deutsch/bilder/uebersicht_unten_selected.gif create mode 100644 template/Deutsch/config.html create mode 100644 template/Deutsch/config.html.orig create mode 100755 template/Deutsch/copper/auge.jpg create mode 100644 template/Deutsch/copper/back.gif create mode 100644 template/Deutsch/copper/background.gif create mode 100644 template/Deutsch/copper/cback.gif create mode 100644 template/Deutsch/copper/cback.png create mode 100644 template/Deutsch/copper/delete.gif create mode 100644 template/Deutsch/copper/edit.gif create mode 100644 template/Deutsch/copper/fern_01.jpg create mode 100644 template/Deutsch/copper/fern_02.jpg create mode 100644 template/Deutsch/copper/fern_03.jpg create mode 100644 template/Deutsch/copper/fern_04.jpg create mode 100644 template/Deutsch/copper/fern_05.jpg create mode 100644 template/Deutsch/copper/fern_06.jpg create mode 100644 template/Deutsch/copper/fern_07.jpg create mode 100644 template/Deutsch/copper/fern_08.jpg create mode 100644 template/Deutsch/copper/fern_09.jpg create mode 100644 template/Deutsch/copper/fern_10.jpg create mode 100644 template/Deutsch/copper/fern_11.jpg create mode 100644 template/Deutsch/copper/fern_12.jpg create mode 100644 template/Deutsch/copper/fern_13.jpg create mode 100644 template/Deutsch/copper/fern_14.jpg create mode 100644 template/Deutsch/copper/fern_15.jpg create mode 100644 template/Deutsch/copper/fern_16.jpg create mode 100644 template/Deutsch/copper/fern_17.jpg create mode 100644 template/Deutsch/copper/fern_18.jpg create mode 100644 template/Deutsch/copper/fern_19.jpg create mode 100644 template/Deutsch/copper/fern_20.jpg create mode 100644 template/Deutsch/copper/fern_21.jpg create mode 100644 template/Deutsch/copper/fern_22.jpg create mode 100644 template/Deutsch/copper/fern_23.jpg create mode 100644 template/Deutsch/copper/fern_24.jpg create mode 100644 template/Deutsch/copper/fern_25.jpg create mode 100644 template/Deutsch/copper/fern_26.jpg create mode 100644 template/Deutsch/copper/fern_27.jpg create mode 100644 template/Deutsch/copper/fern_28.jpg create mode 100644 template/Deutsch/copper/fern_29.jpg create mode 100644 template/Deutsch/copper/fern_30.jpg create mode 100644 template/Deutsch/copper/fern_31.jpg create mode 100644 template/Deutsch/copper/fern_32.jpg create mode 100644 template/Deutsch/copper/fern_33.jpg create mode 100644 template/Deutsch/copper/fern_34.jpg create mode 100644 template/Deutsch/copper/fern_35.jpg create mode 100644 template/Deutsch/copper/fern_36.jpg create mode 100644 template/Deutsch/copper/fern_37.jpg create mode 100644 template/Deutsch/copper/fern_38.jpg create mode 100644 template/Deutsch/copper/fern_39.jpg create mode 100644 template/Deutsch/copper/fern_40.jpg create mode 100644 template/Deutsch/copper/fern_41.jpg create mode 100644 template/Deutsch/copper/fern_42.jpg create mode 100755 template/Deutsch/copper/fern_back.jpg create mode 100644 template/Deutsch/copper/fernseher_unten.gif create mode 100644 template/Deutsch/copper/folder.gif create mode 100644 template/Deutsch/copper/frame.gif create mode 100644 template/Deutsch/copper/framed.gif create mode 100644 template/Deutsch/copper/gbutton_left.gif create mode 100644 template/Deutsch/copper/gbutton_middle.gif create mode 100644 template/Deutsch/copper/gbutton_right.gif create mode 100644 template/Deutsch/copper/help.gif create mode 100644 template/Deutsch/copper/hilfe.gif create mode 100755 template/Deutsch/copper/info.jpg create mode 100644 template/Deutsch/copper/info_button.gif create mode 100644 template/Deutsch/copper/info_button_disabled.gif create mode 100644 template/Deutsch/copper/linvdr.gif create mode 100644 template/Deutsch/copper/logo.gif create mode 100755 template/Deutsch/copper/luecke.gif create mode 100755 template/Deutsch/copper/lupe.jpg create mode 100644 template/Deutsch/copper/mitte.gif create mode 100644 template/Deutsch/copper/nav_button_back.gif create mode 100644 template/Deutsch/copper/nav_button_back_end.gif create mode 100644 template/Deutsch/copper/nav_button_back_mitte.gif create mode 100644 template/Deutsch/copper/navi.css create mode 100644 template/Deutsch/copper/new_auto_timer.gif create mode 100644 template/Deutsch/copper/new_timer.gif create mode 100644 template/Deutsch/copper/pfeile_nachlinks.gif create mode 100644 template/Deutsch/copper/pfeile_nachlinks_soft.gif create mode 100644 template/Deutsch/copper/pfeile_nachrechts.gif create mode 100644 template/Deutsch/copper/pfeile_nachrechts_soft.gif create mode 100644 template/Deutsch/copper/poempl_gelb.gif create mode 100644 template/Deutsch/copper/poempl_gruen.gif create mode 100644 template/Deutsch/copper/poempl_rot.gif create mode 100644 template/Deutsch/copper/rec.gif create mode 100755 template/Deutsch/copper/rec.jpg create mode 100644 template/Deutsch/copper/rec_button.gif create mode 100644 template/Deutsch/copper/rec_mitback.gif create mode 100644 template/Deutsch/copper/sauerei.gif create mode 100644 template/Deutsch/copper/separator.gif create mode 100644 template/Deutsch/copper/sortiert_asc.gif create mode 100644 template/Deutsch/copper/sortiert_desc.gif create mode 100644 template/Deutsch/copper/spacer.gif create mode 100644 template/Deutsch/copper/style.css create mode 100644 template/Deutsch/copper/top.gif create mode 100644 template/Deutsch/copper/top_nav_aufnahmen.gif create mode 100644 template/Deutsch/copper/top_nav_fernbedienung.gif create mode 100644 template/Deutsch/copper/top_nav_konf.gif create mode 100644 template/Deutsch/copper/top_nav_prguebersicht.gif create mode 100644 template/Deutsch/copper/top_nav_timer.gif create mode 100644 template/Deutsch/copper/top_nav_wasjetzt.gif create mode 100644 template/Deutsch/copper/tv_bottom.gif create mode 100644 template/Deutsch/copper/tv_umschalten_mitback.gif create mode 100644 template/Deutsch/copper/uebersicht_links.gif create mode 100644 template/Deutsch/copper/uebersicht_links_dark.gif create mode 100644 template/Deutsch/copper/uebersicht_mitte.gif create mode 100644 template/Deutsch/copper/uebersicht_mitte_dark.gif create mode 100644 template/Deutsch/copper/uebersicht_mitte_dark_selec.gif create mode 100644 template/Deutsch/copper/uebersicht_mitte_selected.gif create mode 100644 template/Deutsch/copper/uebersicht_oben.gif create mode 100644 template/Deutsch/copper/uebersicht_oben_links.gif create mode 100644 template/Deutsch/copper/uebersicht_oben_links_selec.gif create mode 100644 template/Deutsch/copper/uebersicht_oben_rechts.gif create mode 100644 template/Deutsch/copper/uebersicht_oben_rechts_sele.gif create mode 100644 template/Deutsch/copper/uebersicht_oben_selected.gif create mode 100644 template/Deutsch/copper/uebersicht_rechts.gif create mode 100644 template/Deutsch/copper/uebersicht_rechts_dark.gif create mode 100644 template/Deutsch/copper/uebersicht_spacer.gif create mode 100644 template/Deutsch/copper/uebersicht_unten.gif create mode 100644 template/Deutsch/copper/uebersicht_unten_links.gif create mode 100644 template/Deutsch/copper/uebersicht_unten_rechts.gif create mode 100644 template/Deutsch/copper/uebersicht_unten_selected.gif create mode 100644 template/Deutsch/error.html create mode 100644 template/Deutsch/favicon.ico create mode 100644 template/Deutsch/i18n.pl create mode 100644 template/Deutsch/index.html create mode 100644 template/Deutsch/left.html create mode 100644 template/Deutsch/library.js create mode 100644 template/Deutsch/navi.css create mode 100644 template/Deutsch/noauth.html create mode 100644 template/Deutsch/noperm.html create mode 100644 template/Deutsch/prog_detail.html create mode 100644 template/Deutsch/prog_list.html create mode 100644 template/Deutsch/prog_list2.html create mode 100644 template/Deutsch/prog_summary.html create mode 100755 template/Deutsch/prog_timeline.html create mode 100644 template/Deutsch/rc.html create mode 100644 template/Deutsch/rec_edit.html create mode 100644 template/Deutsch/rec_list.html create mode 100644 template/Deutsch/style.css create mode 100644 template/Deutsch/timer_list.html create mode 100644 template/Deutsch/timer_new.html create mode 100644 template/Deutsch/toolbar.html create mode 100644 template/Deutsch/tv.html create mode 100644 template/Deutsch/tv.html.bak create mode 100644 template/Deutsch/tv_flash.html create mode 100644 template/English/at_new.html create mode 100644 template/English/at_timer_list.html create mode 100644 template/English/bilder/back.gif create mode 100644 template/English/bilder/back.png create mode 100644 template/English/bilder/background.gif create mode 100644 template/English/bilder/cback.png create mode 100644 template/English/bilder/delete.gif create mode 100644 template/English/bilder/edit.gif create mode 100644 template/English/bilder/favicon.ico create mode 100644 template/English/bilder/fern_01.jpg create mode 100644 template/English/bilder/fern_02.jpg create mode 100644 template/English/bilder/fern_03.jpg create mode 100644 template/English/bilder/fern_04.jpg create mode 100644 template/English/bilder/fern_05.jpg create mode 100644 template/English/bilder/fern_06.jpg create mode 100644 template/English/bilder/fern_07.jpg create mode 100644 template/English/bilder/fern_08.jpg create mode 100644 template/English/bilder/fern_09.jpg create mode 100644 template/English/bilder/fern_10.jpg create mode 100644 template/English/bilder/fern_11.jpg create mode 100644 template/English/bilder/fern_12.jpg create mode 100644 template/English/bilder/fern_13.jpg create mode 100644 template/English/bilder/fern_14.jpg create mode 100644 template/English/bilder/fern_15.jpg create mode 100644 template/English/bilder/fern_16.jpg create mode 100644 template/English/bilder/fern_17.jpg create mode 100644 template/English/bilder/fern_18.jpg create mode 100644 template/English/bilder/fern_19.jpg create mode 100644 template/English/bilder/fern_20.jpg create mode 100644 template/English/bilder/fern_21.jpg create mode 100644 template/English/bilder/fern_22.jpg create mode 100644 template/English/bilder/fern_23.jpg create mode 100644 template/English/bilder/fern_24.jpg create mode 100644 template/English/bilder/fern_25.jpg create mode 100644 template/English/bilder/fern_26.jpg create mode 100644 template/English/bilder/fern_27.jpg create mode 100644 template/English/bilder/fern_28.jpg create mode 100644 template/English/bilder/fern_29.jpg create mode 100644 template/English/bilder/fern_30.jpg create mode 100644 template/English/bilder/fern_31.jpg create mode 100644 template/English/bilder/fern_32.jpg create mode 100644 template/English/bilder/fern_33.jpg create mode 100644 template/English/bilder/fern_34.jpg create mode 100644 template/English/bilder/fern_35.jpg create mode 100644 template/English/bilder/fern_36.jpg create mode 100644 template/English/bilder/fern_37.jpg create mode 100644 template/English/bilder/fern_38.jpg create mode 100644 template/English/bilder/fern_39.jpg create mode 100644 template/English/bilder/fern_40.jpg create mode 100644 template/English/bilder/fern_41.jpg create mode 100644 template/English/bilder/fern_42.jpg create mode 100644 template/English/bilder/fern_back.jpg create mode 100644 template/English/bilder/fernseher_unten.gif create mode 100644 template/English/bilder/folder.gif create mode 100644 template/English/bilder/frame.png create mode 100644 template/English/bilder/framed.gif create mode 100644 template/English/bilder/gbutton_left.gif create mode 100644 template/English/bilder/gbutton_middle.gif create mode 100644 template/English/bilder/gbutton_right.gif create mode 100644 template/English/bilder/help.gif create mode 100644 template/English/bilder/hilfe.gif create mode 100644 template/English/bilder/info_button.gif create mode 100644 template/English/bilder/info_button_disabled.gif create mode 100644 template/English/bilder/linvdr.gif create mode 100644 template/English/bilder/logo.gif create mode 100644 template/English/bilder/mitte.gif create mode 100644 template/English/bilder/nav_button_back.gif create mode 100644 template/English/bilder/nav_button_back_end.gif create mode 100644 template/English/bilder/nav_button_back_mitte.gif create mode 100644 template/English/bilder/new_auto_timer.gif create mode 100644 template/English/bilder/new_timer.gif create mode 100644 template/English/bilder/pfeile_nachlinks.gif create mode 100644 template/English/bilder/pfeile_nachlinks_soft.gif create mode 100644 template/English/bilder/pfeile_nachrechts.gif create mode 100644 template/English/bilder/pfeile_nachrechts_soft.gif create mode 100644 template/English/bilder/poempl_gelb.gif create mode 100644 template/English/bilder/poempl_gruen.gif create mode 100644 template/English/bilder/poempl_rot.gif create mode 100644 template/English/bilder/rec.gif create mode 100644 template/English/bilder/rec_button.gif create mode 100644 template/English/bilder/rec_mitback.gif create mode 100644 template/English/bilder/remote.swf create mode 100644 template/English/bilder/sauerei.gif create mode 100644 template/English/bilder/separator.png create mode 100644 template/English/bilder/sortiert_asc.gif create mode 100644 template/English/bilder/sortiert_desc.gif create mode 100644 template/English/bilder/spacer.gif create mode 100644 template/English/bilder/top.gif create mode 100644 template/English/bilder/top_nav_aufnahmen.gif create mode 100644 template/English/bilder/top_nav_fernbedienung.gif create mode 100644 template/English/bilder/top_nav_konf.gif create mode 100644 template/English/bilder/top_nav_prguebersicht.gif create mode 100644 template/English/bilder/top_nav_timer.gif create mode 100644 template/English/bilder/top_nav_wasjetzt.gif create mode 100644 template/English/bilder/tv_bottom.gif create mode 100644 template/English/bilder/tv_umschalten_mitback.gif create mode 100644 template/English/bilder/uebersicht_links.gif create mode 100644 template/English/bilder/uebersicht_links_dark.gif create mode 100644 template/English/bilder/uebersicht_mitte.gif create mode 100644 template/English/bilder/uebersicht_mitte_dark.gif create mode 100644 template/English/bilder/uebersicht_mitte_dark_selected.gif create mode 100644 template/English/bilder/uebersicht_mitte_selected.gif create mode 100644 template/English/bilder/uebersicht_oben.gif create mode 100644 template/English/bilder/uebersicht_oben_links.gif create mode 100644 template/English/bilder/uebersicht_oben_links_selected.gif create mode 100644 template/English/bilder/uebersicht_oben_rechts.gif create mode 100644 template/English/bilder/uebersicht_oben_rechts_sele.gif create mode 100644 template/English/bilder/uebersicht_oben_selected.gif create mode 100644 template/English/bilder/uebersicht_rechts.gif create mode 100644 template/English/bilder/uebersicht_rechts_dark.gif create mode 100644 template/English/bilder/uebersicht_spacer.gif create mode 100644 template/English/bilder/uebersicht_unten.gif create mode 100644 template/English/bilder/uebersicht_unten_links.gif create mode 100644 template/English/bilder/uebersicht_unten_rechts.gif create mode 100644 template/English/bilder/uebersicht_unten_selected.gif create mode 100644 template/English/config.html create mode 100644 template/English/error.html create mode 100644 template/English/i18n.pl create mode 100644 template/English/index.html create mode 100644 template/English/left.html create mode 100644 template/English/navi.css create mode 100644 template/English/noauth.html create mode 100644 template/English/noperm.html create mode 100644 template/English/prog_detail.html create mode 100644 template/English/prog_list.html create mode 100644 template/English/prog_summary.html create mode 100644 template/English/rc.html create mode 100644 template/English/rec_list.html create mode 100644 template/English/style.css create mode 100644 template/English/timer_list.html create mode 100644 template/English/timer_new.html create mode 100644 template/English/toolbar.html create mode 100644 template/English/tv.html create mode 100644 template/French/at_new.html create mode 100644 template/French/at_timer_list.html create mode 100644 template/French/bilder/back.gif create mode 100644 template/French/bilder/back.png create mode 100644 template/French/bilder/background.gif create mode 100644 template/French/bilder/cback.png create mode 100644 template/French/bilder/delete.gif create mode 100644 template/French/bilder/edit.gif create mode 100644 template/French/bilder/favicon.ico create mode 100644 template/French/bilder/fern_01.jpg create mode 100644 template/French/bilder/fern_02.jpg create mode 100644 template/French/bilder/fern_03.jpg create mode 100644 template/French/bilder/fern_04.jpg create mode 100644 template/French/bilder/fern_05.jpg create mode 100644 template/French/bilder/fern_06.jpg create mode 100644 template/French/bilder/fern_07.jpg create mode 100644 template/French/bilder/fern_08.jpg create mode 100644 template/French/bilder/fern_09.jpg create mode 100644 template/French/bilder/fern_10.jpg create mode 100644 template/French/bilder/fern_11.jpg create mode 100644 template/French/bilder/fern_12.jpg create mode 100644 template/French/bilder/fern_13.jpg create mode 100644 template/French/bilder/fern_14.jpg create mode 100644 template/French/bilder/fern_15.jpg create mode 100644 template/French/bilder/fern_16.jpg create mode 100644 template/French/bilder/fern_17.jpg create mode 100644 template/French/bilder/fern_18.jpg create mode 100644 template/French/bilder/fern_19.jpg create mode 100644 template/French/bilder/fern_20.jpg create mode 100644 template/French/bilder/fern_21.jpg create mode 100644 template/French/bilder/fern_22.jpg create mode 100644 template/French/bilder/fern_23.jpg create mode 100644 template/French/bilder/fern_24.jpg create mode 100644 template/French/bilder/fern_25.jpg create mode 100644 template/French/bilder/fern_26.jpg create mode 100644 template/French/bilder/fern_27.jpg create mode 100644 template/French/bilder/fern_28.jpg create mode 100644 template/French/bilder/fern_29.jpg create mode 100644 template/French/bilder/fern_30.jpg create mode 100644 template/French/bilder/fern_31.jpg create mode 100644 template/French/bilder/fern_32.jpg create mode 100644 template/French/bilder/fern_33.jpg create mode 100644 template/French/bilder/fern_34.jpg create mode 100644 template/French/bilder/fern_35.jpg create mode 100644 template/French/bilder/fern_36.jpg create mode 100644 template/French/bilder/fern_37.jpg create mode 100644 template/French/bilder/fern_38.jpg create mode 100644 template/French/bilder/fern_39.jpg create mode 100644 template/French/bilder/fern_40.jpg create mode 100644 template/French/bilder/fern_41.jpg create mode 100644 template/French/bilder/fern_42.jpg create mode 100644 template/French/bilder/fern_back.jpg create mode 100644 template/French/bilder/fernseher_unten.gif create mode 100644 template/French/bilder/folder.gif create mode 100644 template/French/bilder/frame.png create mode 100644 template/French/bilder/framed.gif create mode 100644 template/French/bilder/gbutton_left.gif create mode 100644 template/French/bilder/gbutton_middle.gif create mode 100644 template/French/bilder/gbutton_right.gif create mode 100644 template/French/bilder/help.gif create mode 100644 template/French/bilder/hilfe.gif create mode 100644 template/French/bilder/info_button.gif create mode 100644 template/French/bilder/info_button_disabled.gif create mode 100644 template/French/bilder/linvdr.gif create mode 100644 template/French/bilder/logo.gif create mode 100644 template/French/bilder/mitte.gif create mode 100644 template/French/bilder/nav_button_back.gif create mode 100644 template/French/bilder/nav_button_back_end.gif create mode 100644 template/French/bilder/nav_button_back_mitte.gif create mode 100644 template/French/bilder/new_auto_timer.gif create mode 100644 template/French/bilder/new_timer.gif create mode 100644 template/French/bilder/pfeile_nachlinks.gif create mode 100644 template/French/bilder/pfeile_nachlinks_soft.gif create mode 100644 template/French/bilder/pfeile_nachrechts.gif create mode 100644 template/French/bilder/pfeile_nachrechts_soft.gif create mode 100644 template/French/bilder/poempl_gelb.gif create mode 100644 template/French/bilder/poempl_gruen.gif create mode 100644 template/French/bilder/poempl_rot.gif create mode 100644 template/French/bilder/rec.gif create mode 100644 template/French/bilder/rec_button.gif create mode 100644 template/French/bilder/rec_mitback.gif create mode 100644 template/French/bilder/remote.swf create mode 100644 template/French/bilder/sauerei.gif create mode 100644 template/French/bilder/separator.png create mode 100644 template/French/bilder/sortiert_asc.gif create mode 100644 template/French/bilder/sortiert_desc.gif create mode 100644 template/French/bilder/spacer.gif create mode 100644 template/French/bilder/top.gif create mode 100644 template/French/bilder/top_nav_aufnahmen.gif create mode 100644 template/French/bilder/top_nav_fernbedienung.gif create mode 100644 template/French/bilder/top_nav_konf.gif create mode 100644 template/French/bilder/top_nav_prguebersicht.gif create mode 100644 template/French/bilder/top_nav_timer.gif create mode 100644 template/French/bilder/top_nav_wasjetzt.gif create mode 100644 template/French/bilder/tv_bottom.gif create mode 100644 template/French/bilder/tv_umschalten_mitback.gif create mode 100644 template/French/bilder/uebersicht_links.gif create mode 100644 template/French/bilder/uebersicht_links_dark.gif create mode 100644 template/French/bilder/uebersicht_mitte.gif create mode 100644 template/French/bilder/uebersicht_mitte_dark.gif create mode 100644 template/French/bilder/uebersicht_mitte_dark_selected.gif create mode 100644 template/French/bilder/uebersicht_mitte_selected.gif create mode 100644 template/French/bilder/uebersicht_oben.gif create mode 100644 template/French/bilder/uebersicht_oben_links.gif create mode 100644 template/French/bilder/uebersicht_oben_links_selected.gif create mode 100644 template/French/bilder/uebersicht_oben_rechts.gif create mode 100644 template/French/bilder/uebersicht_oben_rechts_sele.gif create mode 100644 template/French/bilder/uebersicht_oben_selected.gif create mode 100644 template/French/bilder/uebersicht_rechts.gif create mode 100644 template/French/bilder/uebersicht_rechts_dark.gif create mode 100644 template/French/bilder/uebersicht_spacer.gif create mode 100644 template/French/bilder/uebersicht_unten.gif create mode 100644 template/French/bilder/uebersicht_unten_links.gif create mode 100644 template/French/bilder/uebersicht_unten_rechts.gif create mode 100644 template/French/bilder/uebersicht_unten_selected.gif create mode 100644 template/French/config.html create mode 100644 template/French/error.html create mode 100644 template/French/i18n.pl create mode 100644 template/French/index.html create mode 100644 template/French/left.html create mode 100644 template/French/navi.css create mode 100644 template/French/noauth.html create mode 100644 template/French/noperm.html create mode 100644 template/French/prog_detail.html create mode 100644 template/French/prog_list.html create mode 100644 template/French/prog_summary.html create mode 100644 template/French/rc.html create mode 100644 template/French/rec_list.html create mode 100644 template/French/style.css create mode 100644 template/French/timer_list.html create mode 100644 template/French/timer_new.html create mode 100644 template/French/toolbar.html create mode 100644 template/French/tv.html create mode 120000 udpc.pl create mode 100755 udpd.pl create mode 100644 vdradmind.at create mode 100644 vdradmind.bl_example create mode 100755 vdradmind.pl diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..a43ea21 --- /dev/null +++ b/COPYING @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 675 Mass Ave, Cambridge, MA 02139, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19yy name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. diff --git a/HISTORY b/HISTORY new file mode 100644 index 0000000..8b6a331 --- /dev/null +++ b/HISTORY @@ -0,0 +1,359 @@ +v0.97 -- unknown (taken from linvdr 0.7) + +v0.96 -- tom -- Tue Apr 6 15:43:16 CEST 2004 + - Reworked timer collision detection (Thanks to Cooper) + - Corrected Power button link in the remote control (Thanks to Tobias Grimm) + - Solved some javascript issues + +v0.95 -- tom -- Sat Dec 13 14:55:04 CET 2003 + - Added support to listen on specific network adresses (Thanks to + Ludwig Nussel) + - Added two new parameters (--message, --displaycall) + - Added some code from the "vdradmin BigPatch" + - Added help system + Fixed Bugs: + - AutoTimer does not work correct if the specified time range goes over + midnight (Thanks to Cooper) + - Solved the "daylight saving" problem (2h offset) + - Solved some problems with gzip compression + +v0.94 -- tom, mdo -- Mon Aug 18 06:32:47 CEST 2003 + - Cleared up some things in the "timer new"/"timer edit" form: + We have now a new line for automatic timer correction, possible values + are "program ID" for the Event-ID as key, "recording time" for the start/end + time of the recording as keys, and "disabled" for uncorrected timers. + - There are two new variables which can be added to the config file + vdradmind.conf by hand (no fronted support!): + NO_EVENTID = 1 + and + NO_EVENTID_ON = 23,24,25 + will disable the usage of event-ids in general or on channels 23 to 25 for + all new timers. + So the automatic timer correction -- both for auto timers and for manual + edited -- will fall back to "recording time" mode. This is interesting for + channels where the Event-ID changes between first show-up in the EPG and + the event (thanks to Jan Ekholm for the idea and his help with debugging). + - New search string handling in AutoTimer: + /regexp/ + and + /regexp/i + are perl regular expression, the second one is case insensitive. + The regexp is testet against a string of the form: + title~subtitle~summary + As you see, all checked fields in the AutoTimer edit form are separated + by a tilde (~). So you can explicitly search the title, subtitle and + summary entry for matches. + I advise you not to use any regular expressions in the AutoTimer, never! + There is absolutely *no* syntax check for the regexp! Leave a stray + brace and see vdradmin dying (because of a perl syntax error), or enter + something like "/.*/" to beam the entire EPG into the timer list and watch + VDR dying under the tons of timers. + Don't write bug reports if a regexp has filled your harddisk to the very + last bit, messed your timer list or killed your VDR: I told you not to use + regular expressions! Don't even think about it! + All non-regexp are now threatened as space separated list of patterns + without any wildcards: Dots are a real dots, braces are real braces, + and little furry things from Centaur 5 are real little furry things from + Centaur 5. + Fixed Bugs: + - Month in "Whats on now" calculated wrong (Thanks to Thomas Schmidt) + - Day in Event detail calculated wrong (Thanks to Thomas Schmidt) + +v0.93 -- tom -- Tue Jul 15 12:09:34 CEST 2003 + Fixed Bugs: + - Several issues with the Internet Explorer + - Doesn't delete a recording timer + +v0.93 -- mdo -- + - The 16th bit of the status field of timers will now be used for indicating + automatically revised timers ("Auto"). Old timers with status "Auto", using + the now deprecated third bit (see v0.24-pre13-mdo), will *in this version* + be described as "Auto (alt)" or "Auto (old)" in the timer list. Editing an + timer with status "Auto (old)" will correct the flag properly. + + CAUTION! Using the third bit (as in v0.24-pre13-mdo up to v0.92) is now + *deprecated* and the support for the third bit will *definitively* be + removed in the next version of vdradmin! Due this change only affects + single timers, all old timers will disappear within the next month -- new + "Auto" timers will be programmed properly. So before updating to the next + version of vdradmin (probably v0.94), check that you don't have any old + "Auto" timers left, or they won't be observed/revised any longer (but work + anyway). + +v0.92 -- tom -- Tue Jul 4 10:49:13 CEST 2003 + Fixed Bugs: + - Several things in the log mechanism + - Can't delete multiple Auto Timers at once (Thanks to Tom Pfeifer) + - Sometimes wrong display of rec icon (Thanks to Tom Pfeifer) + - Recordings frame missing if no recordings on disk (Thanks to Tom Pfeiffer) + +v0.91 -- tom -- Wed Jun 18 07:36:40 CEST 2003 + - Added "Directory" option in Auto Timer (Suggested by Christian Jacobsen) + Fixed Bugs: + - Can't save complex timer (Thanks to Tom Pfeifer) + +v0.90 -- tom -- Sun Jun 15 01:20:00 CEST 2003 + - New German layout (Thanks to Uwe Kempf) + - Translated layout to English + - Translated layout to French (Thanks to Olivier Jacques and Laurent DUPERREY) + - subfolders in recordings (like in VDR) + - Added TV mode + - show disk usage in recordings menu (require VDR 1.1.29) + - added "install" target, this is mainly for distributors + - Reworked Auto Timer (Thanks to cooper) + Fixed bugs: + - Small patch to make vdradmin work together with the analogtv plugin + (Thanks to Andreas Kool) + - Added patch to make apache 2.0.40 with it's mod_proxy happy + (Thanks to Thomas Sailer) + - many, many other small things i don't remember + +v0.24-pre13-mdo -- cooper -- Tue May 27 03:10:39 CEST 2003 + - major changes in AutoTimer(): + - for each autotimer the event_id from the EPG will be stored in the + higher 16 bits of the status value in the timers.conf. Be prepared + to see huge and tiny (negative) numbers in the timers list! + - for all autotimers, the 3rd bit in the status value (first row in + timers.conf) will be set, along with the 1st bit (plus the high + 16 bit as mentioned before) + - will only programm new timers, changing existing timers is now the + job of CheckTimers() + - AutoTimer() will only add new timers, if the event_id and the channel + number of the desired event are not in the current timers.conf. If + there is no event_id, AutoTimer() will check for the name and start time + like in privious versions of vdradmin + - new function CheckTimers(): + - is called every time just before AutoTimer() + - will check every timer of timers.conf with the 3rd bit set in the status + value: + - if there is an event_id, CheckTimers() will search a event with the + same event_id on the same channel in the EPG, and then set title, + subtitle, start/stop time, day of recording and summary according to + the EPG entry. If there is no matching event_id, nothing happens. + - without event_id, CheckTimers() looks for events in the EPG within + the margins of the timer, then do a wighting. For the event with the + highest wight, CheckTimers() extends the margings of the timer so + the event will be fully covered, plus extra time. This will probably + fail when multiple events of 10 minutes duration or shorter are within + the timer margins -- due the timer will only be extended but never + shortened, this should be no real problem. The title of the event is + unchecked. If there is no matching EPG entry, nothing happens. + - other changes: + - the default status for new timers is now 5 (equal to "Auto"), which + means they'll be handled by CheckTimers(), an the event_id will be set. + CheckTimers() will, as described above, change start/stop time and some + more according to the current EPG. To get rid off the automatic + observation, set the status to 0 or 1 (Yes/Ja or No/Nein). The side + effect is that you'll lose the event_id, and if you set the status back + to "Auto" again, CheckTimers() will use the "without event_id" branch + to extend the timer margins. + - side effects: + - the status field (first row) of timers.conf will contain very huge and + tiny numbers between -2147483647 and 2147483647, instead of 0, 1 and 3. + While this is fully covered by Klaus' documentation, it could be some + surprise to other programms parsing the timers.conf or reading the timers + list via lstt from SVDRP, like Master Timer and others. + - editing a timer via VDR will cause the loss of the event_id and set the + status back to 0 or 1 -- so CheckTimers() won't touch it no longer. This + is a feature. + - the start time of observed timers might be changed while VDR is + recording -- resulting in a new file and a little gap between the two + recordings. Should be fixed somewhen. + - observed timers with ":" in the name will cause unnecessary timer + updates because the ":" will cause an inequality between timer title + and event title. + - the title of obeserved timers will be extended automatically by the + subtitle (when in EPG), even if the original title was without subtitle. + - double recordings (same start time, same title) are now very improbable, + but still possible. Should be managed by CheckTimers() somewhen... + +v0.23 -- tom -- Sat Feb 15 22:46:01 CET 2003 + - Now delivering compressed data (like mod_gzip) if the browser accept this. + This makes vdradmin much faster on slow connections. This is experimental, + so if you have problems with this set MOD_GZIP to 0 in your vdradmin.conf. + Fixed Bugs: + - Now opening remote control with target _blank (Thanks to Martin Hillmann) + - Saving timers don't work if priority or lifetime less then 10 (Thanks + to _cooper_) + - Fixed typo in english configuration page (Thanks to Briandorling) + +v0.22 -- tom -- Thu Jan 16 14:08:31 CET 2003 + - Reworked timer sort routine + - Included virtual remote control + Fixed bugs: + - some small layout things + +v0.21 -- tom -- Mon Dec 30 22:34:37 CET 2002 + - Added guest account + - Startpage is now selectable + Fixed Bugs: + - Several things in the Autotimer + +v0.20 -- tom -- Thu Dec 26 13:21:39 CET 2002 + Fixed Bugs: + - Using wrong variable to connect to vdr + +v0.19 -- tom -- Thu Dec 26 03:20:12 CET 2002 + Fixed Bugs: + - Pictures are no longer missing + - "--config" sets wrong variables + - Timer sometimes disapeared + - AutoTimer doesnt run after timeout + - Cant save complex timers + - many other small things... + +v0.18 -- tom -- Tue Dec 17 20:52:09 CET 2002 + - vdradmin does not longer use HTTP::Daemon + - updated english translation + +v0.17 -- tom -- Mon Dec 16 14:19:28 CET 2002 + - Channels without EPG-data are not longer displayed in program list + - No longer add spaces to Summary when changing Timer (Thanks to _cooper_) + - Sorts repeating Timers like VDR (Thanks to Emil Naepflein) + - Three colors shows how timers conflicts with other timers (Thanks to Emil Naepflein) + - Now using HTTP::Daemon to comunicate with clients + - vdradmin knows about first-day timers + - Code cleanup + - Some other things i dont remember + +v0.16 -- tom -- Sun Jun 9 14:58:57 CEST 2002 + Fixed Bugs: + - Auto Timer does nothing if no end time was given + (this bug was introduced in v0.15) + +v0.15 -- tom -- Son Jun 2 17:32:44 CEST 2002 + Fixed Bugs: + - vdradmin exits with "Bad arg length for Socket::unpack..." + under some perl versions. (Thanks to Juergen Schmidt) + - Saving Auto Timers doesnt work in English theme + - Selecting channels for a new Auto Timer doesnt work in German theme. + - Auto Timer does not work if the timer goes across midnight + _and_ the start time is beyond midnight (Thanks to Andrea Schultz). + +v0.14 -- tom -- Sat Apr 13 13:33:00 CEST 2002 + + - English translation added (Thanks to Thilo Wunderlich and Simon Dean) + - Translations / Themes are stored in subdirectorys (suggested by + Thilo Wunderlich) + - internationalized days of week (see template//i18n.pl) + - Changed names of Language. If you wish to use your old vdradmind.conf + change "LANG = de" in "LANG = Deutsch". + + Fixed Bugs: + - Sometimes the language could not be changed. + - Priotity in Auto Timer was lost in some cases. + - State row in channels view was lost if the Broadcaster has no EPG + - Various small things coming with the internationalisation + +v0.13 -- tom -- Mit Mar 6 21:09:02 CET 2002 + + - Added `switch to channel´ function in program overview. + - Fixed date bug with vdr > 1.0.0pre1 + +v0.12 -- tom -- Fre Feb 15 19:44:26 CET 2002 + + - vdradmin crashed when deleting a timer. fixed. + - Fixed many bugs in the timer section + - vdradmin is now compatible with apache & mod_proxy + (thanks to Marcel Walter) + +v0.11 -- tom -- Tue Feb 5 21:25:21 CET 2002 + + - Renamed configuration file. "conffile" -> "vdradmind.conf". If you + wish to use your old configuration file, rename it manualy. + - Added "auto timer" function. + - In timer and recordings menu, multiple entrys can be deleted at once + - Some layout changes + +v0.10 -- tom -- Sam Jan 26 18:27:24 CET 2002 + + - Added complex timer handling + - Fixed broken pipe messages + - Some layout changes + - Modified search function, it does not longer search the exact pattern + (eg. ´one two´ does not search the exact pattern, it now means one + _and_ two) + - When creating a new timer, the timer is activated by default + - After creating a timer from program overview or list you will redirected + where you have been (instead of showing timer overview) + +v0.9 -- tom -- Tue Dec 11 13:38:22 CET 2001 + + - Whoops, fixed stupid bug in recordings sort mechanism + - Added configuration mechanism (--config) + - Added kill parameter (--kill) + - Added prev/next link in program listing + - Adding multiple channels in positive list fails if the list is empty. Fixed. + +v0.8 -- tom -- Sun Dec 2 11:55:43 CET 2001 + + - Time was calculated wrong in recordings section + +v0.7 -- tom -- Sat Dec 1 17:19:48 CET 2001 + + - vdradmin exits with error message if no recording exists. Fixed. + - Added a option which allowes to see only selected channels in program list + - List of recordings now sortable by date, time and name + - Sorted timers + - Time was calculated wrong in the timers section, month's range is 0-11 + not 1-12 + +v0.6 -- tom -- Sun Nov 25 17:31:02 CET 2001 + + - Broadcasters now sorted case insensitive in channel overview + - Encoded '&' very special since IE is too stupid to handle this correctly + - Seperated events in channel list by days + - Sorted recordings by date _and_ time + - Under heavy load vdradmin exits with sigpipe. Fixed. + - Added a search function + +v0.5 -- tom -- Wed Nov 14 12:09:35 CET 2001 + + - Fixed problem with complex timers in timer overview + +v0.4 -- tom -- Wed Nov 14 00:58:31 CET 2001 + + - vdradmin must not longer be started from the directory where it lives in. + - Sorted broadcasters by name in 'Was laeuft jetzt?' + - Added logging mechanism + - Added a 'go!' button in the channel overview + - The time field in the channel summary now eats almost everything. + (e.g. 1920, 19,20, 19.20, 19:20 produces all the same) + - The time buffer (e.g. 5 minutes before/after every movie) was in some + cases calculated wrong. Fixed. + - A click on the name of a recording shows the summary + - Sometimes (if a request was interrupted) the program exits with a + SIGPIPE. Fixed. + - If a timer was (re)edited the channel selection was wrong + - EPG data now stored in a tree (internal). + - as ever, other things i don't remember + +v0.3 -- tom -- Thu Oct 25 21:50:12 CET 2001 + + - vdradmin has now a integrated webserver. No Apache needed. + - A configurating menu added. + - Sometimes (if a timer is recording) deleting this timer deletes the + next one. Fixed. + - EPG and Channel Data now hold in memory. + - Several speed improvements. + - It's now possible to select the channels listed in 'Was laeuft jetzt?' + - I forgot the rest ;) + +v0.2 -- tom -- Sat Oct 13 01:10:50 CET 2001 + + - Viewing and deleting recordings a now possible (thanks to Thomas + Heiligenmann) + - It's now possible to support several languages. vdradmin suports at the + moment only German. + - The funktion of the 'Was laeuft jetzt?' was extended, it's now possible + to show whats going on at eg. twelve a clock (assuming thats now nine + - Sometimes in the channel listing two show's have the same color. Fixed. + - Channel file was now also cached (to speed up) + - Sending "quit\r\n" before closing SVDRP socket + - A timer that titel field contains a ":" was not correct displayed + - many, many other thins i don't remember + +v0.1 -- tom -- Tue Oct 9 00:12:12 CET 2001 + +- Initial release + diff --git a/HISTORY.am b/HISTORY.am new file mode 100644 index 0000000..51ed9a4 --- /dev/null +++ b/HISTORY.am @@ -0,0 +1,19 @@ +2005-03-06: 0.97-am1 "initial release" +This is mainly the lastest vdradmin (v0.97) with different patches applied: +- vdradmin-0.97 has been taken from linvdr-0.7. +- xpix's BigPatch_0.9pre5 (ported from vdradmin-0.95 to vdradmin-0.97 (see HISTORY.bigpatch). +- included changes from vdradmin-0.95-ct-10 (see HISTORY.ct). +- included vdradmin-0.95_0.9_pre5_fb1.diff (see HISTORY.macfly). +- included vdradmin-0.96-rename.diff which also needs an applied "vdr-aio21_svdrprename.patch" patch (don't know the author right now). + +My own changes: +- included missing "Was läuft heute?" template (found at www.vdr-portal.de). +- fixed some rendering problems with "New Timer" and "New Autotimer" on KDE's Konqueror. +- Beautified recordings listing (at least in my eyes ;-) +- Added "Size" selectbox to TV template. + +PLEASE NOTE: +- Streaming doesn't work for me in this release. If you get it working please let me know! +- All the above mentioned work/patches only deal with the German templates and the default "bilder" skin. + This means you only get all features when using German with "bilder" skin. I don't know if the other languages still work, but I have no idea why they shouldn't. + The "copper" misses some images. Maybe someone wants to create them? diff --git a/HISTORY.bigpatch b/HISTORY.bigpatch new file mode 100644 index 0000000..1518bdb --- /dev/null +++ b/HISTORY.bigpatch @@ -0,0 +1,99 @@ +README Big Patch +---------------- +This is a patch to develop for a better vdradmin. +It's designt as Patch for a vanilla vdradmin, i +hope you have many fun with this nice program. + +Version 0.9 + +* Neue Option bei Autotimer Done on/off (thx gfa4711 & viking) +* Done Liste persitent machen +! remove the ffserver stuff, is to buggy and peters solution over samba is better. + +Version 0.8 + +Fixes(!) and Features(*): + +* force an update at start from vdradmind +* popup and change_channel moved to library.js +* cosmetic changes from tv screen for a better display in mozilla +* add refresh 60 sec in prog_summary (thanks to schwarz) +* better handling for tv shows , if this show exists in the past, in auto timer +* Better unique autotimer +! First klick on timeline produce a empty website .. fixed +! remote background fixed +! scrolling in detail window +! replace '|' to
in detail window (thanks to gestein) + +Version 0.7 + +Fixes(!) and Features(*): + +* Yes! Skins! + - a new skin need only a new images directory with a new name in the same dir as 'bilder' + - the images in the new skin dir must have the same size and name from the old dir + - vdradmin will replace the http request to the new skin dir + - vdradmin will also replace the navi.css and style.css, if this exist in skin directory + - i.e. you can use a testing skin 'copper', only changes in color and style +* Unique Autotimer (like master-timer) + - this program only a timer was not come in the past (compare title+subtitle+summary) +* timers can now handle more as one card (thanks to Emil Naepflein) + - handle parallel recordings on same transponder on one card + - handle recordings on cards with CA (only one recording per CA type) +! Cache timeout is now every 60 minutes +! If you not have channels in the right list under config then don't display in timeline + + +Version 0.6 + +Fixes(!) and Features(*): + +* timeline is 50% faster +* existing timer in timeline is marked now +* links to the epg information in timer +* redesign tvscreen with remote control +! remove flash plugin, because losse support for this +! timeline has lost epg items + +Version 0.5 + +Fixes(!) and Features(*): + +* only patching to the new Version 0.95 + +Version 0.4 + +Fixes(!) and Features(*): + +* Stream the records to client (very eperimental) need ffmpeg +* add new timeline table from müntz and friends +* add streamdevurls in prog_list and prog_summary +* add a bunch config vars (for stream and streamdev) + + +Version 0.3 + +Fixes(!) and Features(*): + +* Timeline: screen to display a better Programguide +* Timeline: Pulldownmenu for times at 'was kommt um?' +! Timeline: timeline can open a own window to display the summary, is better for opera users +* Timeline: direct input in the right edge of timeline to display a own time +! Timeline: the list of channels is sortet in user order +* Timeline: higlightet program if this running now +! Timeline: no 25 Uhr at top of timeline +! Timeline: No break for mac users in the top right edge + +! Global: little Bugfixes +* Global: epg.data load direct from filesystem +* Global: better redirects + +* Tv: in tv is grab selected on load +* Tv: Button to grab the tv picture +! Tv: Ok, the tv screen is fixed ;) +* Tv: Preview window as Flash screen, thanks for Albu from vdr-portal.de + +! Config: 1x / je Tag is removed +* Config: epg is configurable with vdradmin -c +* Config: in config screen you can set the timelinescreen as startscreen +* Config: switch for flash tv diff --git a/HISTORY.ct b/HISTORY.ct new file mode 100644 index 0000000..44a0d35 Binary files /dev/null and b/HISTORY.ct differ diff --git a/HISTORY.macfly b/HISTORY.macfly new file mode 100644 index 0000000..afac4d6 --- /dev/null +++ b/HISTORY.macfly @@ -0,0 +1,34 @@ +since i don' know if vdradmin will be maintained in the future, i took the +best version i knew of (the one from xpix) and fixed some issues. This is +the reason, i have my very own HISTORY-File. + +macfly-001 - macfly 04.02.2005 + - added Template, which was missing + - fixed disabled timers in the timeline of timer_list to be grey + - fixed disabled timers in the listing of timer_list to be grey + - included the patch for handling extended EPG provided by tvm2vdr: + if you use autotimer, you can use the following special Tags in + the directory-field. They will be replaced with the information + from the EPG of the EPG-event: + %Title% will become the title of the event + %Subtitle% will become the subtitle of the event + %Director% will become the director of the event + %Date% will become the date of the recording + %Category% will become the category of the Event (Spielfilm/Serie/...) + %Genre% will become the genre of the Event (Drama/Krimi/..) + %Year% will become the year of production + %Country% will become the country of production + %Originaltitle% will become the original title of the event + %FSK% will become the FSK from the event + %Epsiode% will become the episode of the event + %Rating% will become the rating of the event from the EPG-Provider + + - made the inputfield of the directory for autotimers i little bit larger + - fixed enabling/disabling a timer + - added a blacklistfunction. Enter any title into the file vdradmind.bl, + one event into one line. If this string is found either(!!) in title or + in title~subtitle, this event will not be programmed by autotimer. So you + can disable complete episodes (for example when using "Enterprise" as + Blacklist-string) or only one (when using "Enterprise~Azati Prime" as + Blacklist-string). + - removed the
from the events. They are still used for display only. diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..99af2b5 --- /dev/null +++ b/INSTALL @@ -0,0 +1,50 @@ + +Installation: + + Unpack the archive somewhere: + $ tar xvf vdradmin-x.y.tar.gz + $ cd vdradmin-x.y + $ ./vdradmind.pl --config + + Some questions about the configuration will asked. + + After this, point your browser to the given parameters. + + (e.g. http://localhost:8001) + + +Hide vdradmin behind apache: + + you will need apache with mod_proxy and these lines in httpd.conf: + + + ProxyRequests Off + ProxyPass /vdradmin/ http://127.0.0.1:8001/ + + +Hint from Martin Neuditschko for apache2 (untested): + + I have summarized the needed changes for my Apache (Apache2, SuSE 8.2): + Following modules have to be activated additionally: + proxy, html_proxy, rewrite + + Following has to be added to the httpd.conf: + + RewriteEngine On + RewriteRule ^/vdradmin(.*) http://localhost:8001$1 [P,L] + + +See who's calling (you need an ISDN card for this): + + Insert this in your isdn.conf: + + [MSN] + NUMBER = + START = { + [FLAG] + FLAGS = I|O|R + PROGRAM = /path/to/vdradmind.pl --displaycall "Call from \$2" + } + + Restart isdnlog. + diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..6f42f82 --- /dev/null +++ b/Makefile @@ -0,0 +1,26 @@ +DESTDIR= +LIBDIR=/usr/share/vdradmin +ETCDIR=/etc/vdradmin +DOCDIR=/usr/share/doc/vdradmin +BINDIR=/usr/bin + +distclean: + rm -f vdradmind.conf vdradmind.at vdradmind.pid vdradmind.log + +install: + @if [ ! -d $(DESTDIR)$(BINDIR) ]; then \ + mkdir -p $(DESTDIR)$(BINDIR); \ + fi + sed -e "s/my \$$SEARCH_FILES_IN_SYSTEM = 0; \# for distribution/my \$$SEARCH_FILES_IN_SYSTEM = 1;/" < vdradmind.pl > $(DESTDIR)$(BINDIR)/vdradmind.pl + chmod a+x $(DESTDIR)$(BINDIR)/vdradmind.pl + @if [ ! -d $(DESTDIR)$(LIBDIR) ]; then \ + mkdir -p $(DESTDIR)$(LIBDIR); \ + fi + cp -r template lib $(DESTDIR)$(LIBDIR) + @if [ ! -d $(DESTDIR)$(ETCDIR) ]; then \ + mkdir -p $(DESTDIR)$(ETCDIR); \ + fi + @if [ ! -d $(DESTDIR)$(DOCDIR) ]; then \ + mkdir -p $(DESTDIR)$(DOCDIR); \ + fi + cp -r COPYING HISTORY INSTALL contrib $(DESTDIR)$(DOCDIR) diff --git a/contrib/README.vdr-aio21_svdrprename.patch b/contrib/README.vdr-aio21_svdrprename.patch new file mode 100644 index 0000000..f42a4b6 --- /dev/null +++ b/contrib/README.vdr-aio21_svdrprename.patch @@ -0,0 +1,3 @@ +Don't know the patch's author at the moment, found the patch at www.vdr-portal.de. + +This patch applies from vdr 1.3.19 - 1.3.22 even without enAIO patch (even if the patch's name suggests it). diff --git a/contrib/findunusedimage.sh b/contrib/findunusedimage.sh new file mode 100755 index 0000000..740005a --- /dev/null +++ b/contrib/findunusedimage.sh @@ -0,0 +1,8 @@ +#!/bin/bash + +for i in bilder/*; do + grep `basename $i` *.html >/dev/null + if [ $? != 0 ]; then + echo $i + fi +done diff --git a/contrib/gentoo.rc.vdradmind b/contrib/gentoo.rc.vdradmind new file mode 100644 index 0000000..b0f8fb5 --- /dev/null +++ b/contrib/gentoo.rc.vdradmind @@ -0,0 +1,20 @@ +#!/sbin/runscript +# Copyright 1999-2003 Gentoo Technologies, Inc. +# Distributed under the terms of the GNU General Public License, v2 or later +# $Header: /cvsroot/gentoo-deutsch/ebuilds/net-www/vdradmind/files/rc.vdradmind,v 1.2 2003/05/26 20:06:22 mad Exp $ + +depend() { + need vdr +} + +start() { + ebegin "Starting vdradmind" + /usr/bin/vdradmind.pl + eend $? +} + +stop() { + ebegin "Stopping vdradmind" + start-stop-daemon --stop --quiet --pidfile /var/run/vdradmind.pid + eend $? +} diff --git a/contrib/vdr-1.2.0-recordings-length.diff b/contrib/vdr-1.2.0-recordings-length.diff new file mode 100644 index 0000000..a403e8e --- /dev/null +++ b/contrib/vdr-1.2.0-recordings-length.diff @@ -0,0 +1,15 @@ +diff -uHr vdr-1.2.0.patched/svdrp.c vdr-1.2.0/svdrp.c +--- vdr-1.2.0.patched/svdrp.c 2003-04-27 16:21:07.000000000 +0200 ++++ vdr-1.2.0/svdrp.c 2003-06-06 21:34:03.000000000 +0200 +@@ -726,7 +726,10 @@ + else if (recordings) { + cRecording *recording = Recordings.First(); + while (recording) { +- Reply(recording == Recordings.Last() ? 250 : -250, "%d %s", recording->Index() + 1, recording->Title(' ', true)); ++ cIndexFile *oIndex = new cIndexFile(recording->FileName(), false); ++ const char *sTime = IndexToHMSF(oIndex->Last()); ++ Reply(recording == Recordings.Last() ? 250 : -250, "%d %s\t<%s>", recording->Index() + 1, recording->Title(' ', true), sTime); ++ delete oIndex; + recording = Recordings.Next(recording); + } + } diff --git a/contrib/vdr-aio21_svdrprename.patch b/contrib/vdr-aio21_svdrprename.patch new file mode 100755 index 0000000..e279615 --- /dev/null +++ b/contrib/vdr-aio21_svdrprename.patch @@ -0,0 +1,65 @@ +diff -Nru vdr-1.3.11/svdrp.c vdr-1.3.11.patch/svdrp.c +--- vdr-1.3.11/svdrp.c Sun Jun 13 15:38:38 2004 ++++ vdr-1.3.11.patch/svdrp.c Thu Aug 26 14:41:54 2004 +@@ -256,6 +256,8 @@ + " format defined in vdr(5) for the 'epg.data' file. A '.' on a line\n" + " by itself terminates the input and starts processing of the data (all\n" + " entered data is buffered until the terminating '.' is seen).", ++ "RENR \n" ++ " Rename recording. Number must be the Number as returned by LSTR command.", + "SCAN\n" + " Forces an EPG scan. If this is a single DVB device system, the scan\n" + " will be done on the primary device unless it is currently recording.", +@@ -1025,7 +1027,33 @@ + EITScanner.ForceScan(); + Reply(250, "EPG scan triggered"); + } ++void cSVDRP::CmdRENR(const char *Option) ++{ ++ bool recordings = Recordings.Load(); ++ if (recordings) { ++ if (*Option) { ++ char *tail; ++ int n = strtol(Option, &tail, 10); ++ cRecording *recording = Recordings.Get(n - 1); ++ if (recording && tail && tail != Option) { ++ tail = skipspace(tail); ++ int priority=recording->priority; ++ int lifetime=recording->lifetime; ++ recording->Rename(tail,&priority,&lifetime); ++ Reply (250,"Renamed \"%s\" to \"%s\"",recording->Name(),tail); ++ // Reply (200,"New Name: %s",tail); ++ } ++ else ++ Reply(501, "Recording not found or wrong syntax"); ++ } ++ else ++ Reply(501, "Missing Input settings"); ++ } ++ else ++ Reply(550, "No recordings available"); ++} + ++ + void cSVDRP::CmdSTAT(const char *Option) + { + if (*Option) { +@@ -1133,6 +1161,7 @@ + else if (CMD("NEWT")) CmdNEWT(s); + else if (CMD("NEXT")) CmdNEXT(s); + else if (CMD("PUTE")) CmdPUTE(s); ++ else if (CMD("RENR")) CmdRENR(s); + else if (CMD("SCAN")) CmdSCAN(s); + else if (CMD("STAT")) CmdSTAT(s); + else if (CMD("UPDT")) CmdUPDT(s); +diff -Nru vdr-1.3.11/svdrp.h vdr-1.3.11.patch/svdrp.h +--- vdr-1.3.11/svdrp.h Sat Jan 17 14:30:52 2004 ++++ vdr-1.3.11.patch/svdrp.h Thu Aug 26 14:41:54 2004 +@@ -73,6 +73,7 @@ + void CmdNEWT(const char *Option); + void CmdNEXT(const char *Option); + void CmdPUTE(const char *Option); ++ void CmdRENR(const char *Option); + void CmdSCAN(const char *Option); + void CmdSTAT(const char *Option); + void CmdUPDT(const char *Option); diff --git a/lib/HTML/Template.pm b/lib/HTML/Template.pm new file mode 100644 index 0000000..8a2b53f --- /dev/null +++ b/lib/HTML/Template.pm @@ -0,0 +1,3265 @@ +package HTML::Template; + +$HTML::Template::VERSION = '2.6'; + +=head1 NAME + +HTML::Template - Perl module to use HTML Templates from CGI scripts + +=head1 SYNOPSIS + +First you make a template - this is just a normal HTML file with a few +extra tags, the simplest being + +For example, test.tmpl: + + + Test Template + + My Home Directory is +

+ My Path is set to + + + +Now create a small CGI program: + + #!/usr/bin/perl -w + use HTML::Template; + + # open the html template + my $template = HTML::Template->new(filename => 'test.tmpl'); + + # fill in some parameters + $template->param(HOME => $ENV{HOME}); + $template->param(PATH => $ENV{PATH}); + + # send the obligatory Content-Type and print the template output + print "Content-Type: text/html\n\n", $template->output; + +If all is well in the universe this should show something like this in +your browser when visiting the CGI: + + My Home Directory is /home/some/directory + My Path is set to /bin;/usr/bin + +=head1 DESCRIPTION + +This module attempts to make using HTML templates simple and natural. +It extends standard HTML with a few new HTML-esque tags - , +, , , and . +The file written with HTML and these new tags is called a template. +It is usually saved separate from your script - possibly even created +by someone else! Using this module you fill in the values for the +variables, loops and branches declared in the template. This allows +you to separate design - the HTML - from the data, which you generate +in the Perl script. + +This module is licensed under the GPL. See the LICENSE section +below for more details. + +=head1 TUTORIAL + +If you're new to HTML::Template, I suggest you start with the +introductory article available on the HTML::Template website: + + http://html-template.sourceforge.net + +=head1 MOTIVATION + +It is true that there are a number of packages out there to do HTML +templates. On the one hand you have things like HTML::Embperl which +allows you freely mix Perl with HTML. On the other hand lie +home-grown variable substitution solutions. Hopefully the module can +find a place between the two. + +One advantage of this module over a full HTML::Embperl-esque solution +is that it enforces an important divide - design and programming. By +limiting the programmer to just using simple variables and loops in +the HTML, the template remains accessible to designers and other +non-perl people. The use of HTML-esque syntax goes further to make +the format understandable to others. In the future this similarity +could be used to extend existing HTML editors/analyzers to support +HTML::Template. + +An advantage of this module over home-grown tag-replacement schemes is +the support for loops. In my work I am often called on to produce +tables of data in html. Producing them using simplistic HTML +templates results in CGIs containing lots of HTML since the HTML +itself cannot represent loops. The introduction of loop statements in +the HTML simplifies this situation considerably. The designer can +layout a single row and the programmer can fill it in as many times as +necessary - all they must agree on is the parameter names. + +For all that, I think the best thing about this module is that it does +just one thing and it does it quickly and carefully. It doesn't try +to replace Perl and HTML, it just augments them to interact a little +better. And it's pretty fast. + +=head1 THE TAGS + +=head2 TMPL_VAR + + + +The tag is very simple. For each tag in the +template you call $template->param(PARAMETER_NAME => "VALUE"). When +the template is output the is replaced with the VALUE text +you specified. If you don't set a parameter it just gets skipped in +the output. + +Optionally you can use the "ESCAPE=HTML" option in the tag to indicate +that you want the value to be HTML-escaped before being returned from +output (the old ESCAPE=1 syntax is still supported). This means that +the ", <, >, and & characters get translated into ", <, > +and & respectively. This is useful when you want to use a +TMPL_VAR in a context where those characters would cause trouble. +Example: + + "> + +If you called param() with a value like sam"my you'll get in trouble +with HTML's idea of a double-quote. On the other hand, if you use +ESCAPE=HTML, like this: + + "> + +You'll get what you wanted no matter what value happens to be passed in for +param. You can also write ESCAPE="HTML", ESCAPE='HTML' and ESCAPE='1'. +Substitute a 0 for the HTML and you turn off escaping, which is the default +anyway. + +There is also the "ESCAPE=URL" option which may be used for VARs that +populate a URL. It will do URL escaping, like replacing ' ' with '+' +and '/' with '%2F'. + +You can assign a default value to a variable with the DEFAULT +attribute. For example, this will output "the devil gave me a taco" +if the "who" variable is not set. + + The gave me a taco. + +=head2 TMPL_LOOP + + ... + +The tag is a bit more complicated than . The + tag allows you to delimit a section of text and give it a +name. Inside this named loop you place s. Now you pass to +param() a list (an array ref) of parameter assignments (hash refs) for +this loop. The loop iterates over the list and produces output from +the text block for each pass. Unset parameters are skipped. Here's +an example: + + In the template: + + + Name:
+ Job:

+ + + + In the script: + + $template->param(EMPLOYEE_INFO => [ + { name => 'Sam', job => 'programmer' }, + { name => 'Steve', job => 'soda jerk' }, + ] + ); + print $template->output(); + + + The output in a browser: + + Name: Sam + Job: programmer + + Name: Steve + Job: soda jerk + +As you can see above the takes a list of variable +assignments and then iterates over the loop body producing output. + +Often you'll want to generate a 's contents +programmatically. Here's an example of how this can be done (many +other ways are possible!): + + # a couple of arrays of data to put in a loop: + my @words = qw(I Am Cool); + my @numbers = qw(1 2 3); + + my @loop_data = (); # initialize an array to hold your loop + + while (@words and @numbers) { + my %row_data; # get a fresh hash for the row data + + # fill in this row + $row_data{WORD} = shift @words; + $row_data{NUMBER} = shift @numbers; + + # the crucial step - push a reference to this row into the loop! + push(@loop_data, \%row_data); + } + + # finally, assign the loop data to the loop param, again with a + # reference: + $template->param(THIS_LOOP => \@loop_data); + +The above example would work with a template like: + + + Word:
+ Number:

+ + +It would produce output like: + + Word: I + Number: 1 + + Word: Am + Number: 2 + + Word: Cool + Number: 3 + +s within s are fine and work as you would +expect. If the syntax for the param() call has you stumped, here's an +example of a param call with one nested loop: + + $template->param(LOOP => [ + { name => 'Bobby', + nicknames => [ + { name => 'the big bad wolf' }, + { name => 'He-Man' }, + ], + }, + ], + ); + +Basically, each gets an array reference. Inside the array +are any number of hash references. These hashes contain the +name=>value pairs for a single pass over the loop template. + +Inside a , the only variables that are usable are the ones +from the . The variables in the outer blocks are not +visible within a template loop. For the computer-science geeks among +you, a introduces a new scope much like a perl subroutine +call. If you want your variables to be global you can use +'global_vars' option to new() described below. + +=head2 TMPL_INCLUDE + + + +This tag includes a template directly into the current template at the +point where the tag is found. The included template contents are used +exactly as if its contents were physically included in the master +template. + +The file specified can be an absolute path (beginning with a '/' under +Unix, for example). If it isn't absolute, the path to the enclosing +file is tried first. After that the path in the environment variable +HTML_TEMPLATE_ROOT is tried, if it exists. Next, the "path" option is +consulted, first as-is and then with HTML_TEMPLATE_ROOT prepended if +available. As a final attempt, the filename is passed to open() +directly. See below for more information on HTML_TEMPLATE_ROOT and +the "path" option to new(). + +As a protection against infinitly recursive includes, an arbitary +limit of 10 levels deep is imposed. You can alter this limit with the +"max_includes" option. See the entry for the "max_includes" option +below for more details. + +=head2 TMPL_IF + + ... + +The tag allows you to include or not include a block of the +template based on the value of a given parameter name. If the +parameter is given a value that is true for Perl - like '1' - then the +block is included in the output. If it is not defined, or given a +false value - like '0' - then it is skipped. The parameters are +specified the same way as with TMPL_VAR. + +Example Template: + + + Some text that only gets displayed if BOOL is true! + + +Now if you call $template->param(BOOL => 1) then the above block will +be included by output. + + blocks can include any valid HTML::Template +construct - VARs and LOOPs and other IF/ELSE blocks. Note, however, +that intersecting a and a is invalid. + + Not going to work: + + + + + +If the name of a TMPL_LOOP is used in a TMPL_IF, the IF block will +output if the loop has at least one row. Example: + + + This will output if the loop is not empty. + + + + .... + + +WARNING: Much of the benefit of HTML::Template is in decoupling your +Perl and HTML. If you introduce numerous cases where you have +TMPL_IFs and matching Perl if()s, you will create a maintenance +problem in keeping the two synchronized. I suggest you adopt the +practice of only using TMPL_IF if you can do so without requiring a +matching if() in your Perl code. + +=head2 TMPL_ELSE + + ... ... + +You can include an alternate block in your TMPL_IF block by using +TMPL_ELSE. NOTE: You still end the block with , not +! + + Example: + + + Some text that is included only if BOOL is true + + Some text that is included only if BOOL is false + + +=head2 TMPL_UNLESS + + ... + +This tag is the opposite of . The block is output if the +CONTROL_PARAMETER is set false or not defined. You can use + with just as you can with . + + Example: + + + Some text that is output only if BOOL is FALSE. + + Some text that is output only if BOOL is TRUE. + + +If the name of a TMPL_LOOP is used in a TMPL_UNLESS, the UNLESS block +output if the loop has zero rows. + + + This will output if the loop is empty. + + + + .... + + +=cut + +=head2 NOTES + +HTML::Template's tags are meant to mimic normal HTML tags. However, +they are allowed to "break the rules". Something like: + + + +is not really valid HTML, but it is a perfectly valid use and will +work as planned. + +The "NAME=" in the tag is optional, although for extensibility's sake I +recommend using it. Example - "" is acceptable. + +If you're a fanatic about valid HTML and would like your templates +to conform to valid HTML syntax, you may optionally type template tags +in the form of HTML comments. This may be of use to HTML authors who +would like to validate their templates' HTML syntax prior to +HTML::Template processing, or who use DTD-savvy editing tools. + + + +In order to realize a dramatic savings in bandwidth, the standard +(non-comment) tags will be used throughout this documentation. + +=head1 METHODS + +=head2 new() + +Call new() to create a new Template object: + + my $template = HTML::Template->new( filename => 'file.tmpl', + option => 'value' + ); + +You must call new() with at least one name => value pair specifying how +to access the template text. You can use "filename => 'file.tmpl'" to +specify a filename to be opened as the template. Alternately you can +use: + + my $t = HTML::Template->new( scalarref => $ref_to_template_text, + option => 'value' + ); + +and + + my $t = HTML::Template->new( arrayref => $ref_to_array_of_lines , + option => 'value' + ); + + +These initialize the template from in-memory resources. In almost +every case you'll want to use the filename parameter. If you're +worried about all the disk access from reading a template file just +use mod_perl and the cache option detailed below. + +You can also read the template from an already opened filehandle, +either traditionally as a glob or as a FileHandle: + + my $t = HTML::Template->new( filehandle => *FH, option => 'value'); + +The four new() calling methods can also be accessed as below, if you +prefer. + + my $t = HTML::Template->new_file('file.tmpl', option => 'value'); + + my $t = HTML::Template->new_scalar_ref($ref_to_template_text, + option => 'value'); + + my $t = HTML::Template->new_array_ref($ref_to_array_of_lines, + option => 'value'); + + my $t = HTML::Template->new_filehandle($fh, + option => 'value'); + +And as a final option, for those that might prefer it, you can call new as: + + my $t = HTML::Template->new(type => 'filename', + source => 'file.tmpl'); + +Which works for all three of the source types. + +If the environment variable HTML_TEMPLATE_ROOT is set and your +filename doesn't begin with /, then the path will be relative to the +value of $HTML_TEMPLATE_ROOT. Example - if the environment variable +HTML_TEMPLATE_ROOT is set to "/home/sam" and I call +HTML::Template->new() with filename set to "sam.tmpl", the +HTML::Template will try to open "/home/sam/sam.tmpl" to access the +template file. You can also affect the search path for files with the +"path" option to new() - see below for more information. + +You can modify the Template object's behavior with new. These options +are available: + +=over 4 + +=item Error Detection Options + +=over 4 + +=item * + +die_on_bad_params - if set to 0 the module will let you call +$template->param(param_name => 'value') even if 'param_name' doesn't +exist in the template body. Defaults to 1. + +=item * + +strict - if set to 0 the module will allow things that look like they +might be TMPL_* tags to get by without dieing. Example: + + + +Would normally cause an error, but if you call new with strict => 0, +HTML::Template will ignore it. Defaults to 1. + +=item * + +vanguard_compatibility_mode - if set to 1 the module will expect to +see s that look like %NAME% in addition to the standard +syntax. Also sets die_on_bad_params => 0. If you're not at Vanguard +Media trying to use an old format template don't worry about this one. +Defaults to 0. + +=back + +=item Caching Options + +=over 4 + +=item * + +cache - if set to 1 the module will cache in memory the parsed +templates based on the filename parameter and modification date of the +file. This only applies to templates opened with the filename +parameter specified, not scalarref or arrayref templates. Caching +also looks at the modification times of any files included using + tags, but again, only if the template is opened with +filename parameter. + +This is mainly of use in a persistent environment like +Apache/mod_perl. It has absolutely no benefit in a normal CGI +environment since the script is unloaded from memory after every +request. For a cache that does work for normal CGIs see the +'shared_cache' option below. + +Note that different new() parameter settings do not cause a cache +refresh, only a change in the modification time of the template will +trigger a cache refresh. For most usages this is fine. My simplistic +testing shows that using cache yields a 90% performance increase under +mod_perl. Cache defaults to 0. + +=item * + +shared_cache - if set to 1 the module will store its cache in shared +memory using the IPC::SharedCache module (available from CPAN). The +effect of this will be to maintain a single shared copy of each parsed +template for all instances of HTML::Template to use. This can be a +significant reduction in memory usage in a multiple server +environment. As an example, on one of our systems we use 4MB of +template cache and maintain 25 httpd processes - shared_cache results +in saving almost 100MB! Of course, some reduction in speed versus +normal caching is to be expected. Another difference between normal +caching and shared_cache is that shared_cache will work in a CGI +environment - normal caching is only useful in a persistent +environment like Apache/mod_perl. + +By default HTML::Template uses the IPC key 'TMPL' as a shared root +segment (0x4c504d54 in hex), but this can be changed by setting the +'ipc_key' new() parameter to another 4-character or integer key. +Other options can be used to affect the shared memory cache correspond +to IPC::SharedCache options - ipc_mode, ipc_segment_size and +ipc_max_size. See L for a description of how these +work - in most cases you shouldn't need to change them from the +defaults. + +For more information about the shared memory cache system used by +HTML::Template see L. + +=item * + +double_cache - if set to 1 the module will use a combination of +shared_cache and normal cache mode for the best possible caching. Of +course, it also uses the most memory of all the cache modes. All the +same ipc_* options that work with shared_cache apply to double_cache +as well. By default double_cache is off. + +=item * + +blind_cache - if set to 1 the module behaves exactly as with normal +caching but does not check to see if the file has changed on each +request. This option should be used with caution, but could be of use +on high-load servers. My tests show blind_cache performing only 1 to +2 percent faster than cache under mod_perl. + +NOTE: Combining this option with shared_cache can result in stale +templates stuck permanently in shared memory! + +=item * + +file_cache - if set to 1 the module will store its cache in a file +using the Storable module. It uses no additional memory, and my +simplistic testing shows that it yields a 50% performance advantage. +Like shared_cache, it will work in a CGI environment. Default is 0. + +If you set this option you must set the "file_cache_dir" option. See +below for details. + +NOTE: Storable using flock() to ensure safe access to cache files. +Using file_cache on a system or filesystem (NFS) without flock() +support is dangerous. + + +=item * + +file_cache_dir - sets the directory where the module will store the +cache files if file_cache is enabled. Your script will need write +permissions to this directory. You'll also need to make sure the +sufficient space is available to store the cache files. + +=item * + +file_cache_dir_mode - sets the file mode for newly created file_cache +directories and subdirectories. Defaults to 0700 for security but +this may be inconvenient if you do not have access to the account +running the webserver. + +=item * + +double_file_cache - if set to 1 the module will use a combination of +file_cache and normal cache mode for the best possible caching. The +file_cache_* options that work with file_cache apply to double_file_cache +as well. By default double_file_cache is 0. + +=back + +=item Filesystem Options + +=over 4 + +=item * + +path - you can set this variable with a list of paths to search for +files specified with the "filename" option to new() and for files +included with the tag. This list is only consulted +when the filename is relative. The HTML_TEMPLATE_ROOT environment +variable is always tried first if it exists. Also, if +HTML_TEMPLATE_ROOT is set then an attempt will be made to prepend +HTML_TEMPLATE_ROOT onto paths in the path array. In the case of a + file, the path to the including file is also tried +before path is consulted. + +Example: + + my $template = HTML::Template->new( filename => 'file.tmpl', + path => [ '/path/to/templates', + '/alternate/path' + ] + ); + +NOTE: the paths in the path list must be expressed as UNIX paths, +separated by the forward-slash character ('/'). + +=item * + +search_path_on_include - if set to a true value the module will search +from the top of the array of paths specified by the path option on +every and use the first matching template found. The +normal behavior is to look only in the current directory for a +template to include. Defaults to 0. + +=back + +=item Debugging Options + +=over 4 + +=item * + +debug - if set to 1 the module will write random debugging information +to STDERR. Defaults to 0. + +=item * + +stack_debug - if set to 1 the module will use Data::Dumper to print +out the contents of the parse_stack to STDERR. Defaults to 0. + +=item * + +cache_debug - if set to 1 the module will send information on cache +loads, hits and misses to STDERR. Defaults to 0. + +=item * + +shared_cache_debug - if set to 1 the module will turn on the debug +option in IPC::SharedCache - see L for +details. Defaults to 0. + +=item * + +memory_debug - if set to 1 the module will send information on cache +memory usage to STDERR. Requires the GTop module. Defaults to 0. + +=back + +=item Miscellaneous Options + +=over 4 + +=item * + +associate - this option allows you to inherit the parameter values +from other objects. The only requirement for the other object is that +it have a param() method that works like HTML::Template's param(). A +good candidate would be a CGI.pm query object. Example: + + my $query = new CGI; + my $template = HTML::Template->new(filename => 'template.tmpl', + associate => $query); + +Now, $template->output() will act as though + + $template->param('FormField', $cgi->param('FormField')); + +had been specified for each key/value pair that would be provided by +the $cgi->param() method. Parameters you set directly take precedence +over associated parameters. + +You can specify multiple objects to associate by passing an anonymous +array to the associate option. They are searched for parameters in +the order they appear: + + my $template = HTML::Template->new(filename => 'template.tmpl', + associate => [$query, $other_obj]); + +The old associateCGI() call is still supported, but should be +considered obsolete. + +NOTE: The parameter names are matched in a case-insensitve manner. If +you have two parameters in a CGI object like 'NAME' and 'Name' one +will be chosen randomly by associate. This behavior can be changed by +the following option. + +=item * + +case_sensitive - setting this option to true causes HTML::Template to +treat template variable names case-sensitively. The following example +would only set one parameter without the "case_sensitive" option: + + my $template = HTML::Template->new(filename => 'template.tmpl', + case_sensitive => 1); + $template->param( + FieldA => 'foo', + fIELDa => 'bar', + ); + +This option defaults to off. + +NOTE: with case_sensitive and loop_context_vars the special loop +variables are available in lower-case only. + +=item * + +loop_context_vars - when this parameter is set to true (it is false by +default) four loop context variables are made available inside a loop: +__first__, __last__, __inner__, __odd__. They can be used with +, and to control how a loop is +output. + +In addition to the above, a __counter__ var is also made available +when loop context variables are turned on. + +Example: + + + + This only outputs on the first pass. + + + + This outputs every other pass, on the odd passes. + + + + This outputs every other pass, on the even passes. + + + + This outputs on passes that are neither first nor last. + + + This is pass number . + + + This only outputs on the last pass. + + + +One use of this feature is to provide a "separator" similar in effect +to the perl function join(). Example: + + + and + , . + + +Would output (in a browser) something like: + + Apples, Oranges, Brains, Toes, and Kiwi. + +Given an appropriate param() call, of course. NOTE: A loop with only +a single pass will get both __first__ and __last__ set to true, but +not __inner__. + +=item * + +no_includes - set this option to 1 to disallow the tag +in the template file. This can be used to make opening untrusted +templates B less dangerous. Defaults to 0. + +=item * + +max_includes - set this variable to determine the maximum depth that +includes can reach. Set to 10 by default. Including files to a depth +greater than this value causes an error message to be displayed. Set +to 0 to disable this protection. + +=item * + +global_vars - normally variables declared outside a loop are not +available inside a loop. This option makes s like global +variables in Perl - they have unlimited scope. This option also +affects and . + +Example: + + This is a normal variable: .

+ + + Here it is inside the loop:

+ + +Normally this wouldn't work as expected, since 's +value outside the loop is not available inside the loop. + +The global_vars option also allows you to access the values of an +enclosing loop within an inner loop. For example, in this loop the +inner loop will have access to the value of OUTER_VAR in the correct +iteration: + + + OUTER: + + INNER: + INSIDE OUT: + + + +=item * + +filter - this option allows you to specify a filter for your template +files. A filter is a subroutine that will be called after +HTML::Template reads your template file but before it starts parsing +template tags. + +In the most simple usage, you simply assign a code reference to the +filter parameter. This subroutine will recieve a single arguement - a +reference to a string containing the template file text. Here is an +example that accepts templates with tags that look like "!!!ZAP_VAR +FOO!!!" and transforms them into HTML::Template tags: + + my $filter = sub { + my $text_ref = shift; + $$text_ref =~ s/!!!ZAP_(.*?)!!!//g; + }; + + # open zap.tmpl using the above filter + my $template = HTML::Template->new(filename => 'zap.tmpl', + filter => $filter); + +More complicated usages are possible. You can request that your +filter receieve the template text as an array of lines rather than as +a single scalar. To do that you need to specify your filter using a +hash-ref. In this form you specify the filter using the "sub" key and +the desired argument format using the "format" key. The available +formats are "scalar" and "array". Using the "array" format will incur +a performance penalty but may be more convenient in some situations. + + my $template = HTML::Template->new(filename => 'zap.tmpl', + filter => { sub => $filter, + format => 'array' }); + +You may also have multiple filters. This allows simple filters to be +combined for more elaborate functionality. To do this you specify an +array of filters. The filters are applied in the order they are +specified. + + my $template = HTML::Template->new(filename => 'zap.tmpl', + filter => [ + { sub => \&decompress, + format => 'scalar' }, + { sub => \&remove_spaces, + format => 'array' } + ]); + +The specified filters will be called for any TMPL_INCLUDEed files just +as they are for the main template file. + +=back + +=back 4 + +=cut + + +use integer; # no floating point math so far! +use strict; # and no funny business, either. + +use Carp; # generate better errors with more context +use File::Spec; # generate paths that work on all platforms + +# define accessor constants used to improve readability of array +# accesses into "objects". I used to use 'use constant' but that +# seems to cause occasional irritating warnings in older Perls. +package HTML::Template::LOOP; +sub TEMPLATE_HASH () { 0; } +sub PARAM_SET () { 1 }; + +package HTML::Template::COND; +sub VARIABLE () { 0 }; +sub VARIABLE_TYPE () { 1 }; +sub VARIABLE_TYPE_VAR () { 0 }; +sub VARIABLE_TYPE_LOOP () { 1 }; +sub JUMP_IF_TRUE () { 2 }; +sub JUMP_ADDRESS () { 3 }; +sub WHICH () { 4 }; +sub WHICH_IF () { 0 }; +sub WHICH_UNLESS () { 1 }; + +# back to the main package scope. +package HTML::Template; + +# open a new template and return an object handle +sub new { + my $pkg = shift; + my $self; { my %hash; $self = bless(\%hash, $pkg); } + + # the options hash + my $options = {}; + $self->{options} = $options; + + # set default parameters in options hash + %$options = ( + debug => 0, + stack_debug => 0, + timing => 0, + search_path_on_include => 0, + cache => 0, + blind_cache => 0, + file_cache => 0, + file_cache_dir => '', + file_cache_dir_mode => 0700, + cache_debug => 0, + shared_cache_debug => 0, + memory_debug => 0, + die_on_bad_params => 1, + vanguard_compatibility_mode => 0, + associate => [], + path => [], + strict => 1, + loop_context_vars => 0, + max_includes => 10, + shared_cache => 0, + double_cache => 0, + double_file_cache => 0, + ipc_key => 'TMPL', + ipc_mode => 0666, + ipc_segment_size => 65536, + ipc_max_size => 0, + global_vars => 0, + no_includes => 0, + case_sensitive => 0, + filter => [], + ); + + # load in options supplied to new() + for (my $x = 0; $x <= $#_; $x += 2) { + defined($_[($x + 1)]) or croak("HTML::Template->new() called with odd number of option parameters - should be of the form option => value"); + $options->{lc($_[$x])} = $_[($x + 1)]; + } + + # blind_cache = 1 implies cache = 1 + $options->{blind_cache} and $options->{cache} = 1; + + # shared_cache = 1 implies cache = 1 + $options->{shared_cache} and $options->{cache} = 1; + + # file_cache = 1 implies cache = 1 + $options->{file_cache} and $options->{cache} = 1; + + # double_cache is a combination of shared_cache and cache. + $options->{double_cache} and $options->{cache} = 1; + $options->{double_cache} and $options->{shared_cache} = 1; + + # double_file_cache is a combination of file_cache and cache. + $options->{double_file_cache} and $options->{cache} = 1; + $options->{double_file_cache} and $options->{file_cache} = 1; + + # vanguard_compatibility_mode implies die_on_bad_params = 0 + $options->{vanguard_compatibility_mode} and + $options->{die_on_bad_params} = 0; + + # handle the "type", "source" parameter format (does anyone use it?) + if (exists($options->{type})) { + exists($options->{source}) or croak("HTML::Template->new() called with 'type' parameter set, but no 'source'!"); + ($options->{type} eq 'filename' or $options->{type} eq 'scalarref' or + $options->{type} eq 'arrayref' or $options->{type} eq 'filehandle') or + croak("HTML::Template->new() : type parameter must be set to 'filename', 'arrayref', 'scalarref' or 'filehandle'!"); + + $options->{$options->{type}} = $options->{source}; + delete $options->{type}; + delete $options->{source}; + } + + # associate should be an array of one element if it's not + # already an array. + if (ref($options->{associate}) ne 'ARRAY') { + $options->{associate} = [ $options->{associate} ]; + } + + # path should be an array if it's not already + if (ref($options->{path}) ne 'ARRAY') { + $options->{path} = [ $options->{path} ]; + } + + # filter should be an array if it's not already + if (ref($options->{filter}) ne 'ARRAY') { + $options->{filter} = [ $options->{filter} ]; + } + + # make sure objects in associate area support param() + foreach my $object (@{$options->{associate}}) { + defined($object->can('param')) or + croak("HTML::Template->new called with associate option, containing object of type " . ref($object) . " which lacks a param() method!"); + } + + # check for syntax errors: + my $source_count = 0; + exists($options->{filename}) and $source_count++; + exists($options->{filehandle}) and $source_count++; + exists($options->{arrayref}) and $source_count++; + exists($options->{scalarref}) and $source_count++; + if ($source_count != 1) { + croak("HTML::Template->new called with multiple (or no) template sources specified! A valid call to new() has exactly one filename => 'file' OR exactly one scalarref => \\\$scalar OR exactly one arrayref => \\\@array OR exactly one filehandle => \*FH"); + } + + # do some memory debugging - this is best started as early as possible + if ($options->{memory_debug}) { + # memory_debug needs GTop + eval { require GTop; }; + croak("Could not load GTop. You must have GTop installed to use HTML::Template in memory_debug mode. The error was: $@") + if ($@); + $self->{gtop} = GTop->new(); + $self->{proc_mem} = $self->{gtop}->proc_mem($$); + print STDERR "\n### HTML::Template Memory Debug ### START ", $self->{proc_mem}->size(), "\n"; + } + + if ($options->{file_cache}) { + # make sure we have a file_cache_dir option + croak("You must specify the file_cache_dir option if you want to use file_cache.") + unless defined $options->{file_cache_dir} and + length $options->{file_cache_dir}; + + # file_cache needs some extra modules loaded + eval { require Storable; }; + croak("Could not load Storable. You must have Storable installed to use HTML::Template in file_cache mode. The error was: $@") + if ($@); + eval { require Digest::MD5; }; + croak("Could not load Digest::MD5. You must have Digest::MD5 installed to use HTML::Template in file_cache mode. The error was: $@") + if ($@); + } + + if ($options->{shared_cache}) { + # shared_cache needs some extra modules loaded + eval { require IPC::SharedCache; }; + croak("Could not load IPC::SharedCache. You must have IPC::SharedCache installed to use HTML::Template in shared_cache mode. The error was: $@") + if ($@); + + # initialize the shared cache + my %cache; + tie %cache, 'IPC::SharedCache', + ipc_key => $options->{ipc_key}, + load_callback => [\&_load_shared_cache, $self], + validate_callback => [\&_validate_shared_cache, $self], + debug => $options->{shared_cache_debug}, + ipc_mode => $options->{ipc_mode}, + max_size => $options->{ipc_max_size}, + ipc_segment_size => $options->{ipc_segment_size}; + $self->{cache} = \%cache; + } + + print STDERR "### HTML::Template Memory Debug ### POST CACHE INIT ", $self->{proc_mem}->size(), "\n" + if $options->{memory_debug}; + + # initialize data structures + $self->_init; + + print STDERR "### HTML::Template Memory Debug ### POST _INIT CALL ", $self->{proc_mem}->size(), "\n" + if $options->{memory_debug}; + + # drop the shared cache - leaving out this step results in the + # template object evading garbage collection since the callbacks in + # the shared cache tie hold references to $self! This was not easy + # to find, by the way. + delete $self->{cache} if $options->{shared_cache}; + + return $self; +} + +# an internally used new that receives its parse_stack and param_map as input +sub _new_from_loop { + my $pkg = shift; + my $self; { my %hash; $self = bless(\%hash, $pkg); } + + # the options hash + my $options = {}; + $self->{options} = $options; + + # set default parameters in options hash - a subset of the options + # valid in a normal new(). Since _new_from_loop never calls _init, + # many options have no relevance. + %$options = ( + debug => 0, + stack_debug => 0, + die_on_bad_params => 1, + associate => [], + loop_context_vars => 0, + ); + + # load in options supplied to new() + for (my $x = 0; $x <= $#_; $x += 2) { + defined($_[($x + 1)]) or croak("HTML::Template->new() called with odd number of option parameters - should be of the form option => value"); + $options->{lc($_[$x])} = $_[($x + 1)]; + } + + $self->{param_map} = $options->{param_map}; + $self->{parse_stack} = $options->{parse_stack}; + delete($options->{param_map}); + delete($options->{parse_stack}); + + return $self; +} + +# a few shortcuts to new(), of possible use... +sub new_file { + my $pkg = shift; return $pkg->new('filename', @_); +} +sub new_filehandle { + my $pkg = shift; return $pkg->new('filehandle', @_); +} +sub new_array_ref { + my $pkg = shift; return $pkg->new('arrayref', @_); +} +sub new_scalar_ref { + my $pkg = shift; return $pkg->new('scalarref', @_); +} + +# initializes all the object data structures, either from cache or by +# calling the appropriate routines. +sub _init { + my $self = shift; + my $options = $self->{options}; + + if ($options->{double_cache}) { + # try the normal cache, return if we have it. + $self->_fetch_from_cache(); + return if (defined $self->{param_map} and defined $self->{parse_stack}); + + # try the shared cache + $self->_fetch_from_shared_cache(); + + # put it in the local cache if we got it. + $self->_commit_to_cache() + if (defined $self->{param_map} and defined $self->{parse_stack}); + } elsif ($options->{double_file_cache}) { + # try the normal cache, return if we have it. + $self->_fetch_from_cache(); + return if (defined $self->{param_map} and defined $self->{parse_stack}); + + # try the file cache + $self->_fetch_from_file_cache(); + + # put it in the local cache if we got it. + $self->_commit_to_cache() + if (defined $self->{param_map} and defined $self->{parse_stack}); + } elsif ($options->{shared_cache}) { + # try the shared cache + $self->_fetch_from_shared_cache(); + } elsif ($options->{file_cache}) { + # try the file cache + $self->_fetch_from_file_cache(); + } elsif ($options->{cache}) { + # try the normal cache + $self->_fetch_from_cache(); + } + + # if we got a cache hit, return + return if (defined $self->{param_map} and defined $self->{parse_stack}); + + # if we're here, then we didn't get a cached copy, so do a full + # init. + $self->_init_template(); + $self->_parse(); + + # now that we have a full init, cache the structures if cacheing is + # on. shared cache is already cool. + if($options->{file_cache}){ + $self->_commit_to_file_cache(); + } + $self->_commit_to_cache() if (($options->{cache} + and not $options->{shared_cache} + and not $options->{file_cache}) or + ($options->{double_cache}) or + ($options->{double_file_cache})); +} + +# Caching subroutines - they handle getting and validating cache +# records from either the in-memory or shared caches. + +# handles the normal in memory cache +use vars qw( %CACHE ); +sub _fetch_from_cache { + my $self = shift; + my $options = $self->{options}; + + # return if there's no cache entry for this filename + return unless exists($options->{filename}); + my $filepath = $self->_find_file($options->{filename}); + return unless (defined($filepath) and + exists $CACHE{$filepath}); + + $options->{filepath} = $filepath; + + # validate the cache + my $mtime = $self->_mtime($filepath); + if (defined $mtime) { + # return if the mtime doesn't match the cache + if (defined($CACHE{$filepath}{mtime}) and + ($mtime != $CACHE{$filepath}{mtime})) { + $options->{cache_debug} and + print STDERR "CACHE MISS : $filepath : $mtime\n"; + return; + } + + # if the template has includes, check each included file's mtime + # and return if different + if (exists($CACHE{$filepath}{included_mtimes})) { + foreach my $filename (keys %{$CACHE{$filepath}{included_mtimes}}) { + next unless + defined($CACHE{$filepath}{included_mtimes}{$filename}); + + my $included_mtime = (stat($filename))[9]; + if ($included_mtime != $CACHE{$filepath}{included_mtimes}{$filename}) { + $options->{cache_debug} and + print STDERR "### HTML::Template Cache Debug ### CACHE MISS : $filepath : INCLUDE $filename : $included_mtime\n"; + + return; + } + } + } + } + + # got a cache hit! + + $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### CACHE HIT : $filepath\n"; + + $self->{param_map} = $CACHE{$filepath}{param_map}; + $self->{parse_stack} = $CACHE{$filepath}{parse_stack}; + exists($CACHE{$filepath}{included_mtimes}) and + $self->{included_mtimes} = $CACHE{$filepath}{included_mtimes}; + + # clear out values from param_map from last run + $self->_normalize_options(); + $self->clear_params(); +} + +sub _commit_to_cache { + my $self = shift; + my $options = $self->{options}; + + my $filepath = $options->{filepath}; + if (not defined $filepath) { + $filepath = $self->_find_file($options->{filename}); + confess("HTML::Template->new() : Cannot open included file $options->{filename} : file not found.") + unless defined($filepath); + $options->{filepath} = $filepath; + } + + $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### CACHE LOAD : $filepath\n"; + + $options->{blind_cache} or + $CACHE{$filepath}{mtime} = $self->_mtime($filepath); + $CACHE{$filepath}{param_map} = $self->{param_map}; + $CACHE{$filepath}{parse_stack} = $self->{parse_stack}; + exists($self->{included_mtimes}) and + $CACHE{$filepath}{included_mtimes} = $self->{included_mtimes}; +} + +# generates MD5 from filepath to determine filename for cache file +sub _get_cache_filename { + my ($self, $filepath) = @_; + + # hash the filename ... + my $hash = Digest::MD5::md5_hex($filepath); + + # ... and build a path out of it. Using the first two charcters + # gives us 255 buckets. This means you can have 255,000 templates + # in the cache before any one directory gets over a few thousand + # files in it. That's probably pretty good for this planet. If not + # then it should be configurable. + if (wantarray) { + return (substr($hash,0,2), substr($hash,2)) + } else { + return File::Spec->join($self->{options}{file_cache_dir}, + substr($hash,0,2), substr($hash,2)); + } +} + +# handles the file cache +sub _fetch_from_file_cache { + my $self = shift; + my $options = $self->{options}; + return unless exists($options->{filename}); + + # return if there's no cache entry for this filename + my $filepath = $self->_find_file($options->{filename}); + return unless defined $filepath; + my $cache_filename = $self->_get_cache_filename($filepath); + return unless -e $cache_filename; + + eval { + $self->{record} = Storable::lock_retrieve($cache_filename); + }; + croak("HTML::Template::new() - Problem reading cache file $cache_filename (file_cache => 1) : $@") + if $@; + croak("HTML::Template::new() - Problem reading cache file $cache_filename (file_cache => 1) : $!") + unless defined $self->{record}; + + ($self->{mtime}, + $self->{included_mtimes}, + $self->{param_map}, + $self->{parse_stack}) = @{$self->{record}}; + + $options->{filepath} = $filepath; + + # validate the cache + my $mtime = $self->_mtime($filepath); + if (defined $mtime) { + # return if the mtime doesn't match the cache + if (defined($self->{mtime}) and + ($mtime != $self->{mtime})) { + $options->{cache_debug} and + print STDERR "### HTML::Template Cache Debug ### FILE CACHE MISS : $filepath : $mtime\n"; + ($self->{mtime}, + $self->{included_mtimes}, + $self->{param_map}, + $self->{parse_stack}) = (undef, undef, undef, undef); + return; + } + + # if the template has includes, check each included file's mtime + # and return if different + if (exists($self->{included_mtimes})) { + foreach my $filename (keys %{$self->{included_mtimes}}) { + next unless + defined($self->{included_mtimes}{$filename}); + + my $included_mtime = (stat($filename))[9]; + if ($included_mtime != $self->{included_mtimes}{$filename}) { + $options->{cache_debug} and + print STDERR "### HTML::Template Cache Debug ### FILE CACHE MISS : $filepath : INCLUDE $filename : $included_mtime\n"; + ($self->{mtime}, + $self->{included_mtimes}, + $self->{param_map}, + $self->{parse_stack}) = (undef, undef, undef, undef); + return; + } + } + } + } + + # got a cache hit! + $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### FILE CACHE HIT : $filepath\n"; + + # clear out values from param_map from last run + $self->_normalize_options(); + $self->clear_params(); +} + +sub _commit_to_file_cache { + my $self = shift; + my $options = $self->{options}; + + my $filepath = $options->{filepath}; + if (not defined $filepath) { + $filepath = $self->_find_file($options->{filename}); + confess("HTML::Template->new() : Cannot open included file $options->{filename} : file not found.") + unless defined($filepath); + $options->{filepath} = $filepath; + } + + my ($cache_dir, $cache_file) = $self->_get_cache_filename($filepath); + $cache_dir = File::Spec->join($options->{file_cache_dir}, $cache_dir); + if (not -d $cache_dir) { + if (not -d $options->{file_cache_dir}) { + mkdir($options->{file_cache_dir},$options->{file_cache_dir_mode}) + or croak("HTML::Template->new() : can't mkdir $options->{file_cache_dir} (file_cache => 1): $!"); + } + mkdir($cache_dir,$options->{file_cache_dir_mode}) + or croak("HTML::Template->new() : can't mkdir $cache_dir (file_cache => 1): $!"); + } + + $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### FILE CACHE LOAD : $options->{filepath}\n"; + + my $result; + eval { + $result = Storable::lock_store([ $self->{mtime}, + $self->{included_mtimes}, + $self->{param_map}, + $self->{parse_stack} ], + scalar File::Spec->join($cache_dir, $cache_file) + ); + }; + croak("HTML::Template::new() - Problem writing cache file $cache_dir/$cache_file (file_cache => 1) : $@") + if $@; + croak("HTML::Template::new() - Problem writing cache file $cache_dir/$cache_file (file_cache => 1) : $!") + unless defined $result; +} + +# Shared cache routines. +sub _fetch_from_shared_cache { + my $self = shift; + my $options = $self->{options}; + + my $filepath = $self->_find_file($options->{filename}); + return unless defined $filepath; + + # fetch from the shared cache. + $self->{record} = $self->{cache}{$filepath}; + + ($self->{mtime}, + $self->{included_mtimes}, + $self->{param_map}, + $self->{parse_stack}) = @{$self->{record}} + if defined($self->{record}); + + $options->{cache_debug} and defined($self->{record}) and print STDERR "### HTML::Template Cache Debug ### CACHE HIT : $filepath\n"; + # clear out values from param_map from last run + $self->_normalize_options(), $self->clear_params() + if (defined($self->{record})); + delete($self->{record}); + + return $self; +} + +sub _validate_shared_cache { + my ($self, $filename, $record) = @_; + my $options = $self->{options}; + + $options->{shared_cache_debug} and print STDERR "### HTML::Template Cache Debug ### SHARED CACHE VALIDATE : $filename\n"; + + return 1 if $options->{blind_cache}; + + my ($c_mtime, $included_mtimes, $param_map, $parse_stack) = @$record; + + # if the modification time has changed return false + my $mtime = $self->_mtime($filename); + if (defined $mtime and defined $c_mtime + and $mtime != $c_mtime) { + $options->{cache_debug} and + print STDERR "### HTML::Template Cache Debug ### SHARED CACHE MISS : $filename : $mtime\n"; + return 0; + } + + # if the template has includes, check each included file's mtime + # and return false if different + if (defined $mtime and defined $included_mtimes) { + foreach my $fname (keys %$included_mtimes) { + next unless defined($included_mtimes->{$fname}); + if ($included_mtimes->{$fname} != (stat($fname))[9]) { + $options->{cache_debug} and + print STDERR "### HTML::Template Cache Debug ### SHARED CACHE MISS : $filename : INCLUDE $fname\n"; + return 0; + } + } + } + + # all done - return true + return 1; +} + +sub _load_shared_cache { + my ($self, $filename) = @_; + my $options = $self->{options}; + my $cache = $self->{cache}; + + $self->_init_template(); + $self->_parse(); + + $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### SHARED CACHE LOAD : $options->{filepath}\n"; + + print STDERR "### HTML::Template Memory Debug ### END CACHE LOAD ", $self->{proc_mem}->size(), "\n" + if $options->{memory_debug}; + + return [ $self->{mtime}, + $self->{included_mtimes}, + $self->{param_map}, + $self->{parse_stack} ]; +} + +# utility function - given a filename performs documented search and +# returns a full path of undef if the file cannot be found. +sub _find_file { + my ($self, $filename, $extra_path) = @_; + my $options = $self->{options}; + my $filepath; + + # first check for a full path + return File::Spec->canonpath($filename) + if (File::Spec->file_name_is_absolute($filename) and (-e $filename)); + + # try the extra_path if one was specified + if (defined($extra_path)) { + $extra_path->[$#{$extra_path}] = $filename; + $filepath = File::Spec->canonpath(File::Spec->catfile(@$extra_path)); + return File::Spec->canonpath($filepath) if -e $filepath; + } + + # try pre-prending HTML_Template_Root + if (exists($ENV{HTML_TEMPLATE_ROOT})) { + $filepath = File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $filename); + return File::Spec->canonpath($filepath) if -e $filepath; + } + + # try "path" option list.. + foreach my $path (@{$options->{path}}) { + $filepath = File::Spec->catfile($path, $filename); + return File::Spec->canonpath($filepath) if -e $filepath; + } + + # try even a relative path from the current directory... + return File::Spec->canonpath($filename) if -e $filename; + + # try "path" option list with HTML_TEMPLATE_ROOT prepended... + if (exists($ENV{HTML_TEMPLATE_ROOT})) { + foreach my $path (@{$options->{path}}) { + $filepath = File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $path, $filename); + return File::Spec->canonpath($filepath) if -e $filepath; + } + } + + return undef; +} + +# utility function - computes the mtime for $filename +sub _mtime { + my ($self, $filepath) = @_; + my $options = $self->{options}; + + return(undef) if ($options->{blind_cache}); + + # make sure it still exists in the filesystem + (-r $filepath) or Carp::confess("HTML::Template : template file $filepath does not exist or is unreadable."); + + # get the modification time + return (stat(_))[9]; +} + +# utility function - enforces new() options across LOOPs that have +# come from a cache. Otherwise they would have stale options hashes. +sub _normalize_options { + my $self = shift; + my $options = $self->{options}; + + my @pstacks = ($self->{parse_stack}); + while(@pstacks) { + my $pstack = pop(@pstacks); + foreach my $item (@$pstack) { + next unless (ref($item) eq 'HTML::Template::LOOP'); + foreach my $template (values %{$item->[HTML::Template::LOOP::TEMPLATE_HASH]}) { + # must be the same list as the call to _new_from_loop... + $template->{options}{debug} = $options->{debug}; + $template->{options}{stack_debug} = $options->{stack_debug}; + $template->{options}{die_on_bad_params} = $options->{die_on_bad_params}; + $template->{options}{case_sensitive} = $options->{case_sensitive}; + + push(@pstacks, $template->{parse_stack}); + } + } + } +} + +# initialize the template buffer +sub _init_template { + my $self = shift; + my $options = $self->{options}; + + print STDERR "### HTML::Template Memory Debug ### START INIT_TEMPLATE ", $self->{proc_mem}->size(), "\n" + if $options->{memory_debug}; + + if (exists($options->{filename})) { + my $filepath = $options->{filepath}; + if (not defined $filepath) { + $filepath = $self->_find_file($options->{filename}); + confess("HTML::Template->new() : Cannot open included file $options->{filename} : file not found.") + unless defined($filepath); + # we'll need this for future reference - to call stat() for example. + $options->{filepath} = $filepath; + } + + confess("HTML::Template->new() : Cannot open included file $options->{filename} : $!") + unless defined(open(TEMPLATE, $filepath)); + $self->{mtime} = $self->_mtime($filepath); + + # read into scalar, note the mtime for the record + $self->{template} = ""; + while (read(TEMPLATE, $self->{template}, 10240, length($self->{template}))) {} + close(TEMPLATE); + + } elsif (exists($options->{scalarref})) { + # copy in the template text + $self->{template} = ${$options->{scalarref}}; + + delete($options->{scalarref}); + } elsif (exists($options->{arrayref})) { + # if we have an array ref, join and store the template text + $self->{template} = join("", @{$options->{arrayref}}); + + delete($options->{arrayref}); + } elsif (exists($options->{filehandle})) { + # just read everything in in one go + local $/ = undef; + $self->{template} = readline($options->{filehandle}); + + delete($options->{filehandle}); + } else { + confess("HTML::Template : Need to call new with filename, filehandle, scalarref or arrayref parameter specified."); + } + + print STDERR "### HTML::Template Memory Debug ### END INIT_TEMPLATE ", $self->{proc_mem}->size(), "\n" + if $options->{memory_debug}; + + # handle filters if necessary + $self->_call_filters(\$self->{template}) if @{$options->{filter}}; + + return $self; +} + +# handle calling user defined filters +sub _call_filters { + my $self = shift; + my $template_ref = shift; + my $options = $self->{options}; + + my ($format, $sub); + foreach my $filter (@{$options->{filter}}) { + croak("HTML::Template->new() : bad value set for filter parameter - must be a code ref or a hash ref.") + unless ref $filter; + + # translate into CODE->HASH + $filter = { 'format' => 'scalar', 'sub' => $filter } + if (ref $filter eq 'CODE'); + + if (ref $filter eq 'HASH') { + $format = $filter->{'format'}; + $sub = $filter->{'sub'}; + + # check types and values + croak("HTML::Template->new() : bad value set for filter parameter - hash must contain \"format\" key and \"sub\" key.") + unless defined $format and defined $sub; + croak("HTML::Template->new() : bad value set for filter parameter - \"format\" must be either 'array' or 'scalar'") + unless $format eq 'array' or $format eq 'scalar'; + croak("HTML::Template->new() : bad value set for filter parameter - \"sub\" must be a code ref") + unless ref $sub and ref $sub eq 'CODE'; + + # catch errors + eval { + if ($format eq 'scalar') { + # call + $sub->($template_ref); + } else { + # modulate + my @array = map { $_."\n" } split("\n", $$template_ref); + # call + $sub->(\@array); + # demodulate + $$template_ref = join("", @array); + } + }; + croak("HTML::Template->new() : fatal error occured during filter call: $@") if $@; + } else { + croak("HTML::Template->new() : bad value set for filter parameter - must be code ref or hash ref"); + } + } + # all done + return $template_ref; +} + +# _parse sifts through a template building up the param_map and +# parse_stack structures. +# +# The end result is a Template object that is fully ready for +# output(). +sub _parse { + my $self = shift; + my $options = $self->{options}; + + $options->{debug} and print STDERR "### HTML::Template Debug ### In _parse:\n"; + + # setup the stacks and maps - they're accessed by typeglobs that + # reference the top of the stack. They are masked so that a loop + # can transparently have its own versions. + use vars qw(@pstack %pmap @ifstack @ucstack %top_pmap); + local (*pstack, *ifstack, *pmap, *ucstack, *top_pmap); + + # the pstack is the array of scalar refs (plain text from the + # template file), VARs, LOOPs, IFs and ELSEs that output() works on + # to produce output. Looking at output() should make it clear what + # _parse is trying to accomplish. + my @pstacks = ([]); + *pstack = $pstacks[0]; + $self->{parse_stack} = $pstacks[0]; + + # the pmap binds names to VARs, LOOPs and IFs. It allows param() to + # access the right variable. NOTE: output() does not look at the + # pmap at all! + my @pmaps = ({}); + *pmap = $pmaps[0]; + *top_pmap = $pmaps[0]; + $self->{param_map} = $pmaps[0]; + + # the ifstack is a temporary stack containing pending ifs and elses + # waiting for a /if. + my @ifstacks = ([]); + *ifstack = $ifstacks[0]; + + # the ucstack is a temporary stack containing conditions that need + # to be bound to param_map entries when their block is finished. + # This happens when a conditional is encountered before any other + # reference to its NAME. Since a conditional can reference VARs and + # LOOPs it isn't possible to make the link right away. + my @ucstacks = ([]); + *ucstack = $ucstacks[0]; + + # the loopstack is another temp stack for closing loops. unlike + # those above it doesn't get scoped inside loops, therefore it + # doesn't need the typeglob magic. + my @loopstack = (); + + # the fstack is a stack of filenames and counters that keeps track + # of which file we're in and where we are in it. This allows + # accurate error messages even inside included files! + # fcounter, fmax and fname are aliases for the current file's info + use vars qw($fcounter $fname $fmax); + local (*fcounter, *fname, *fmax); + + my @fstack = ([$options->{filepath} || "/fake/path/for/non/file/template", + 1, + scalar @{[$self->{template} =~ m/(\n)/g]} + 1 + ]); + (*fname, *fcounter, *fmax) = \ ( @{$fstack[0]} ); + + my $NOOP = HTML::Template::NOOP->new(); + my $ESCAPE = HTML::Template::ESCAPE->new(); + my $URLESCAPE = HTML::Template::URLESCAPE->new(); + + # all the tags that need NAMEs: + my %need_names = map { $_ => 1 } + qw(TMPL_VAR TMPL_LOOP TMPL_IF TMPL_UNLESS TMPL_INCLUDE); + + # variables used below that don't need to be my'd in the loop + my ($name, $which, $escape, $default); + + # handle the old vanguard format + $options->{vanguard_compatibility_mode} and + $self->{template} =~ s/%([-\w\/\.+]+)%//g; + + # now split up template on '<', leaving them in + my @chunks = split(m/(?=<)/, $self->{template}); + + # all done with template + delete $self->{template}; + + # loop through chunks, filling up pstack + my $last_chunk = $#chunks; + CHUNK: for (my $chunk_number = 0; + $chunk_number <= $last_chunk; + $chunk_number++) { + next unless defined $chunks[$chunk_number]; + my $chunk = $chunks[$chunk_number]; + + # a general regex to match any and all TMPL_* tags + if ($chunk =~ /^< + (?:!--\s*)? + ( + \/?[Tt][Mm][Pp][Ll]_ + (?: + (?:[Vv][Aa][Rr]) + | + (?:[Ll][Oo][Oo][Pp]) + | + (?:[Ii][Ff]) + | + (?:[Ee][Ll][Ss][Ee]) + | + (?:[Uu][Nn][Ll][Ee][Ss][Ss]) + | + (?:[Ii][Nn][Cc][Ll][Uu][Dd][Ee]) + ) + ) # $1 => $which - start of the tag + + \s* + + # DEFAULT attribute + (?: + [Dd][Ee][Ff][Aa][Uu][Ll][Tt] + \s*=\s* + (?: + "([^">]*)" # $2 => double-quoted DEFAULT value " + | + '([^'>]*)' # $3 => single-quoted DEFAULT value + | + ([^\s=>]*) # $4 => unquoted DEFAULT value + ) + )? + + \s* + + # ESCAPE attribute + (?: + [Ee][Ss][Cc][Aa][Pp][Ee] + \s*=\s* + (?: + (?: 0 | (?:"0") | (?:'0') ) + | + ( 1 | (?:"1") | (?:'1') | + (?:[Hh][Tt][Mm][Ll]) | + (?:"[Hh][Tt][Mm][Ll]") | + (?:'[Hh][Tt][Mm][Ll]') | + (?:[Uu][Rr][Ll]) | + (?:"[Uu][Rr][Ll]") | + (?:'[Uu][Rr][Ll]') | + ) # $5 => ESCAPE on + ) + )* # allow multiple ESCAPEs + + \s* + + # DEFAULT attribute + (?: + [Dd][Ee][Ff][Aa][Uu][Ll][Tt] + \s*=\s* + (?: + "([^">]*)" # $6 => double-quoted DEFAULT value " + | + '([^'>]*)' # $7 => single-quoted DEFAULT value + | + ([^\s=>]*) # $8 => unquoted DEFAULT value + ) + )? + + \s* + + # NAME attribute + (?: + (?: + [Nn][Aa][Mm][Ee] + \s*=\s* + )? + (?: + "([^">]*)" # $9 => double-quoted NAME value " + | + '([^'>]*)' # $10 => single-quoted NAME value + | + ([^\s=>]*) # $11 => unquoted NAME value + ) + )? + + \s* + + # DEFAULT attribute + (?: + [Dd][Ee][Ff][Aa][Uu][Ll][Tt] + \s*=\s* + (?: + "([^">]*)" # $12 => double-quoted DEFAULT value " + | + '([^'>]*)' # $13 => single-quoted DEFAULT value + | + ([^\s=>]*) # $14 => unquoted DEFAULT value + ) + )? + + \s* + + # ESCAPE attribute + (?: + [Ee][Ss][Cc][Aa][Pp][Ee] + \s*=\s* + (?: + (?: 0 | (?:"0") | (?:'0') ) + | + ( 1 | (?:"1") | (?:'1') | + (?:[Hh][Tt][Mm][Ll]) | + (?:"[Hh][Tt][Mm][Ll]") | + (?:'[Hh][Tt][Mm][Ll]') | + (?:[Uu][Rr][Ll]) | + (?:"[Uu][Rr][Ll]") | + (?:'[Uu][Rr][Ll]') | + ) # $15 => ESCAPE on + ) + )* # allow multiple ESCAPEs + + \s* + + # DEFAULT attribute + (?: + [Dd][Ee][Ff][Aa][Uu][Ll][Tt] + \s*=\s* + (?: + "([^">]*)" # $16 => double-quoted DEFAULT value " + | + '([^'>]*)' # $17 => single-quoted DEFAULT value + | + ([^\s=>]*) # $18 => unquoted DEFAULT value + ) + )? + + \s* + + (?:--)?> + (.*) # $19 => $post - text that comes after the tag + $/sx) { + + $which = uc($1); # which tag is it + + $escape = defined $5 ? $5 : defined $15 ? $15 : 0; # escape set? + + # what name for the tag? undef for a /tag at most, one of the + # following three will be defined + $name = defined $9 ? $9 : defined $10 ? $10 : defined $11 ? $11 : undef; + + # is there a default? + $default = defined $2 ? $2 : defined $3 ? $3 : defined $4 ? $4 : + defined $6 ? $6 : defined $7 ? $7 : defined $8 ? $8 : + defined $12 ? $12 : defined $13 ? $13 : defined $14 ? $14 : + defined $16 ? $16 : defined $17 ? $17 : defined $18 ? $18 : + undef; + + my $post = $19; # what comes after on the line + + # allow mixed case in filenames, otherwise flatten + $name = lc($name) unless (not defined $name or $which eq 'TMPL_INCLUDE' or $options->{case_sensitive}); + + # die if we need a name and didn't get one + die "HTML::Template->new() : No NAME given to a $which tag at $fname : line $fcounter." + if ($need_names{$which} and (not defined $name or not length $name)); + + # die if we got an escape but can't use one + die "HTML::Template->new() : ESCAPE option invalid in a $which tag at $fname : line $fcounter." if ( $escape and ($which ne 'TMPL_VAR')); + + # die if we got a default but can't use one + die "HTML::Template->new() : DEFAULT option invalid in a $which tag at $fname : line $fcounter." if ( defined $default and ($which ne 'TMPL_VAR')); + + # take actions depending on which tag found + if ($which eq 'TMPL_VAR') { + $options->{debug} and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : parsed VAR $name\n"; + + # if we already have this var, then simply link to the existing + # HTML::Template::VAR, else create a new one. + my $var; + if (exists $pmap{$name}) { + $var = $pmap{$name}; + (ref($var) eq 'HTML::Template::VAR') or + die "HTML::Template->new() : Already used param name $name as a TMPL_LOOP, found in a TMPL_VAR at $fname : line $fcounter."; + } else { + $var = HTML::Template::VAR->new(); + $pmap{$name} = $var; + $top_pmap{$name} = HTML::Template::VAR->new() + if $options->{global_vars} and not exists $top_pmap{$name}; + } + + # if a DEFAULT was provided, push a DEFAULT object on the + # stack before the variable. + if (defined $default) { + push(@pstack, HTML::Template::DEFAULT->new($default)); + } + + # if ESCAPE was set, push an ESCAPE op on the stack before + # the variable. output will handle the actual work. + if ($escape) { + if ($escape =~ /^"?[Uu][Rr][Ll]"?$/) { + push(@pstack, $URLESCAPE); + } else { + push(@pstack, $ESCAPE); + } + } + + push(@pstack, $var); + + } elsif ($which eq 'TMPL_LOOP') { + # we've got a loop start + $options->{debug} and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : LOOP $name start\n"; + + # if we already have this loop, then simply link to the existing + # HTML::Template::LOOP, else create a new one. + my $loop; + if (exists $pmap{$name}) { + $loop = $pmap{$name}; + (ref($loop) eq 'HTML::Template::LOOP') or + die "HTML::Template->new() : Already used param name $name as a TMPL_VAR, TMPL_IF or TMPL_UNLESS, found in a TMP_LOOP at $fname : line $fcounter!"; + + } else { + # store the results in a LOOP object - actually just a + # thin wrapper around another HTML::Template object. + $loop = HTML::Template::LOOP->new(); + $pmap{$name} = $loop; + } + + # get it on the loopstack, pstack of the enclosing block + push(@pstack, $loop); + push(@loopstack, [$loop, $#pstack]); + + # magic time - push on a fresh pmap and pstack, adjust the typeglobs. + # this gives the loop a separate namespace (i.e. pmap and pstack). + push(@pstacks, []); + *pstack = $pstacks[$#pstacks]; + push(@pmaps, {}); + *pmap = $pmaps[$#pmaps]; + push(@ifstacks, []); + *ifstack = $ifstacks[$#ifstacks]; + push(@ucstacks, []); + *ucstack = $ucstacks[$#ucstacks]; + + # auto-vivify __FIRST__, __LAST__ and __INNER__ if + # loop_context_vars is set. Otherwise, with + # die_on_bad_params set output() will might cause errors + # when it tries to set them. + if ($options->{loop_context_vars}) { + $pmap{__first__} = HTML::Template::VAR->new(); + $pmap{__inner__} = HTML::Template::VAR->new(); + $pmap{__last__} = HTML::Template::VAR->new(); + $pmap{__odd__} = HTML::Template::VAR->new(); + $pmap{__counter__} = HTML::Template::VAR->new(); + } + + } elsif ($which eq '/TMPL_LOOP') { + $options->{debug} and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : LOOP end\n"; + + my $loopdata = pop(@loopstack); + die "HTML::Template->new() : found with no matching at $fname : line $fcounter!" unless defined $loopdata; + + my ($loop, $starts_at) = @$loopdata; + + # resolve pending conditionals + foreach my $uc (@ucstack) { + my $var = $uc->[HTML::Template::COND::VARIABLE]; + if (exists($pmap{$var})) { + $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var}; + } else { + $pmap{$var} = HTML::Template::VAR->new(); + $top_pmap{$var} = HTML::Template::VAR->new() + if $options->{global_vars} and not exists $top_pmap{$var}; + $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var}; + } + if (ref($pmap{$var}) eq 'HTML::Template::VAR') { + $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_VAR; + } else { + $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_LOOP; + } + } + + # get pmap and pstack for the loop, adjust the typeglobs to + # the enclosing block. + my $param_map = pop(@pmaps); + *pmap = $pmaps[$#pmaps]; + my $parse_stack = pop(@pstacks); + *pstack = $pstacks[$#pstacks]; + + scalar(@ifstack) and die "HTML::Template->new() : Dangling or in loop ending at $fname : line $fcounter."; + pop(@ifstacks); + *ifstack = $ifstacks[$#ifstacks]; + pop(@ucstacks); + *ucstack = $ucstacks[$#ucstacks]; + + # instantiate the sub-Template, feeding it parse_stack and + # param_map. This means that only the enclosing template + # does _parse() - sub-templates get their parse_stack and + # param_map fed to them already filled in. + $loop->[HTML::Template::LOOP::TEMPLATE_HASH]{$starts_at} + = HTML::Template->_new_from_loop( + parse_stack => $parse_stack, + param_map => $param_map, + debug => $options->{debug}, + die_on_bad_params => $options->{die_on_bad_params}, + loop_context_vars => $options->{loop_context_vars}, + case_sensitive => $options->{case_sensitive}, + ); + + } elsif ($which eq 'TMPL_IF' or $which eq 'TMPL_UNLESS' ) { + $options->{debug} and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : $which $name start\n"; + + # if we already have this var, then simply link to the existing + # HTML::Template::VAR/LOOP, else defer the mapping + my $var; + if (exists $pmap{$name}) { + $var = $pmap{$name}; + } else { + $var = $name; + } + + # connect the var to a conditional + my $cond = HTML::Template::COND->new($var); + if ($which eq 'TMPL_IF') { + $cond->[HTML::Template::COND::WHICH] = HTML::Template::COND::WHICH_IF; + $cond->[HTML::Template::COND::JUMP_IF_TRUE] = 0; + } else { + $cond->[HTML::Template::COND::WHICH] = HTML::Template::COND::WHICH_UNLESS; + $cond->[HTML::Template::COND::JUMP_IF_TRUE] = 1; + } + + # push unconnected conditionals onto the ucstack for + # resolution later. Otherwise, save type information now. + if ($var eq $name) { + push(@ucstack, $cond); + } else { + if (ref($var) eq 'HTML::Template::VAR') { + $cond->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_VAR; + } else { + $cond->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_LOOP; + } + } + + # push what we've got onto the stacks + push(@pstack, $cond); + push(@ifstack, $cond); + + } elsif ($which eq '/TMPL_IF' or $which eq '/TMPL_UNLESS') { + $options->{debug} and print STDERR "### HTML::Template Debug ###$fname : line $fcounter : $which end\n"; + + my $cond = pop(@ifstack); + die "HTML::Template->new() : found with no matching at $fname : line $fcounter." unless defined $cond; + if ($which eq '/TMPL_IF') { + die "HTML::Template->new() : found incorrectly terminating a (use ) at $fname : line $fcounter.\n" + if ($cond->[HTML::Template::COND::WHICH] == HTML::Template::COND::WHICH_UNLESS); + } else { + die "HTML::Template->new() : found incorrectly terminating a (use ) at $fname : line $fcounter.\n" + if ($cond->[HTML::Template::COND::WHICH] == HTML::Template::COND::WHICH_IF); + } + + # connect the matching to this "address" - place a NOOP to + # hold the spot. This allows output() to treat an IF in the + # assembler-esque "Conditional Jump" mode. + push(@pstack, $NOOP); + $cond->[HTML::Template::COND::JUMP_ADDRESS] = $#pstack; + + } elsif ($which eq 'TMPL_ELSE') { + $options->{debug} and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : ELSE\n"; + + my $cond = pop(@ifstack); + die "HTML::Template->new() : found with no matching or at $fname : line $fcounter." unless defined $cond; + + + my $else = HTML::Template::COND->new($cond->[HTML::Template::COND::VARIABLE]); + $else->[HTML::Template::COND::WHICH] = $cond->[HTML::Template::COND::WHICH]; + $else->[HTML::Template::COND::JUMP_IF_TRUE] = not $cond->[HTML::Template::COND::JUMP_IF_TRUE]; + + # need end-block resolution? + if (defined($cond->[HTML::Template::COND::VARIABLE_TYPE])) { + $else->[HTML::Template::COND::VARIABLE_TYPE] = $cond->[HTML::Template::COND::VARIABLE_TYPE]; + } else { + push(@ucstack, $else); + } + + push(@pstack, $else); + push(@ifstack, $else); + + # connect the matching to this "address" - thus the if, + # failing jumps to the ELSE address. The else then gets + # elaborated, and of course succeeds. On the other hand, if + # the IF fails and falls though, output will reach the else + # and jump to the /if address. + $cond->[HTML::Template::COND::JUMP_ADDRESS] = $#pstack; + + } elsif ($which eq 'TMPL_INCLUDE') { + # handle TMPL_INCLUDEs + $options->{debug} and print STDERR "### HTML::Template Debug ### $fname : line $fcounter : INCLUDE $name \n"; + + # no includes here, bub + $options->{no_includes} and croak("HTML::Template : Illegal attempt to use TMPL_INCLUDE in template file : (no_includes => 1)"); + + my $filename = $name; + + # look for the included file... + my $filepath; + if ($options->{search_path_on_include}) { + $filepath = $self->_find_file($filename); + } else { + $filepath = $self->_find_file($filename, + [File::Spec->splitdir($fstack[-1][0])] + ); + } + die "HTML::Template->new() : Cannot open included file $filename : file not found." + unless defined($filepath); + die "HTML::Template->new() : Cannot open included file $filename : $!" + unless defined(open(TEMPLATE, $filepath)); + + # read into the array + my $included_template = ""; + while(read(TEMPLATE, $included_template, 10240, length($included_template))) {} + close(TEMPLATE); + + # call filters if necessary + $self->_call_filters(\$included_template) if @{$options->{filter}}; + + if ($included_template) { # not empty + # handle the old vanguard format - this needs to happen here + # since we're not about to do a next CHUNKS. + $options->{vanguard_compatibility_mode} and + $included_template =~ s/%([-\w\/\.+]+)%//g; + + # collect mtimes for included files + if ($options->{cache} and !$options->{blind_cache}) { + $self->{included_mtimes}{$filepath} = (stat($filepath))[9]; + } + + # adjust the fstack to point to the included file info + push(@fstack, [$filepath, 1, + scalar @{[$included_template =~ m/(\n)/g]} + 1]); + (*fname, *fcounter, *fmax) = \ ( @{$fstack[$#fstack]} ); + + # make sure we aren't infinitely recursing + die "HTML::Template->new() : likely recursive includes - parsed $options->{max_includes} files deep and giving up (set max_includes higher to allow deeper recursion)." if ($options->{max_includes} and (scalar(@fstack) > $options->{max_includes})); + + # stick the remains of this chunk onto the bottom of the + # included text. + $included_template .= $post; + $post = undef; + + # move the new chunks into place. + splice(@chunks, $chunk_number, 1, + split(m/(?=<)/, $included_template)); + + # recalculate stopping point + $last_chunk = $#chunks; + + # start in on the first line of the included text - nothing + # else to do on this line. + $chunk = $chunks[$chunk_number]; + + redo CHUNK; + } + } else { + # zuh!? + die "HTML::Template->new() : Unknown or unmatched TMPL construct at $fname : line $fcounter."; + } + # push the rest after the tag + if (defined($post)) { + if (ref($pstack[$#pstack]) eq 'SCALAR') { + ${$pstack[$#pstack]} .= $post; + } else { + push(@pstack, \$post); + } + } + } else { # just your ordinary markup + # make sure we didn't reject something TMPL_* but badly formed + if ($options->{strict}) { + die "HTML::Template->new() : Syntax error in tag at $fname : $fcounter." if ($chunk =~ /<(?:!--\s*)?\/?[Tt][Mm][Pp][Ll]_/); + } + + # push the rest and get next chunk + if (defined($chunk)) { + if (ref($pstack[$#pstack]) eq 'SCALAR') { + ${$pstack[$#pstack]} .= $chunk; + } else { + push(@pstack, \$chunk); + } + } + } + # count newlines in chunk and advance line count + $fcounter += scalar(@{[$chunk =~ m/(\n)/g]}); + # if we just crossed the end of an included file + # pop off the record and re-alias to the enclosing file's info + pop(@fstack), (*fname, *fcounter, *fmax) = \ ( @{$fstack[$#fstack]} ) + if ($fcounter > $fmax); + + } # next CHUNK + + # make sure we don't have dangling IF or LOOP blocks + scalar(@ifstack) and die "HTML::Template->new() : At least one or not terminated at end of file!"; + scalar(@loopstack) and die "HTML::Template->new() : At least one not terminated at end of file!"; + + # resolve pending conditionals + foreach my $uc (@ucstack) { + my $var = $uc->[HTML::Template::COND::VARIABLE]; + if (exists($pmap{$var})) { + $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var}; + } else { + $pmap{$var} = HTML::Template::VAR->new(); + $top_pmap{$var} = HTML::Template::VAR->new() + if $options->{global_vars} and not exists $top_pmap{$var}; + $uc->[HTML::Template::COND::VARIABLE] = $pmap{$var}; + } + if (ref($pmap{$var}) eq 'HTML::Template::VAR') { + $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_VAR; + } else { + $uc->[HTML::Template::COND::VARIABLE_TYPE] = HTML::Template::COND::VARIABLE_TYPE_LOOP; + } + } + + # want a stack dump? + if ($options->{stack_debug}) { + require 'Data/Dumper.pm'; + print STDERR "### HTML::Template _param Stack Dump ###\n\n", Data::Dumper::Dumper($self->{parse_stack}), "\n"; + } + + # get rid of filters - they cause runtime errors if Storable tries + # to store them. This can happen under global_vars. + delete $options->{filter}; +} + +# a recursive sub that associates each loop with the loops above +# (treating the top-level as a loop) +sub _globalize_vars { + my $self = shift; + + # associate with the loop (and top-level templates) above in the tree. + push(@{$self->{options}{associate}}, @_); + + # recurse down into the template tree, adding ourself to the end of + # list. + push(@_, $self); + map { $_->_globalize_vars(@_) } + map {values %{$_->[HTML::Template::LOOP::TEMPLATE_HASH]}} + grep { ref($_) eq 'HTML::Template::LOOP'} @{$self->{parse_stack}}; +} + +# method used to recursively un-hook associate +sub _unglobalize_vars { + my $self = shift; + + # disassociate + $self->{options}{associate} = undef; + + # recurse down into the template tree disassociating + map { $_->_unglobalize_vars() } + map {values %{$_->[HTML::Template::LOOP::TEMPLATE_HASH]}} + grep { ref($_) eq 'HTML::Template::LOOP'} @{$self->{parse_stack}}; +} + +=head2 param() + +param() can be called in a number of ways + +1) To return a list of parameters in the template : + + my @parameter_names = $self->param(); + + +2) To return the value set to a param : + + my $value = $self->param('PARAM'); + +3) To set the value of a parameter : + + # For simple TMPL_VARs: + $self->param(PARAM => 'value'); + + # with a subroutine reference that gets called to get the value + # of the scalar. The sub will recieve the template object as a + # parameter. + $self->param(PARAM => sub { return 'value' }); + + # And TMPL_LOOPs: + $self->param(LOOP_PARAM => + [ + { PARAM => VALUE_FOR_FIRST_PASS, ... }, + { PARAM => VALUE_FOR_SECOND_PASS, ... } + ... + ] + ); + +4) To set the value of a a number of parameters : + + # For simple TMPL_VARs: + $self->param(PARAM => 'value', + PARAM2 => 'value' + ); + + # And with some TMPL_LOOPs: + $self->param(PARAM => 'value', + PARAM2 => 'value', + LOOP_PARAM => + [ + { PARAM => VALUE_FOR_FIRST_PASS, ... }, + { PARAM => VALUE_FOR_SECOND_PASS, ... } + ... + ], + ANOTHER_LOOP_PARAM => + [ + { PARAM => VALUE_FOR_FIRST_PASS, ... }, + { PARAM => VALUE_FOR_SECOND_PASS, ... } + ... + ] + ); + +5) To set the value of a a number of parameters using a hash-ref : + + $self->param( + { + PARAM => 'value', + PARAM2 => 'value', + LOOP_PARAM => + [ + { PARAM => VALUE_FOR_FIRST_PASS, ... }, + { PARAM => VALUE_FOR_SECOND_PASS, ... } + ... + ], + ANOTHER_LOOP_PARAM => + [ + { PARAM => VALUE_FOR_FIRST_PASS, ... }, + { PARAM => VALUE_FOR_SECOND_PASS, ... } + ... + ] + } + ); + +=cut + + +sub param { + my $self = shift; + my $options = $self->{options}; + my $param_map = $self->{param_map}; + + # the no-parameter case - return list of parameters in the template. + return keys(%$param_map) unless scalar(@_); + + my $first = shift; + my $type = ref $first; + + # the one-parameter case - could be a parameter value request or a + # hash-ref. + if (!scalar(@_) and !length($type)) { + my $param = $options->{case_sensitive} ? $first : lc $first; + + # check for parameter existence + $options->{die_on_bad_params} and !exists($param_map->{$param}) and + croak("HTML::Template : Attempt to get nonexistent parameter '$param' - this parameter name doesn't match any declarations in the template file : (die_on_bad_params set => 1)"); + + return undef unless (exists($param_map->{$param}) and + defined($param_map->{$param})); + + return ${$param_map->{$param}} if + (ref($param_map->{$param}) eq 'HTML::Template::VAR'); + return $param_map->{$param}[HTML::Template::LOOP::PARAM_SET]; + } + + if (!scalar(@_)) { + croak("HTML::Template->param() : Single reference arg to param() must be a hash-ref! You gave me a $type.") + unless $type eq 'HASH' or + (ref($first) and UNIVERSAL::isa($first, 'HASH')); + push(@_, %$first); + } else { + unshift(@_, $first); + } + + croak("HTML::Template->param() : You gave me an odd number of parameters to param()!") + unless ((@_ % 2) == 0); + + # strangely, changing this to a "while(@_) { shift, shift }" type + # loop causes perl 5.004_04 to die with some nonsense about a + # read-only value. + for (my $x = 0; $x <= $#_; $x += 2) { + my $param = $options->{case_sensitive} ? $_[$x] : lc $_[$x]; + my $value = $_[($x + 1)]; + + # check that this param exists in the template + $options->{die_on_bad_params} and !exists($param_map->{$param}) and + croak("HTML::Template : Attempt to set nonexistent parameter '$param' - this parameter name doesn't match any declarations in the template file : (die_on_bad_params => 1)"); + + # if we're not going to die from bad param names, we need to ignore + # them... + next unless (exists($param_map->{$param})); + + # figure out what we've got, taking special care to allow for + # objects that are compatible underneath. + my $value_type = ref($value); + if (defined($value_type) and length($value_type) and ($value_type eq 'ARRAY' or ((ref($value) !~ /^(CODE)|(HASH)|(SCALAR)$/) and $value->isa('ARRAY')))) { + (ref($param_map->{$param}) eq 'HTML::Template::LOOP') or + croak("HTML::Template::param() : attempt to set parameter '$param' with an array ref - parameter is not a TMPL_LOOP!"); + $param_map->{$param}[HTML::Template::LOOP::PARAM_SET] = [@{$value}]; + } else { + (ref($param_map->{$param}) eq 'HTML::Template::VAR') or + croak("HTML::Template::param() : attempt to set parameter '$param' with a scalar - parameter is not a TMPL_VAR!"); + ${$param_map->{$param}} = $value; + } + } +} + +=pod + +=head2 clear_params() + +Sets all the parameters to undef. Useful internally, if nowhere else! + +=cut + +sub clear_params { + my $self = shift; + my $type; + foreach my $name (keys %{$self->{param_map}}) { + $type = ref($self->{param_map}{$name}); + undef(${$self->{param_map}{$name}}) + if ($type eq 'HTML::Template::VAR'); + undef($self->{param_map}{$name}[HTML::Template::LOOP::PARAM_SET]) + if ($type eq 'HTML::Template::LOOP'); + } +} + + +# obsolete implementation of associate +sub associateCGI { + my $self = shift; + my $cgi = shift; + (ref($cgi) eq 'CGI') or + croak("Warning! non-CGI object was passed to HTML::Template::associateCGI()!\n"); + push(@{$self->{options}{associate}}, $cgi); + return 1; +} + + +=head2 output() + +output() returns the final result of the template. In most situations +you'll want to print this, like: + + print $template->output(); + +When output is called each occurrence of is +replaced with the value assigned to "name" via param(). If a named +parameter is unset it is simply replaced with ''. are +evaluated once per parameter set, accumlating output on each pass. + +Calling output() is guaranteed not to change the state of the +Template object, in case you were wondering. This property is mostly +important for the internal implementation of loops. + +You may optionally supply a filehandle to print to automatically as +the template is generated. This may improve performance and lower +memory consumption. Example: + + $template->output(print_to => *STDOUT); + +The return value is undefined when using the "print_to" option. + +=cut + +use vars qw(%URLESCAPE_MAP); +sub output { + my $self = shift; + my $options = $self->{options}; + local $_; + + croak("HTML::Template->output() : You gave me an odd number of parameters to output()!") + unless ((@_ % 2) == 0); + my %args = @_; + + print STDERR "### HTML::Template Memory Debug ### START OUTPUT ", $self->{proc_mem}->size(), "\n" + if $options->{memory_debug}; + + $options->{debug} and print STDERR "### HTML::Template Debug ### In output\n"; + + # want a stack dump? + if ($options->{stack_debug}) { + require 'Data/Dumper.pm'; + print STDERR "### HTML::Template output Stack Dump ###\n\n", Data::Dumper::Dumper($self->{parse_stack}), "\n"; + } + + # globalize vars - this happens here to localize the circular + # references created by global_vars. + $self->_globalize_vars() if ($options->{global_vars}); + + # support the associate magic, searching for undefined params and + # attempting to fill them from the associated objects. + if (scalar(@{$options->{associate}})) { + # prepare case-mapping hashes to do case-insensitive matching + # against associated objects. This allows CGI.pm to be + # case-sensitive and still work with asssociate. + my (%case_map, $lparam); + foreach my $associated_object (@{$options->{associate}}) { + # what a hack! This should really be optimized out for case_sensitive. + if ($options->{case_sensitive}) { + map { + $case_map{$associated_object}{$_} = $_ + } $associated_object->param(); + } else { + map { + $case_map{$associated_object}{lc($_)} = $_ + } $associated_object->param(); + } + } + + foreach my $param (keys %{$self->{param_map}}) { + unless (defined($self->param($param))) { + OBJ: foreach my $associated_object (reverse @{$options->{associate}}) { + $self->param($param, scalar $associated_object->param($case_map{$associated_object}{$param})), last OBJ + if (exists($case_map{$associated_object}{$param})); + } + } + } + } + + use vars qw($line @parse_stack); local(*line, *parse_stack); + + # walk the parse stack, accumulating output in $result + *parse_stack = $self->{parse_stack}; + my $result = ''; + + tie $result, 'HTML::Template::PRINTSCALAR', $args{print_to} + if defined $args{print_to} and not tied $args{print_to}; + + my $type; + my $parse_stack_length = $#parse_stack; + for (my $x = 0; $x <= $parse_stack_length; $x++) { + *line = \$parse_stack[$x]; + $type = ref($line); + + if ($type eq 'SCALAR') { + $result .= $$line; + } elsif ($type eq 'HTML::Template::VAR' and ref($$line) eq 'CODE') { + defined($$line) and $result .= $$line->($self); + } elsif ($type eq 'HTML::Template::VAR') { + defined($$line) and $result .= $$line; + } elsif ($type eq 'HTML::Template::LOOP') { + if (defined($line->[HTML::Template::LOOP::PARAM_SET])) { + eval { $result .= $line->output($x, $options->{loop_context_vars}); }; + croak("HTML::Template->output() : fatal error in loop output : $@") + if $@; + } + } elsif ($type eq 'HTML::Template::COND') { + if ($line->[HTML::Template::COND::JUMP_IF_TRUE]) { + if ($line->[HTML::Template::COND::VARIABLE_TYPE] == HTML::Template::COND::VARIABLE_TYPE_VAR) { + if (defined ${$line->[HTML::Template::COND::VARIABLE]}) { + if (ref(${$line->[HTML::Template::COND::VARIABLE]}) eq 'CODE') { + $x = $line->[HTML::Template::COND::JUMP_ADDRESS] if ${$line->[HTML::Template::COND::VARIABLE]}->($self); + } else { + $x = $line->[HTML::Template::COND::JUMP_ADDRESS] if ${$line->[HTML::Template::COND::VARIABLE]}; + } + } + } else { + $x = $line->[HTML::Template::COND::JUMP_ADDRESS] if + (defined $line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET] and + scalar @{$line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET]}); + } + } else { + if ($line->[HTML::Template::COND::VARIABLE_TYPE] == HTML::Template::COND::VARIABLE_TYPE_VAR) { + if (defined ${$line->[HTML::Template::COND::VARIABLE]}) { + if (ref(${$line->[HTML::Template::COND::VARIABLE]}) eq 'CODE') { + $x = $line->[HTML::Template::COND::JUMP_ADDRESS] unless ${$line->[HTML::Template::COND::VARIABLE]}->($self); + } else { + $x = $line->[HTML::Template::COND::JUMP_ADDRESS] unless ${$line->[HTML::Template::COND::VARIABLE]}; + } + } else { + $x = $line->[HTML::Template::COND::JUMP_ADDRESS]; + } + } else { + $x = $line->[HTML::Template::COND::JUMP_ADDRESS] if + (not defined $line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET] or + not scalar @{$line->[HTML::Template::COND::VARIABLE][HTML::Template::LOOP::PARAM_SET]}); + } + } + } elsif ($type eq 'HTML::Template::NOOP') { + next; + } elsif ($type eq 'HTML::Template::DEFAULT') { + $_ = $x; # remember default place in stack + + # find next VAR, there might be an ESCAPE in the way + *line = \$parse_stack[++$x]; + *line = \$parse_stack[++$x] if ref $line eq 'HTML::Template::ESCAPE'; + + # either output the default or go back + if (defined $$line) { + $x = $_; + } else { + $result .= ${$parse_stack[$_]}; + } + next; + } elsif ($type eq 'HTML::Template::ESCAPE') { + *line = \$parse_stack[++$x]; + if (defined($$line)) { + $_ = $$line; + + # straight from the CGI.pm bible. + s/&/&/g; + s/\"/"/g; #" + s/>/>/g; + s/hex map if one isn't already available + unless (exists($URLESCAPE_MAP{chr(1)})) { + for (0..255) { $URLESCAPE_MAP{chr($_)} = sprintf('%%%02X', $_); } + } + # do the translation (RFC 2396 ^uric) + s!([^a-zA-Z0-9_.\-])!$URLESCAPE_MAP{$1}!g; + $result .= $_; + } + } else { + confess("HTML::Template::output() : Unknown item in parse_stack : " . $type); + } + } + + # undo the globalization circular refs + $self->_unglobalize_vars() if ($options->{global_vars}); + + print STDERR "### HTML::Template Memory Debug ### END OUTPUT ", $self->{proc_mem}->size(), "\n" + if $options->{memory_debug}; + + return undef if defined $args{print_to}; + return $result; +} + +=pod + +=head2 query() + +This method allow you to get information about the template structure. +It can be called in a number of ways. The simplest usage of query is +simply to check whether a parameter name exists in the template, using +the C option: + + if ($template->query(name => 'foo')) { + # do something if a varaible of any type + # named FOO is in the template + } + +This same usage returns the type of the parameter. The type is the +same as the tag minus the leading 'TMPL_'. So, for example, a +TMPL_VAR parameter returns 'VAR' from query(). + + if ($template->query(name => 'foo') eq 'VAR') { + # do something if FOO exists and is a TMPL_VAR + } + +Note that the variables associated with TMPL_IFs and TMPL_UNLESSs will +be identified as 'VAR' unless they are also used in a TMPL_LOOP, in +which case they will return 'LOOP'. + +C also allows you to get a list of parameters inside a loop +(and inside loops inside loops). Example loop: + + + + + + + + + + +And some query calls: + + # returns 'LOOP' + $type = $template->query(name => 'EXAMPLE_LOOP'); + + # returns ('bop', 'bee', 'example_inner_loop') + @param_names = $template->query(loop => 'EXAMPLE_LOOP'); + + # both return 'VAR' + $type = $template->query(name => ['EXAMPLE_LOOP', 'BEE']); + $type = $template->query(name => ['EXAMPLE_LOOP', 'BOP']); + + # and this one returns 'LOOP' + $type = $template->query(name => ['EXAMPLE_LOOP', + 'EXAMPLE_INNER_LOOP']); + + # and finally, this returns ('inner_bee', 'inner_bop') + @inner_param_names = $template->query(loop => ['EXAMPLE_LOOP', + 'EXAMPLE_INNER_LOOP']); + + # for non existent parameter names you get undef + # this returns undef. + $type = $template->query(name => 'DWEAZLE_ZAPPA'); + + # calling loop on a non-loop parameter name will cause an error. + # this dies: + $type = $template->query(loop => 'DWEAZLE_ZAPPA'); + +As you can see above the C option returns a list of parameter +names and both C and C take array refs in order to refer +to parameters inside loops. It is an error to use C with a +parameter that is not a loop. + +Note that all the names are returned in lowercase and the types are +uppercase. + +Just like C, C with no arguements returns all the +parameter names in the template at the top level. + +=cut + +sub query { + my $self = shift; + $self->{options}{debug} and print STDERR "### HTML::Template Debug ### query(", join(', ', @_), ")\n"; + + # the no-parameter case - return $self->param() + return $self->param() unless scalar(@_); + + croak("HTML::Template::query() : Odd number of parameters passed to query!") + if (scalar(@_) % 2); + croak("HTML::Template::query() : Wrong number of parameters passed to query - should be 2.") + if (scalar(@_) != 2); + + my ($opt, $path) = (lc shift, shift); + croak("HTML::Template::query() : invalid parameter ($opt)") + unless ($opt eq 'name' or $opt eq 'loop'); + + # make path an array unless it already is + $path = [$path] unless (ref $path); + + # find the param in question. + my @objs = $self->_find_param(@$path); + return undef unless scalar(@objs); + my ($obj, $type); + + # do what the user asked with the object + if ($opt eq 'name') { + # we only look at the first one. new() should make sure they're + # all the same. + ($obj, $type) = (shift(@objs), shift(@objs)); + return undef unless defined $obj; + return 'VAR' if $type eq 'HTML::Template::VAR'; + return 'LOOP' if $type eq 'HTML::Template::LOOP'; + croak("HTML::Template::query() : unknown object ($type) in param_map!"); + + } elsif ($opt eq 'loop') { + my %results; + while(@objs) { + ($obj, $type) = (shift(@objs), shift(@objs)); + croak("HTML::Template::query() : Search path [", join(', ', @$path), "] doesn't end in a TMPL_LOOP - it is an error to use the 'loop' option on a non-loop parameter. To avoid this problem you can use the 'name' option to query() to check the type first.") + unless ((defined $obj) and ($type eq 'HTML::Template::LOOP')); + + # SHAZAM! This bit extracts all the parameter names from all the + # loop objects for this name. + map {$results{$_} = 1} map { keys(%{$_->{'param_map'}}) } + values(%{$obj->[HTML::Template::LOOP::TEMPLATE_HASH]}); + } + # this is our loop list, return it. + return keys(%results); + } +} + +# a function that returns the object(s) corresponding to a given path and +# its (their) ref()(s). Used by query() in the obvious way. +sub _find_param { + my $self = shift; + my $spot = $self->{options}{case_sensitive} ? shift : lc shift; + + # get the obj and type for this spot + my $obj = $self->{'param_map'}{$spot}; + return unless defined $obj; + my $type = ref $obj; + + # return if we're here or if we're not but this isn't a loop + return ($obj, $type) unless @_; + return unless ($type eq 'HTML::Template::LOOP'); + + # recurse. this is a depth first seach on the template tree, for + # the algorithm geeks in the audience. + return map { $_->_find_param(@_) } + values(%{$obj->[HTML::Template::LOOP::TEMPLATE_HASH]}); +} + +# HTML::Template::VAR, LOOP, etc are *light* objects - their internal +# spec is used above. No encapsulation or information hiding is to be +# assumed. + +package HTML::Template::VAR; + +sub new { + my $value; + return bless(\$value, $_[0]); +} + +package HTML::Template::DEFAULT; + +sub new { + my $value = $_[1]; + return bless(\$value, $_[0]); +} + +package HTML::Template::LOOP; + +sub new { + return bless([], $_[0]); +} + +sub output { + my $self = shift; + my $index = shift; + my $loop_context_vars = shift; + my $template = $self->[TEMPLATE_HASH]{$index}; + my $value_sets_array = $self->[PARAM_SET]; + return unless defined($value_sets_array); + + my $result = ''; + my $count = 0; + my $odd = 0; + foreach my $value_set (@$value_sets_array) { + if ($loop_context_vars) { + if ($count == 0) { + @{$value_set}{qw(__first__ __inner__ __last__)} = (1,0,$#{$value_sets_array} == 0); + } elsif ($count == $#{$value_sets_array}) { + @{$value_set}{qw(__first__ __inner__ __last__)} = (0,0,1); + } else { + @{$value_set}{qw(__first__ __inner__ __last__)} = (0,1,0); + } + $odd = $value_set->{__odd__} = not $odd; + $value_set->{__counter__} = $count + 1; + } + $template->param($value_set); + $result .= $template->output; + $template->clear_params; + @{$value_set}{qw(__first__ __last__ __inner__ __odd__ __counter__)} = + (0,0,0,0) + if ($loop_context_vars); + $count++; + } + + return $result; +} + +package HTML::Template::COND; + +sub new { + my $pkg = shift; + my $var = shift; + my $self = []; + $self->[VARIABLE] = $var; + + bless($self, $pkg); + return $self; +} + +package HTML::Template::NOOP; +sub new { + my $unused; + my $self = \$unused; + bless($self, $_[0]); + return $self; +} + +package HTML::Template::ESCAPE; +sub new { + my $unused; + my $self = \$unused; + bless($self, $_[0]); + return $self; +} + +package HTML::Template::URLESCAPE; +sub new { + my $unused; + my $self = \$unused; + bless($self, $_[0]); + return $self; +} + +# scalar-tying package for output(print_to => *HANDLE) implementation +package HTML::Template::PRINTSCALAR; +use strict; + +sub TIESCALAR { bless \$_[1], $_[0]; } +sub FETCH { } +sub STORE { + my $self = shift; + local *FH = $$self; + print FH @_; +} +1; +__END__ + +=head1 FREQUENTLY ASKED QUESTIONS + +In the interest of greater understanding I've started a FAQ section of +the perldocs. Please look in here before you send me email. + +=over 4 + +=item 1 + +Q: Is there a place to go to discuss HTML::Template and/or get help? + +A: There's a mailing-list for discussing HTML::Template at +html-template-users@lists.sourceforge.net. To join: + + http://lists.sourceforge.net/lists/listinfo/html-template-users + +If you just want to get email when new releases are available you can +join the announcements mailing-list here: + + http://lists.sourceforge.net/lists/listinfo/html-template-announce + +=item 2 + +Q: Is there a searchable archive for the mailing-list? + +A: Yes, you can find an archive of the SourceForge list here: + + http://www.geocrawler.com/lists/3/SourceForge/23294/0/ + +For an archive of the old vm.com list, setup by Sean P. Scanlon, see: + + http://bluedot.net/mail/archive/ + +=item 3 + +Q: I want support for ! How about it? + +A: Maybe. I definitely encourage people to discuss their ideas for +HTML::Template on the mailing list. Please be ready to explain to me +how the new tag fits in with HTML::Template's mission to provide a +fast, lightweight system for using HTML templates. + +NOTE: Offering to program said addition and provide it in the form of +a patch to the most recent version of HTML::Template will definitely +have a softening effect on potential opponents! + +=item 4 + +Q: I found a bug, can you fix it? + +A: That depends. Did you send me the VERSION of HTML::Template, a test +script and a test template? If so, then almost certainly. + +If you're feeling really adventurous, HTML::Template has a publically +available CVS server. See below for more information in the PUBLIC +CVS SERVER section. + +=item 5 + +Q: s from the main template aren't working inside a +! Why? + +A: This is the intended behavior. introduces a separate +scope for s much like a subroutine call in Perl introduces a +separate scope for "my" variables. + +If you want your s to be global you can set the +'global_vars' option when you call new(). See above for documentation +of the 'global_vars' new() option. + +=item 6 + +Q: Why do you use /[Tt]/ instead of /t/i? It's so ugly! + +A: Simple - the case-insensitive match switch is very inefficient. +According to _Mastering_Regular_Expressions_ from O'Reilly Press, +/[Tt]/ is faster and more space efficient than /t/i - by as much as +double against long strings. //i essentially does a lc() on the +string and keeps a temporary copy in memory. + +When this changes, and it is in the 5.6 development series, I will +gladly use //i. Believe me, I realize [Tt] is hideously ugly. + +=item 7 + +Q: How can I pre-load my templates using cache-mode and mod_perl? + +A: Add something like this to your startup.pl: + + use HTML::Template; + use File::Find; + + print STDERR "Pre-loading HTML Templates...\n"; + find( + sub { + return unless /\.tmpl$/; + HTML::Template->new( + filename => "$File::Find::dir/$_", + cache => 1, + ); + }, + '/path/to/templates', + '/another/path/to/templates/' + ); + +Note that you'll need to modify the "return unless" line to specify +the extension you use for your template files - I use .tmpl, as you +can see. You'll also need to specify the path to your template files. + +One potential problem: the "/path/to/templates/" must be EXACTLY the +same path you use when you call HTML::Template->new(). Otherwise the +cache won't know they're the same file and will load a new copy - +instead getting a speed increase, you'll double your memory usage. To +find out if this is happening set cache_debug => 1 in your application +code and look for "CACHE MISS" messages in the logs. + +=item 8 + +Q: What characters are allowed in TMPL_* NAMEs? + +A: Numbers, letters, '.', '/', '+', '-' and '_'. + +=item 9 + +Q: How can I execute a program from inside my template? + +A: Short answer: you can't. Longer answer: you shouldn't since this +violates the fundamental concept behind HTML::Template - that design +and code should be seperate. + +But, inevitably some people still want to do it. If that describes +you then you should take a look at +L. Using +HTML::Template::Expr it should be easy to write a run_program() +function. Then you can do awful stuff like: + + + +Just, please, don't tell me about it. I'm feeling guilty enough just +for writing HTML::Template::Expr in the first place. + +=item 10 + +Q: Can I get a copy of these docs in Japanese? + +A: Yes you can. See Kawai Takanori's translation at: + + http://member.nifty.ne.jp/hippo2000/perltips/html/template.htm + +=item 11 + +Q: What's the best way to create a element entirely inside the +template. What you end up with is a rat's nest of loops and conditionals. +Alternately you can give up a certain amount of flexibility in return for +vastly simplifying your templates. I generally choose the latter. + +Another option is to investigate HTML::FillInForm which some have +reported success using to solve this problem. + +=back + +=head1 BUGS + +I am aware of no bugs - if you find one, join the mailing list and +tell us about it. You can join the HTML::Template mailing-list by +visiting: + + http://lists.sourceforge.net/lists/listinfo/html-template-users + +Of course, you can still email me directly (sam@tregar.com) with bugs, +but I reserve the right to forward bug reports to the mailing list. + +When submitting bug reports, be sure to include full details, +including the VERSION of the module, a test script and a test template +demonstrating the problem! + +If you're feeling really adventurous, HTML::Template has a publically +available CVS server. See below for more information in the PUBLIC +CVS SERVER section. + +=head1 CREDITS + +This module was the brain child of my boss, Jesse Erlbaum +( jesse@vm.com ) at Vanguard Media ( http://vm.com ) . The most original +idea in this module - the - was entirely his. + +Fixes, Bug Reports, Optimizations and Ideas have been generously +provided by: + + Richard Chen + Mike Blazer + Adriano Nagelschmidt Rodrigues + Andrej Mikus + Ilya Obshadko + Kevin Puetz + Steve Reppucci + Richard Dice + Tom Hukins + Eric Zylberstejn + David Glasser + Peter Marelas + James William Carlson + Frank D. Cringle + Winfried Koenig + Matthew Wickline + Doug Steinwand + Drew Taylor + Tobias Brox + Michael Lloyd + Simran Gambhir + Chris Houser + Larry Moore + Todd Larason + Jody Biggs + T.J. Mather + Martin Schroth + Dave Wolfe + uchum + Kawai Takanori + Peter Guelich + Chris Nokleberg + Ralph Corderoy + William Ward + Ade Olonoh + Mark Stosberg + Lance Thomas + Roland Giersig + Jere Julian + Peter Leonard + Kenny Smith + Sean P. Scanlon + Martin Pfeffer + David Ferrance + Gyepi Sam + Darren Chamberlain + +Thanks! + +=head1 WEBSITE + +You can find information about HTML::Template and other related modules at: + + http://html-template.sourceforge.net + +=head1 PUBLIC CVS SERVER + +HTML::Template now has a publicly accessible CVS server provided by +SourceForge (www.sourceforge.net). You can access it by going to +http://sourceforge.net/cvs/?group_id=1075. Give it a try! + +=head1 AUTHOR + +Sam Tregar, sam@tregar.com + +=head1 LICENSE + + HTML::Template : A module for using HTML Templates with Perl + Copyright (C) 2000-2002 Sam Tregar (sam@tregar.com) + + This module is free software; you can redistribute it and/or modify it + under the terms of either: + + a) the GNU General Public License as published by the Free Software + Foundation; either version 1, or (at your option) any later version, + + or + + b) the "Artistic License" which comes with this module. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either + the GNU General Public License or the Artistic License for more details. + + You should have received a copy of the Artistic License with this + module, in the file ARTISTIC. If not, I'll be glad to provide one. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 + USA + +=cut diff --git a/lib/HTML/Template/Expr.pm b/lib/HTML/Template/Expr.pm new file mode 100644 index 0000000..e6c9dd9 --- /dev/null +++ b/lib/HTML/Template/Expr.pm @@ -0,0 +1,688 @@ +package HTML::Template::Expr; + +use strict; +use vars qw($VERSION); + +$VERSION = '0.04'; + +use HTML::Template 2.4; +use Carp qw(croak confess carp); +use Parse::RecDescent; + +use base 'HTML::Template'; + +# constants used in the expression tree +use constant BIN_OP => 1; +use constant FUNCTION_CALL => 2; + +use vars qw($GRAMMAR); +$GRAMMAR = < + +binary_op : '(' subexpression op subexpression ')' + { [ \$item[3][0], \$item[3][1], \$item[2], \$item[4] ] } + +op : />=?|<=?|!=|==/ { [ ${\BIN_OP}, \$item[1] ] } + | /le|ge|eq|ne|lt|gt/ { [ ${\BIN_OP}, \$item[1] ] } + | /\\|\\||or|&&|and/ { [ ${\BIN_OP}, \$item[1] ] } + | /[-+*\\/\%]/ { [ ${\BIN_OP}, \$item[1] ] } + +function_call : function_name '(' args ')' + { [ ${\FUNCTION_CALL}, \$item[1], \$item[3] ] } + | function_name ...'(' subexpression + { [ ${\FUNCTION_CALL}, \$item[1], [ \$item[3] ] ] } + | function_name '(' ')' + { [ ${\FUNCTION_CALL}, \$item[1] ] } + +function_name : /[A-Za-z_][A-Za-z0-9_]*/ + { \$item[1] } + +args : + +var : /[A-Za-z_][A-Za-z0-9_]*/ { \\\$item[1] } + +literal : /-?\\d*\\.\\d+/ { \$item[1] } + | /-?\\d+/ { \$item[1] } + | { \$item[1][2] } + +END + + +# create global parser +use vars qw($PARSER); +$PARSER = Parse::RecDescent->new($GRAMMAR); + +# initialize preset function table +use vars qw(%FUNC); +%FUNC = + ( + 'sprintf' => sub { sprintf(shift, @_); }, + 'substr' => sub { + return substr($_[0], $_[1]) if @_ == 2; + return substr($_[0], $_[1], $_[2]); + }, + 'lc' => sub { lc($_[0]); }, + 'lcfirst' => sub { lcfirst($_[0]); }, + 'uc' => sub { uc($_[0]); }, + 'ucfirst' => sub { ucfirst($_[0]); }, + 'length' => sub { length($_[0]); }, + 'defined' => sub { defined($_[0]); }, + 'abs' => sub { abs($_[0]); }, + 'atan2' => sub { atan2($_[0], $_[1]); }, + 'cos' => sub { cos($_[0]); }, + 'exp' => sub { exp($_[0]); }, + 'hex' => sub { hex($_[0]); }, + 'int' => sub { int($_[0]); }, + 'log' => sub { log($_[0]); }, + 'oct' => sub { oct($_[0]); }, + 'rand' => sub { rand($_[0]); }, + 'sin' => sub { sin($_[0]); }, + 'sqrt' => sub { sqrt($_[0]); }, + 'srand' => sub { srand($_[0]); }, + ); + +sub new { + my $pkg = shift; + my $self; + + # check hashworthyness + croak("HTML::Template::Expr->new() called with odd number of option parameters - should be of the form option => value") + if (@_ % 2); + my %options = @_; + + # check for unsupported options file_cache and shared_cache + croak("HTML::Template::Expr->new() : sorry, this module won't work with file_cache or shared_cache modes. This will hopefully be fixed in an upcoming version.") + if ($options{file_cache} or $options{shared_cache}); + + # push on our filter, one way or another. Why did I allow so many + # different ways to say the same thing? Was I smoking crack? + my @expr; + if (exists $options{filter}) { + # CODE => ARRAY + $options{filter} = [ { 'sub' => $options{filter}, + 'format' => 'scalar' } ] + if ref($options{filter}) eq 'CODE'; + + # HASH => ARRAY + $options{filter} = [ $options{filter} ] + if ref($options{filter}) eq 'HASH'; + + # push onto ARRAY + if (ref($options{filter}) eq 'ARRAY') { + push(@{$options{filter}}, { 'sub' => sub { _expr_filter(\@expr, @_); }, + 'format' => 'scalar' }); + } else { + # unrecognized + croak("HTML::Template::Expr->new() : bad format for filter argument. Please check the HTML::Template docs for the allowed forms."); + } + } else { + # new filter + $options{filter} = [ { 'sub' => sub { _expr_filter(\@expr, @_) }, + 'format' => 'scalar' + } ]; + } + + # force global_vars on + $options{global_vars} = 1; + + # create an HTML::Template object, catch the results to keep error + # message line-numbers helpful. + eval { + $self = $pkg->SUPER::new(%options, + expr => \@expr, + expr_func => $options{functions} || {}); + }; + croak("HTML::Template::Expr->new() : Error creating HTML::Template object : $@") if $@; + + return $self; +} + +sub _expr_filter { + my $expr = shift; + my $text = shift; + + # find expressions and create parse trees + my ($ref, $tree, $expr_text, $vars, $which, $out); + $$text =~ s/<(?:!--\s*)?[Tt][Mm][Pp][Ll]_([Ii][Ff]|[Uu][Nn][Ll][Ee][Ss][Ss]|[Vv][Aa][Rr])\s+[Ee][Xx][Pp][Rr]="(.*?)"\s*(?:--)?> + / + $which = $1; + $expr_text = $2; + + # add enclosing parens to keep grammar simple + $expr_text = "($expr_text)"; + + # parse the expression + eval { + $tree = $PARSER->expression($expr_text); + }; + croak("HTML::Template::Expr : Unable to parse expression: $expr_text") + if $@ or not $tree; + + # stub out variables needed by the expression + $out = ""; + foreach my $var (_expr_vars($tree)) { + next unless defined $var; + $out .= ""; + } + + # save parse tree for later + push(@$expr, $tree); + + # add the expression placeholder and replace + $out . "<\/tmpl_if>"; + /xeg; + # stupid emacs - / + + return; +} + +# find all variables in a parse tree +sub _expr_vars { + my %vars; + + while(@_) { + my $node = shift; + if (ref($node)) { + if (ref $node eq 'SCALAR') { + # found a variable + $vars{$$node} = 1; + } elsif ($node->[0] == FUNCTION_CALL) { + # function calls + push(@_, @{$node->[2]}) if defined $node->[2]; + } else { + # binary ops + push(@_, $node->[2], $node->[3]); + } + } + } + + return keys %vars; +} + + +sub output { + my $self = shift; + my $parse_stack = $self->{parse_stack}; + my $options = $self->{options}; + my ($expr, $expr_func); + + # pull expr and expr_func out of the parse_stack for cache mode. + if ($options->{cache}) { + $expr = pop @$parse_stack; + $expr_func = pop @$parse_stack; + } else { + $expr = $options->{expr}; + $expr_func = $options->{expr_func}; + } + + # setup expression evaluators + my %param; + for (my $x = 0; $x < @$expr; $x++) { + my $node = $expr->[$x]; + $param{"__expr_" . $x . "__"} = sub { _expr_evaluate($node, @_) }; + } + $self->param(\%param); + + # setup %FUNC + local %FUNC = (%FUNC, %$expr_func); + + my $result = HTML::Template::output($self, @_); + + # restore cached values to their hideout in the parse_stack + if ($options->{cache}) { + push @$parse_stack, $expr_func; + push @$parse_stack, $expr; + } + + return $result; +} + +sub _expr_evaluate { + my ($tree, $template) = @_; + my ($op, $lhs, $rhs); + + # return literals up + return $tree unless ref $tree; + + # lookup vars + return $template->param($$tree) + if ref $tree eq 'SCALAR'; + + my $type = $tree->[0]; + + # handle binary expressions + if ($type == BIN_OP) { + ($op, $lhs, $rhs) = ($tree->[1], $tree->[2], $tree->[3]); + + # recurse and resolve subexpressions + $lhs = _expr_evaluate($lhs, $template) if ref($lhs); + $rhs = _expr_evaluate($rhs, $template) if ref($rhs); + + # do the op + $op eq '==' and return $lhs == $rhs; + $op eq 'eq' and return $lhs eq $rhs; + $op eq '>' and return $lhs > $rhs; + $op eq '<' and return $lhs < $rhs; + + $op eq '!=' and return $lhs != $rhs; + $op eq 'ne' and return $lhs ne $rhs; + $op eq '>=' and return $lhs >= $rhs; + $op eq '<=' and return $lhs <= $rhs; + + $op eq '+' and return $lhs + $rhs; + $op eq '-' and return $lhs - $rhs; + $op eq '/' and return $lhs / $rhs; + $op eq '*' and return $lhs * $rhs; + $op eq '%' and return $lhs % $rhs; + + if ($op eq 'or' or $op eq '||') { + # short circuit or + $lhs = _expr_evaluate($lhs, $template) if ref $lhs; + return 1 if $lhs; + $rhs = _expr_evaluate($rhs, $template) if ref $rhs; + return 1 if $rhs; + return 0; + } else { + # short circuit and + $lhs = _expr_evaluate($lhs, $template) if ref $lhs; + return 0 unless $lhs; + $rhs = _expr_evaluate($rhs, $template) if ref $rhs; + return 0 unless $rhs; + return 1; + } + + $op eq 'le' and return $lhs le $rhs; + $op eq 'ge' and return $lhs ge $rhs; + $op eq 'lt' and return $lhs lt $rhs; + $op eq 'gt' and return $lhs gt $rhs; + + confess("HTML::Template::Expr : unknown op: $op"); + } + + if ($type == FUNCTION_CALL) { + croak("HTML::Template::Expr : found unknown subroutine call : $tree->[1]\n") unless exists($FUNC{$tree->[1]}); + + if (defined $tree->[2]) { + return $FUNC{$tree->[1]}->( + map { _expr_evaluate($_, $template) } @{$tree->[2]} + ); + } else { + return $FUNC{$tree->[1]}->(); + } + } + + croak("HTML::Template::Expr : fell off the edge of _expr_evaluate()! This is a bug - please report it to the author."); +} + +sub register_function { + my($class, $name, $sub) = @_; + + croak("HTML::Template::Expr : args 3 of register_function must be subroutine reference\n") + unless ref($sub) eq 'CODE'; + + $FUNC{$name} = $sub; +} + + +# Make caching work right by hiding our vars in the parse_stack +# between cache store and load. This is such a hack. +sub _commit_to_cache { + my $self = shift; + my $parse_stack = $self->{parse_stack}; + + push @$parse_stack, $self->{options}{expr_func}; + push @$parse_stack, $self->{options}{expr}; + + my $result = HTML::Template::_commit_to_cache($self, @_); +} + +1; +__END__ +=pod + +=head1 NAME + +HTML::Template::Expr - HTML::Template extension adding expression support + +=head1 SYNOPSIS + + use HTML::Template::Expr; + + my $template = HTML::Template::Expr->new(filename => 'foo.tmpl'); + $template->param(banana_count => 10); + print $template->output(); + +=head1 DESCRIPTION + +This module provides an extension to HTML::Template which allows +expressions in the template syntax. This is purely an addition - all +the normal HTML::Template options, syntax and behaviors will still +work. See L for details. + +Expression support includes comparisons, math operations, string +operations and a mechanism to allow you add your own functions at +runtime. The basic syntax is: + + + I've got a lot of bananas. + + +This will output "I've got a lot of bananas" if you call: + + $template->param(banana_count => 100); + +In your script. s also work with expressions: + + I'd like to have bananas. + +This will output "I'd like to have 200 bananas." with the same param() +call as above. + +=head1 MOTIVATION + +Some of you may wonder if I've been replaced by a pod person. Just +for the record, I still think this sort of thing should be avoided. +However, I realize that there are some situations where allowing the +template author some programatic leeway can be invaluable. + +If you don't like it, don't use this module. Keep using plain ol' +HTML::Template - I know I will! However, if you find yourself needing +a little programming in your template, for whatever reason, then this +module may just save you from HTML::Mason. + +=head1 BASIC SYNTAX + +Variables are unquoted alphanumeric strings with the same restrictions +as variable names in HTML::Template. Their values are set through +param(), just like normal HTML::Template variables. For example, +these two lines are equivalent: + + + + + +Numbers are unquoted strings of numbers and may have a single "." to +indicate a floating point number. For example: + + + +String constants must be enclosed in quotes, single or double. For example: + + + +The parser is currently rather simple, so all compound expressions +must be parenthesized. Examples: + + + + + +If you don't like this rule please feel free to contribute a patch +to improve the parser's grammar. + +=head1 COMPARISON + +Here's a list of supported comparison operators: + +=over 4 + +=item * Numeric Comparisons + +=over 4 + +=item * E + +=item * E + +=item * == + +=item * != + +=item * E= + +=item * E= + +=item * E=E + +=back 4 + +=item * String Comparisons + +=over 4 + +=item * gt + +=item * lt + +=item * eq + +=item * ne + +=item * ge + +=item * le + +=item * cmp + +=back 4 + +=back 4 + +=head1 MATHEMATICS + +The basic operators are supported: + +=over 4 + +=item * + + +=item * - + +=item * * + +=item * / + +=item * % + +=back 4 + +There are also some mathy functions. See the FUNCTIONS section below. + +=head1 LOGIC + +Boolean logic is available: + +=over 4 + +=item * && (synonym: and) + +=item * || (synonym: or) + +=back 4 + +=head1 FUNCTIONS + +The following functions are available to be used in expressions. See +perldoc perlfunc for details. + +=over 4 + +=item * sprintf + +=item * substr (2 and 3 arg versions only) + +=item * lc + +=item * lcfirst + +=item * uc + +=item * ucfirst + +=item * length + +=item * defined + +=item * abs + +=item * atan2 + +=item * cos + +=item * exp + +=item * hex + +=item * int + +=item * log + +=item * oct + +=item * rand + +=item * sin + +=item * sqrt + +=item * srand + +=back 4 + +All functions must be called using full parenthesis. For example, +this is a syntax error: + + + +But this is good: + + + +=head1 DEFINING NEW FUNCTIONS + +To define a new function, pass a C option to new: + + $t = HTML::Template::Expr->new(filename => 'foo.tmpl', + functions => + { func_name => \&func_handler }); + +Or, you can use C class method to register +the function globally: + + HTML::Template::Expr->register_function(func_name => \&func_handler); + +You provide a subroutine reference that will be called during output. +It will recieve as arguments the parameters specified in the template. +For example, here's a function that checks if a directory exists: + + sub directory_exists { + my $dir_name = shift; + return 1 if -d $dir_name; + return 0; + } + +If you call HTML::Template::Expr->new() with a C arg: + + $t = HTML::Template::Expr->new(filename => 'foo.tmpl', + functions => { + directory_exists => \&directory_exists + }); + +Then you can use it in your template: + + + +This can be abused in ways that make my teeth hurt. + +=head1 MOD_PERL TIP + +C class method can be called in mod_perl's +startup.pl to define widely used common functions to +HTML::Template::Expr. Add something like this to your startup.pl: + + use HTML::Template::Expr; + + HTML::Template::Expr->register_function(foozicate => sub { ... }); + HTML::Template::Expr->register_function(barify => sub { ... }); + HTML::Template::Expr->register_function(baznate => sub { ... }); + +You might also want to pre-compile some commonly used templates and +cache them. See L's FAQ for instructions. + +=head1 CAVEATS + +Currently the module forces the HTML::Template global_vars option to +be set. This will hopefully go away in a future version, so if you +need global_vars in your templates then you should set it explicitely. + +The module won't work with HTML::Template's file_cache or shared_cache +modes, but normal memory caching should work. I hope to address this +is a future version. + +The module is inefficient, both in parsing and evaluation. I'll be +working on this for future versions and patches are always welcome. + +=head1 BUGS + +I am aware of no bugs - if you find one, join the mailing list and +tell us about it. You can join the HTML::Template mailing-list by +visiting: + + http://lists.sourceforge.net/lists/listinfo/html-template-users + +Of course, you can still email me directly (sam@tregar.com) with bugs, +but I reserve the right to forward bug reports to the mailing list. + +When submitting bug reports, be sure to include full details, +including the VERSION of the module, a test script and a test template +demonstrating the problem! + +=head1 CREDITS + +The following people have generously submitted bug reports, patches +and ideas: + + Peter Leonard + Tatsuhiko Miyagawa + +Thanks! + +=head1 AUTHOR + +Sam Tregar + +=head1 LICENSE + +HTML::Template::Expr : HTML::Template extension adding expression support + +Copyright (C) 2001 Sam Tregar (sam@tregar.com) + +This module is free software; you can redistribute it and/or modify it +under the terms of either: + +a) the GNU General Public License as published by the Free Software +Foundation; either version 1, or (at your option) any later version, +or + +b) the "Artistic License" which comes with this module. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either +the GNU General Public License or the Artistic License for more details. + +You should have received a copy of the Artistic License with this +module, in the file ARTISTIC. If not, I'll be glad to provide one. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +USA + diff --git a/lib/MIME/Base64.pm b/lib/MIME/Base64.pm new file mode 100644 index 0000000..f29c889 --- /dev/null +++ b/lib/MIME/Base64.pm @@ -0,0 +1,202 @@ +# +# $Id: Base64.pm,v 2.16 2001/02/24 06:28:10 gisle Exp $ + +package MIME::Base64; + +=head1 NAME + +MIME::Base64 - Encoding and decoding of base64 strings + +=head1 SYNOPSIS + + use MIME::Base64; + + $encoded = encode_base64('Aladdin:open sesame'); + $decoded = decode_base64($encoded); + +=head1 DESCRIPTION + +This module provides functions to encode and decode strings into the +Base64 encoding specified in RFC 2045 - I. The Base64 encoding is designed to represent +arbitrary sequences of octets in a form that need not be humanly +readable. A 65-character subset ([A-Za-z0-9+/=]) of US-ASCII is used, +enabling 6 bits to be represented per printable character. + +The following functions are provided: + +=over 4 + +=item encode_base64($str, [$eol]) + +Encode data by calling the encode_base64() function. The first +argument is the string to encode. The second argument is the line +ending sequence to use (it is optional and defaults to C<"\n">). The +returned encoded string is broken into lines of no more than 76 +characters each and it will end with $eol unless it is empty. Pass an +empty string as second argument if you do not want the encoded string +broken into lines. + +=item decode_base64($str) + +Decode a base64 string by calling the decode_base64() function. This +function takes a single argument which is the string to decode and +returns the decoded data. + +Any character not part of the 65-character base64 subset set is +silently ignored. Characters occuring after a '=' padding character +are never decoded. + +If the length of the string to decode (after ignoring +non-base64 chars) is not a multiple of 4 or padding occurs too ealy, +then a warning is generated if perl is running under C<-w>. + +=back + +If you prefer not to import these routines into your namespace you can +call them as: + + use MIME::Base64 (); + $encoded = MIME::Base64::encode($decoded); + $decoded = MIME::Base64::decode($encoded); + +=head1 DIAGNOSTICS + +The following warnings might be generated if perl is invoked with the +C<-w> switch: + +=over 4 + +=item Premature end of base64 data + +The number of characters to decode is not a multiple of 4. Legal +base64 data should be padded with one or two "=" characters to make +its length a multiple of 4. The decoded result will anyway be as if +the padding was there. + +=item Premature padding of base64 data + +The '=' padding character occurs as the first or second character +in a base64 quartet. + +=back + +=head1 EXAMPLES + +If you want to encode a large file, you should encode it in chunks +that are a multiple of 57 bytes. This ensures that the base64 lines +line up and that you do not end up with padding in the middle. 57 +bytes of data fills one complete base64 line (76 == 57*4/3): + + use MIME::Base64 qw(encode_base64); + + open(FILE, "/var/log/wtmp") or die "$!"; + while (read(FILE, $buf, 60*57)) { + print encode_base64($buf); + } + +or if you know you have enough memory + + use MIME::Base64 qw(encode_base64); + local($/) = undef; # slurp + print encode_base64(); + +The same approach as a command line: + + perl -MMIME::Base64 -0777 -ne 'print encode_base64($_)' and Joerg Reichelt and +code posted to comp.lang.perl <3pd2lp$6gf@wsinti07.win.tue.nl> by Hans +Mulder + +The XS implementation use code from metamail. Copyright 1991 Bell +Communications Research, Inc. (Bellcore) + +=cut + +use strict; +use vars qw(@ISA @EXPORT $VERSION $OLD_CODE); + +require Exporter; +require DynaLoader; +@ISA = qw(Exporter DynaLoader); +@EXPORT = qw(encode_base64 decode_base64); + +$VERSION = '2.12'; + +eval { bootstrap MIME::Base64 $VERSION; }; +if ($@) { + # can't bootstrap XS implementation, use perl implementation + *encode_base64 = \&old_encode_base64; + *decode_base64 = \&old_decode_base64; + + $OLD_CODE = $@; + #warn $@ if $^W; +} + +# Historically this module has been implemented as pure perl code. +# The XS implementation runs about 20 times faster, but the Perl +# code might be more portable, so it is still here. + +use integer; + +sub old_encode_base64 ($;$) +{ + my $res = ""; + my $eol = $_[1]; + $eol = "\n" unless defined $eol; + pos($_[0]) = 0; # ensure start at the beginning + + $res = join '', map( pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); + + $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs + # fix padding at the end + my $padding = (3 - length($_[0]) % 3) % 3; + $res =~ s/.{$padding}$/'=' x $padding/e if $padding; + # break encoded string into lines of no more than 76 characters each + if (length $eol) { + $res =~ s/(.{1,76})/$1$eol/g; + } + return $res; +} + + +sub old_decode_base64 ($) +{ + local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123] + + my $str = shift; + $str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars + if (length($str) % 4) { + require Carp; + Carp::carp("Length of base64 data not a multiple of 4") + } + $str =~ s/=+$//; # remove padding + $str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format + + return join'', map( unpack("u", chr(32 + length($_)*3/4) . $_), + $str =~ /(.{1,60})/gs); +} + +# Set up aliases so that these functions also can be called as +# +# MIME::Base64::encode(); +# MIME::Base64::decode(); + +*encode = \&encode_base64; +*decode = \&decode_base64; + +1; diff --git a/lib/Parse/RecDescent.pm b/lib/Parse/RecDescent.pm new file mode 100644 index 0000000..35b9e9d --- /dev/null +++ b/lib/Parse/RecDescent.pm @@ -0,0 +1,3045 @@ +# GENERATE RECURSIVE DESCENT PARSER OBJECTS FROM A GRAMMARC +# SEE RecDescent.pod FOR FULL DETAILS + +use 5.005; +use strict; + +package Parse::RecDescent; + +use Text::Balanced qw ( extract_codeblock extract_bracketed extract_quotelike extract_delimited ); + +use vars qw ( $skip ); + + *defskip = \ '\s*'; # DEFAULT SEPARATOR IS OPTIONAL WHITESPACE + $skip = '\s*'; # UNIVERSAL SEPARATOR IS OPTIONAL WHITESPACE +my $MAXREP = 100_000_000; # REPETITIONS MATCH AT MOST 100,000,000 TIMES + + +sub import # IMPLEMENT PRECOMPILER BEHAVIOUR UNDER: + # perl -MParse::RecDescent - +{ + local *_die = sub { print @_, "\n"; exit }; + + my ($package, $file, $line) = caller; + if (substr($file,0,1) eq '-' && $line == 0) + { + _die("Usage: perl -MLocalTest - ") + unless @ARGV == 2; + + my ($sourcefile, $class) = @ARGV; + + local *IN; + open IN, $sourcefile + or _die("Can't open grammar file '$sourcefile'"); + + my $grammar = join '', ; + + Parse::RecDescent->Precompile($grammar, $class, $sourcefile); + exit; + } +} + +sub Save +{ + my ($self, $class) = @_; + $self->{saving} = 1; + $self->Precompile(undef,$class); + $self->{saving} = 0; +} + +sub Precompile +{ + my ($self, $grammar, $class, $sourcefile) = @_; + + $class =~ /^(\w+::)*\w+$/ or croak("Bad class name: $class"); + + my $modulefile = $class; + $modulefile =~ s/.*:://; + $modulefile .= ".pm"; + + open OUT, ">$modulefile" + or croak("Can't write to new module file '$modulefile'"); + + print STDERR "precompiling grammar from file '$sourcefile'\n", + "to class $class in module file '$modulefile'\n" + if $grammar && $sourcefile; + + # local $::RD_HINT = 1; + $self = Parse::RecDescent->new($grammar,1,$class) + || croak("Can't compile bad grammar") + if $grammar; + + foreach ( keys %{$self->{rules}} ) + { $self->{rules}{$_}{changed} = 1 } + + print OUT "package $class;\nuse Parse::RecDescent;\n\n"; + + print OUT "{ my \$ERRORS;\n\n"; + + print OUT $self->_code(); + + print OUT "}\npackage $class; sub new { "; + print OUT "my "; + + require Data::Dumper; + print OUT Data::Dumper->Dump([$self], [qw(self)]); + + print OUT "}"; + + close OUT + or croak("Can't write to new module file '$modulefile'"); +} + + +package Parse::RecDescent::LineCounter; + + +sub TIESCALAR # ($classname, \$text, $thisparser, $prevflag) +{ + bless { + text => $_[1], + parser => $_[2], + prev => $_[3]?1:0, + }, $_[0]; +} + +my %counter_cache; + +sub FETCH +{ + my $parser = $_[0]->{parser}; + my $from = $parser->{fulltextlen}-length(${$_[0]->{text}})-$_[0]->{prev} +; + + unless (exists $counter_cache{$from}) { + $parser->{lastlinenum} = $parser->{offsetlinenum} + - Parse::RecDescent::_linecount(substr($parser->{fulltext},$from)) + + 1; + $counter_cache{$from} = $parser->{lastlinenum}; + } + return $counter_cache{$from}; +} + +sub STORE +{ + my $parser = $_[0]->{parser}; + $parser->{offsetlinenum} -= $parser->{lastlinenum} - $_[1]; + return undef; +} + +sub resync # ($linecounter) +{ + my $self = tied($_[0]); + die "Tried to alter something other than a LineCounter\n" + unless $self =~ /Parse::RecDescent::LineCounter/; + + my $parser = $self->{parser}; + my $apparently = $parser->{offsetlinenum} + - Parse::RecDescent::_linecount(${$self->{text}}) + + 1; + + $parser->{offsetlinenum} += $parser->{lastlinenum} - $apparently; + return 1; +} + +package Parse::RecDescent::ColCounter; + +sub TIESCALAR # ($classname, \$text, $thisparser, $prevflag) +{ + bless { + text => $_[1], + parser => $_[2], + prev => $_[3]?1:0, + }, $_[0]; +} + +sub FETCH +{ + my $parser = $_[0]->{parser}; + my $missing = $parser->{fulltextlen}-length(${$_[0]->{text}})-$_[0]->{prev}+1; + substr($parser->{fulltext},0,$missing) =~ m/^(.*)\Z/m; + return length($1); +} + +sub STORE +{ + die "Can't set column number via \$thiscolumn\n"; +} + + +package Parse::RecDescent::OffsetCounter; + +sub TIESCALAR # ($classname, \$text, $thisparser, $prev) +{ + bless { + text => $_[1], + parser => $_[2], + prev => $_[3]?-1:0, + }, $_[0]; +} + +sub FETCH +{ + my $parser = $_[0]->{parser}; + return $parser->{fulltextlen}-length(${$_[0]->{text}})+$_[0]->{prev}; +} + +sub STORE +{ + die "Can't set current offset via \$thisoffset or \$prevoffset\n"; +} + + + +package Parse::RecDescent::Rule; + +sub new ($$$$$) +{ + my $class = ref($_[0]) || $_[0]; + my $name = $_[1]; + my $owner = $_[2]; + my $line = $_[3]; + my $replace = $_[4]; + + if (defined $owner->{"rules"}{$name}) + { + my $self = $owner->{"rules"}{$name}; + if ($replace && !$self->{"changed"}) + { + $self->reset; + } + return $self; + } + else + { + return $owner->{"rules"}{$name} = + bless + { + "name" => $name, + "prods" => [], + "calls" => [], + "changed" => 0, + "line" => $line, + "impcount" => 0, + "opcount" => 0, + "vars" => "", + }, $class; + } +} + +sub reset($) +{ + @{$_[0]->{"prods"}} = (); + @{$_[0]->{"calls"}} = (); + $_[0]->{"changed"} = 0; + $_[0]->{"impcount"} = 0; + $_[0]->{"opcount"} = 0; + $_[0]->{"vars"} = ""; +} + +sub DESTROY {} + +sub hasleftmost($$) +{ + my ($self, $ref) = @_; + + my $prod; + foreach $prod ( @{$self->{"prods"}} ) + { + return 1 if $prod->hasleftmost($ref); + } + + return 0; +} + +sub leftmostsubrules($) +{ + my $self = shift; + my @subrules = (); + + my $prod; + foreach $prod ( @{$self->{"prods"}} ) + { + push @subrules, $prod->leftmostsubrule(); + } + + return @subrules; +} + +sub expected($) +{ + my $self = shift; + my @expected = (); + + my $prod; + foreach $prod ( @{$self->{"prods"}} ) + { + my $next = $prod->expected(); + unless (! $next or _contains($next,@expected) ) + { + push @expected, $next; + } + } + + return join ', or ', @expected; +} + +sub _contains($@) +{ + my $target = shift; + my $item; + foreach $item ( @_ ) { return 1 if $target eq $item; } + return 0; +} + +sub addcall($$) +{ + my ( $self, $subrule ) = @_; + unless ( _contains($subrule, @{$self->{"calls"}}) ) + { + push @{$self->{"calls"}}, $subrule; + } +} + +sub addprod($$) +{ + my ( $self, $prod ) = @_; + push @{$self->{"prods"}}, $prod; + $self->{"changed"} = 1; + $self->{"impcount"} = 0; + $self->{"opcount"} = 0; + $prod->{"number"} = $#{$self->{"prods"}}; + return $prod; +} + +sub addvar +{ + my ( $self, $var, $parser ) = @_; + if ($var =~ /\A\s*local\s+([%@\$]\w+)/) + { + $parser->{localvars} .= " $1"; + $self->{"vars"} .= "$var;\n" } + else + { $self->{"vars"} .= "my $var;\n" } + $self->{"changed"} = 1; + return 1; +} + +sub addautoscore +{ + my ( $self, $code ) = @_; + $self->{"autoscore"} = $code; + $self->{"changed"} = 1; + return 1; +} + +sub nextoperator($) +{ + my $self = shift; + my $prodcount = scalar @{$self->{"prods"}}; + my $opcount = ++$self->{"opcount"}; + return "_operator_${opcount}_of_production_${prodcount}_of_rule_$self->{name}"; +} + +sub nextimplicit($) +{ + my $self = shift; + my $prodcount = scalar @{$self->{"prods"}}; + my $impcount = ++$self->{"impcount"}; + return "_alternation_${impcount}_of_production_${prodcount}_of_rule_$self->{name}"; +} + + +sub code +{ + my ($self, $namespace, $parser) = @_; + +eval 'undef &' . $namespace . '::' . $self->{"name"} unless $parser->{saving}; + + my $code = +' +# ARGS ARE: ($parser, $text; $repeating, $_noactions, \@args) +sub ' . $namespace . '::' . $self->{"name"} . ' +{ + my $thisparser = $_[0]; + use vars q{$tracelevel}; + local $tracelevel = ($tracelevel||0)+1; + $ERRORS = 0; + my $thisrule = $thisparser->{"rules"}{"' . $self->{"name"} . '"}; + + Parse::RecDescent::_trace(q{Trying rule: [' . $self->{"name"} . ']}, + Parse::RecDescent::_tracefirst($_[1]), + q{' . $self->{"name"} . '}, + $tracelevel) + if defined $::RD_TRACE; + + ' . ($parser->{deferrable} + ? 'my $def_at = @{$thisparser->{deferred}};' + : '') . + ' + my $err_at = @{$thisparser->{errors}}; + + my $score; + my $score_return; + my $_tok; + my $return = undef; + my $_matched=0; + my $commit=0; + my @item = (); + my %item = (); + my $repeating = defined($_[2]) && $_[2]; + my $_noactions = defined($_[3]) && $_[3]; + my @arg = defined $_[4] ? @{ &{$_[4]} } : (); + my %arg = ($#arg & 01) ? @arg : (@arg, undef); + my $text; + my $lastsep=""; + my $expectation = new Parse::RecDescent::Expectation($thisrule->expected()); + $expectation->at($_[1]); + '. ($parser->{_check}{thisoffset}?' + my $thisoffset; + tie $thisoffset, q{Parse::RecDescent::OffsetCounter}, \$text, $thisparser; + ':'') . ($parser->{_check}{prevoffset}?' + my $prevoffset; + tie $prevoffset, q{Parse::RecDescent::OffsetCounter}, \$text, $thisparser, 1; + ':'') . ($parser->{_check}{thiscolumn}?' + my $thiscolumn; + tie $thiscolumn, q{Parse::RecDescent::ColCounter}, \$text, $thisparser; + ':'') . ($parser->{_check}{prevcolumn}?' + my $prevcolumn; + tie $prevcolumn, q{Parse::RecDescent::ColCounter}, \$text, $thisparser, 1; + ':'') . ($parser->{_check}{prevline}?' + my $prevline; + tie $prevline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser, 1; + ':'') . ' + my $thisline; + tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser; + + '. $self->{vars} .' +'; + + my $prod; + foreach $prod ( @{$self->{"prods"}} ) + { + $prod->addscore($self->{autoscore},0,0) if $self->{autoscore}; + next unless $prod->checkleftmost(); + $code .= $prod->code($namespace,$self,$parser); + + $code .= $parser->{deferrable} + ? ' splice + @{$thisparser->{deferred}}, $def_at unless $_matched; + ' + : ''; + } + + $code .= +' + unless ( $_matched || defined($return) || defined($score) ) + { + ' .($parser->{deferrable} + ? ' splice @{$thisparser->{deferred}}, $def_at; + ' + : '') . ' + + $_[1] = $text; # NOT SURE THIS IS NEEDED + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($_[1]), + q{' . $self->{"name"} .'}, + $tracelevel) + if defined $::RD_TRACE; + return undef; + } + if (!defined($return) && defined($score)) + { + Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "", + q{' . $self->{"name"} .'}, + $tracelevel) + if defined $::RD_TRACE; + $return = $score_return; + } + splice @{$thisparser->{errors}}, $err_at; + $return = $item[$#item] unless defined $return; + if (defined $::RD_TRACE) + { + Parse::RecDescent::_trace(q{>>Matched rule<< (return value: [} . + $return . q{])}, "", + q{' . $self->{"name"} .'}, + $tracelevel); + Parse::RecDescent::_trace(q{(consumed: [} . + Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])}, + Parse::RecDescent::_tracefirst($text), + , q{' . $self->{"name"} .'}, + $tracelevel) + } + $_[1] = $text; + return $return; +} +'; + + return $code; +} + +my @left; +sub isleftrec($$) +{ + my ($self, $rules) = @_; + my $root = $self->{"name"}; + @left = $self->leftmostsubrules(); + my $next; + foreach $next ( @left ) + { + next unless defined $rules->{$next}; # SKIP NON-EXISTENT RULES + return 1 if $next eq $root; + my $child; + foreach $child ( $rules->{$next}->leftmostsubrules() ) + { + push(@left, $child) + if ! _contains($child, @left) ; + } + } + return 0; +} + +package Parse::RecDescent::Production; + +sub describe ($;$) +{ + return join ' ', map { $_->describe($_[1]) or () } @{$_[0]->{items}}; +} + +sub new ($$;$$) +{ + my ($self, $line, $uncommit, $error) = @_; + my $class = ref($self) || $self; + + bless + { + "items" => [], + "uncommit" => $uncommit, + "error" => $error, + "line" => $line, + strcount => 0, + patcount => 0, + dircount => 0, + actcount => 0, + }, $class; +} + +sub expected ($) +{ + my $itemcount = scalar @{$_[0]->{"items"}}; + return ($itemcount) ? $_[0]->{"items"}[0]->describe(1) : ''; +} + +sub hasleftmost ($$) +{ + my ($self, $ref) = @_; + return ${$self->{"items"}}[0] eq $ref if scalar @{$self->{"items"}}; + return 0; +} + +sub leftmostsubrule($) +{ + my $self = shift; + + if ( $#{$self->{"items"}} >= 0 ) + { + my $subrule = $self->{"items"}[0]->issubrule(); + return $subrule if defined $subrule; + } + + return (); +} + +sub checkleftmost($) +{ + my @items = @{$_[0]->{"items"}}; + if (@items==1 && ref($items[0]) =~ /\AParse::RecDescent::Error/ + && $items[0]->{commitonly} ) + { + Parse::RecDescent::_warn(2,"Lone in production treated + as "); + Parse::RecDescent::_hint("A production consisting of a single + conditional directive would + normally succeed (with the value zero) if the + rule is not 'commited' when it is + tried. Since you almost certainly wanted + ' ' Parse::RecDescent + supplied it for you."); + push @{$_[0]->{items}}, + Parse::RecDescent::UncondReject->new(0,0,''); + } + elsif (@items==1 && ($items[0]->describe||"") =~ /describe||"") =~ /describe ."]"); + my $what = $items[0]->describe =~ / (which acts like an unconditional during parsing)" + : $items[0]->describe =~ / (which acts like an unconditional during parsing)" + : "an unconditional "; + my $caveat = $items[0]->describe =~ / 1 + ? "However, there were also other (useless) items after the leading " + . $items[0]->describe + . ", so you may have been expecting some other behaviour." + : "You can safely ignore this message."; + Parse::RecDescent::_hint("The production starts with $what. That means that the + production can never successfully match, so it was + optimized out of the final parser$caveat. $advice"); + return 0; + } + return 1; +} + +sub changesskip($) +{ + my $item; + foreach $item (@{$_[0]->{"items"}}) + { + if (ref($item) =~ /Parse::RecDescent::(Action|Directive)/) + { + return 1 if $item->{code} =~ /\$skip/; + } + } + return 0; +} + +sub adddirective +{ + my ( $self, $whichop, $line, $name ) = @_; + push @{$self->{op}}, + { type=>$whichop, line=>$line, name=>$name, + offset=> scalar(@{$self->{items}}) }; +} + +sub addscore +{ + my ( $self, $code, $lookahead, $line ) = @_; + $self->additem(Parse::RecDescent::Directive->new( + "local \$^W; + my \$thisscore = do { $code } + 0; + if (!defined(\$score) || \$thisscore>\$score) + { \$score=\$thisscore; \$score_return=\$item[-1]; } + undef;", $lookahead, $line,"") ) + unless $self->{items}[-1]->describe =~ /{op}) + { + while (my $next = pop @{$self->{op}}) + { + Parse::RecDescent::_error("Incomplete <$next->{type}op:...>.", $line); + Parse::RecDescent::_hint( + "The current production ended without completing the + <$next->{type}op:...> directive that started near line + $next->{line}. Did you forget the closing '>'?"); + } + } + return 1; +} + +sub enddirective +{ + my ( $self, $line, $minrep, $maxrep ) = @_; + unless ($self->{op}) + { + Parse::RecDescent::_error("Unmatched > found.", $line); + Parse::RecDescent::_hint( + "A '>' angle bracket was encountered, which typically + indicates the end of a directive. However no suitable + preceding directive was encountered. Typically this + indicates either a extra '>' in the grammar, or a + problem inside the previous directive."); + return; + } + my $op = pop @{$self->{op}}; + my $span = @{$self->{items}} - $op->{offset}; + if ($op->{type} =~ /left|right/) + { + if ($span != 3) + { + Parse::RecDescent::_error( + "Incorrect <$op->{type}op:...> specification: + expected 3 args, but found $span instead", $line); + Parse::RecDescent::_hint( + "The <$op->{type}op:...> directive requires a + sequence of exactly three elements. For example: + <$op->{type}op:leftarg /op/ rightarg>"); + } + else + { + push @{$self->{items}}, + Parse::RecDescent::Operator->new( + $op->{type}, $minrep, $maxrep, splice(@{$self->{"items"}}, -3)); + $self->{items}[-1]->sethashname($self); + $self->{items}[-1]{name} = $op->{name}; + } + } +} + +sub prevwasreturn +{ + my ( $self, $line ) = @_; + unless (@{$self->{items}}) + { + Parse::RecDescent::_error( + "Incorrect specification: + expected item missing", $line); + Parse::RecDescent::_hint( + "The directive requires a + sequence of at least one item. For example: + "); + return; + } + push @{$self->{items}}, + Parse::RecDescent::Result->new(); +} + +sub additem +{ + my ( $self, $item ) = @_; + $item->sethashname($self); + push @{$self->{"items"}}, $item; + return $item; +} + + +sub preitempos +{ + return q + { + push @itempos, {'offset' => {'from'=>$thisoffset, 'to'=>undef}, + 'line' => {'from'=>$thisline, 'to'=>undef}, + 'column' => {'from'=>$thiscolumn, 'to'=>undef} }; + } +} + +sub incitempos +{ + return q + { + $itempos[$#itempos]{'offset'}{'from'} += length($1); + $itempos[$#itempos]{'line'}{'from'} = $thisline; + $itempos[$#itempos]{'column'}{'from'} = $thiscolumn; + } +} + +sub postitempos +{ + return q + { + $itempos[$#itempos]{'offset'}{'to'} = $prevoffset; + $itempos[$#itempos]{'line'}{'to'} = $prevline; + $itempos[$#itempos]{'column'}{'to'} = $prevcolumn; + } +} + +sub code($$$$) +{ + my ($self,$namespace,$rule,$parser) = @_; + my $code = +' + while (!$_matched' + . (defined $self->{"uncommit"} ? '' : ' && !$commit') + . ') + { + ' . + ($self->changesskip() + ? 'local $skip = defined($skip) ? $skip : $Parse::RecDescent::skip;' + : '') .' + Parse::RecDescent::_trace(q{Trying production: [' + . $self->describe . ']}, + Parse::RecDescent::_tracefirst($_[1]), + q{' . $rule ->{name}. '}, + $tracelevel) + if defined $::RD_TRACE; + my $thisprod = $thisrule->{"prods"}[' . $self->{"number"} . ']; + ' . (defined $self->{"error"} ? '' : '$text = $_[1];' ) . ' + my $_savetext; + @item = (q{' . $rule->{"name"} . '}); + %item = (__RULE__ => q{' . $rule->{"name"} . '}); + my $repcount = 0; + +'; + $code .= +' my @itempos = ({}); +' if $parser->{_check}{itempos}; + + my $item; + my $i; + + for ($i = 0; $i < @{$self->{"items"}}; $i++) + { + $item = ${$self->{items}}[$i]; + + $code .= preitempos() if $parser->{_check}{itempos}; + + $code .= $item->code($namespace,$rule,$parser->{_check}); + + $code .= postitempos() if $parser->{_check}{itempos}; + + } + + if ($parser->{_AUTOACTION} && defined($item) && !$item->isa("Parse::RecDescent::Action")) + { + $code .= $parser->{_AUTOACTION}->code($namespace,$rule); + Parse::RecDescent::_warn(1,"Autogenerating action in rule + \"$rule->{name}\": + $parser->{_AUTOACTION}{code}") + and + Parse::RecDescent::_hint("The \$::RD_AUTOACTION was defined, + so any production not ending in an + explicit action has the specified + \"auto-action\" automatically + appended."); + } + elsif ($parser->{_AUTOTREE} && defined($item) && !$item->isa("Parse::RecDescent::Action")) + { + if ($i==1 && $item->isterminal) + { + $code .= $parser->{_AUTOTREE}{TERMINAL}->code($namespace,$rule); + } + else + { + $code .= $parser->{_AUTOTREE}{NODE}->code($namespace,$rule); + } + Parse::RecDescent::_warn(1,"Autogenerating tree-building action in rule + \"$rule->{name}\"") + and + Parse::RecDescent::_hint("The directive was specified, + so any production not ending + in an explicit action has + some parse-tree building code + automatically appended."); + } + + $code .= +' + + Parse::RecDescent::_trace(q{>>Matched production: [' + . $self->describe . ']<<}, + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{name} . '}, + $tracelevel) + if defined $::RD_TRACE; + $_matched = 1; + last; + } + +'; + return $code; +} + +1; + +package Parse::RecDescent::Action; + +sub describe { undef } + +sub sethashname { $_[0]->{hashname} = '__ACTION' . ++$_[1]->{actcount} .'__'; } + +sub new +{ + my $class = ref($_[0]) || $_[0]; + bless + { + "code" => $_[1], + "lookahead" => $_[2], + "line" => $_[3], + }, $class; +} + +sub issubrule { undef } +sub isterminal { 0 } + +sub code($$$$) +{ + my ($self, $namespace, $rule) = @_; + +' + Parse::RecDescent::_trace(q{Trying action}, + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{name} . '}, + $tracelevel) + if defined $::RD_TRACE; + ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) .' + + $_tok = ($_noactions) ? 0 : do ' . $self->{"code"} . '; + ' . ($self->{"lookahead"}<0?'if':'unless') . ' (defined $_tok) + { + Parse::RecDescent::_trace(q{<> (return value: [undef])}) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched action<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $_tok; + ' . ($self->{line}>=0 ? '$item{'. $self->{hashname} .'}=$_tok;' : '' ) .' + ' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .' +' +} + + +1; + +package Parse::RecDescent::Directive; + +sub sethashname { $_[0]->{hashname} = '__DIRECTIVE' . ++$_[1]->{dircount} . '__'; } + +sub issubrule { undef } +sub isterminal { 0 } +sub describe { $_[1] ? '' : $_[0]->{name} } + +sub new ($$$$$) +{ + my $class = ref($_[0]) || $_[0]; + bless + { + "code" => $_[1], + "lookahead" => $_[2], + "line" => $_[3], + "name" => $_[4], + }, $class; +} + +sub code($$$$) +{ + my ($self, $namespace, $rule) = @_; + +' + ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) .' + + Parse::RecDescent::_trace(q{Trying directive: [' + . $self->describe . ']}, + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{name} . '}, + $tracelevel) + if defined $::RD_TRACE; ' .' + $_tok = do { ' . $self->{"code"} . ' }; + if (defined($_tok)) + { + Parse::RecDescent::_trace(q{>>Matched directive<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + else + { + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + } + ' . ($self->{"lookahead"} ? '$text = $_savetext and ' : '' ) .' + last ' + . ($self->{"lookahead"}<0?'if':'unless') . ' defined $_tok; + push @item, $item{'.$self->{hashname}.'}=$_tok; + ' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .' +' +} + +1; + +package Parse::RecDescent::UncondReject; + +sub issubrule { undef } +sub isterminal { 0 } +sub describe { $_[1] ? '' : $_[0]->{name} } +sub sethashname { $_[0]->{hashname} = '__DIRECTIVE' . ++$_[1]->{dircount} . '__'; } + +sub new ($$$;$) +{ + my $class = ref($_[0]) || $_[0]; + bless + { + "lookahead" => $_[1], + "line" => $_[2], + "name" => $_[3], + }, $class; +} + +# MARK, YOU MAY WANT TO OPTIMIZE THIS. + + +sub code($$$$) +{ + my ($self, $namespace, $rule) = @_; + +' + Parse::RecDescent::_trace(q{>>Rejecting production<< (found ' + . $self->describe . ')}, + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{name} . '}, + $tracelevel) + if defined $::RD_TRACE; + undef $return; + ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) .' + + $_tok = undef; + ' . ($self->{"lookahead"} ? '$text = $_savetext and ' : '' ) .' + last ' + . ($self->{"lookahead"}<0?'if':'unless') . ' defined $_tok; +' +} + +1; + +package Parse::RecDescent::Error; + +sub issubrule { undef } +sub isterminal { 0 } +sub describe { $_[1] ? '' : $_[0]->{commitonly} ? '' : '' } +sub sethashname { $_[0]->{hashname} = '__DIRECTIVE' . ++$_[1]->{dircount} . '__'; } + +sub new ($$$$$) +{ + my $class = ref($_[0]) || $_[0]; + bless + { + "msg" => $_[1], + "lookahead" => $_[2], + "commitonly" => $_[3], + "line" => $_[4], + }, $class; +} + +sub code($$$$) +{ + my ($self, $namespace, $rule) = @_; + + my $action = ''; + + if ($self->{"msg"}) # ERROR MESSAGE SUPPLIED + { + #WAS: $action .= "Parse::RecDescent::_error(qq{$self->{msg}}" . ',$thisline);'; + $action .= 'push @{$thisparser->{errors}}, [qq{'.$self->{msg}.'},$thisline];'; + + } + else # GENERATE ERROR MESSAGE DURING PARSE + { + $action .= ' + my $rule = $item[0]; + $rule =~ s/_/ /g; + #WAS: Parse::RecDescent::_error("Invalid $rule: " . $expectation->message() ,$thisline); + push @{$thisparser->{errors}}, ["Invalid $rule: " . $expectation->message() ,$thisline]; + '; + } + + my $dir = + new Parse::RecDescent::Directive('if (' . + ($self->{"commitonly"} ? '$commit' : '1') . + ") { do {$action} unless ".' $_noactions; undef } else {0}', + $self->{"lookahead"},0,$self->describe); + $dir->{hashname} = $self->{hashname}; + return $dir->code($namespace, $rule, 0); +} + +1; + +package Parse::RecDescent::Token; + +sub sethashname { $_[0]->{hashname} = '__PATTERN' . ++$_[1]->{patcount} . '__'; } + +sub issubrule { undef } +sub isterminal { 1 } +sub describe ($) { shift->{'description'}} + + +# ARGS ARE: $self, $pattern, $left_delim, $modifiers, $lookahead, $linenum +sub new ($$$$$$) +{ + my $class = ref($_[0]) || $_[0]; + my $pattern = $_[1]; + my $pat = $_[1]; + my $ldel = $_[2]; + my $rdel = $ldel; + $rdel =~ tr/{[(/; + + my $mod = $_[3]; + + my $desc; + + if ($ldel eq '/') { $desc = "$ldel$pattern$rdel$mod" } + else { $desc = "m$ldel$pattern$rdel$mod" } + $desc =~ s/\\/\\\\/g; + $desc =~ s/\$$/\\\$/g; + $desc =~ s/}/\\}/g; + $desc =~ s/{/\\{/g; + + if (!eval "no strict; + local \$SIG{__WARN__} = sub {0}; + '' =~ m$ldel$pattern$rdel" and $@) + { + Parse::RecDescent::_warn(3, "Token pattern \"m$ldel$pattern$rdel\" + may not be a valid regular expression", + $_[5]); + $@ =~ s/ at \(eval.*/./; + Parse::RecDescent::_hint($@); + } + + # QUIETLY PREVENT (WELL-INTENTIONED) CALAMITY + $mod =~ s/[gc]//g; + $pattern =~ s/(\A|[^\\])\\G/$1/g; + + bless + { + "pattern" => $pattern, + "ldelim" => $ldel, + "rdelim" => $rdel, + "mod" => $mod, + "lookahead" => $_[4], + "line" => $_[5], + "description" => $desc, + }, $class; +} + + +sub code($$$$) +{ + my ($self, $namespace, $rule, $check) = @_; + my $ldel = $self->{"ldelim"}; + my $rdel = $self->{"rdelim"}; + my $sdel = $ldel; + my $mod = $self->{"mod"}; + + $sdel =~ s/[[{(<]/{}/; + +my $code = ' + Parse::RecDescent::_trace(q{Trying terminal: [' . $self->describe + . ']}, Parse::RecDescent::_tracefirst($text), + q{' . $rule->{name} . '}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{' . ($rule->hasleftmost($self) ? '' + : $self->describe ) . '})->at($text); + ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) . ' + + ' . ($self->{"lookahead"}<0?'if':'unless') + . ' ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and ' + . ($check->{itempos}? 'do {'.Parse::RecDescent::Production::incitempos().' 1} and ' : '') + . ' $text =~ s' . $ldel . '\A(?:' . $self->{"pattern"} . ')' + . $rdel . $sdel . $mod . ') + { + '.($self->{"lookahead"} ? '$text = $_savetext;' : '').' + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{'.$self->{hashname}.'}=$&; + ' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .' +'; + + return $code; +} + +1; + +package Parse::RecDescent::Literal; + +sub sethashname { $_[0]->{hashname} = '__STRING' . ++$_[1]->{strcount} . '__'; } + +sub issubrule { undef } +sub isterminal { 1 } +sub describe ($) { shift->{'description'} } + +sub new ($$$$) +{ + my $class = ref($_[0]) || $_[0]; + + my $pattern = $_[1]; + + my $desc = $pattern; + $desc=~s/\\/\\\\/g; + $desc=~s/}/\\}/g; + $desc=~s/{/\\{/g; + + bless + { + "pattern" => $pattern, + "lookahead" => $_[2], + "line" => $_[3], + "description" => "'$desc'", + }, $class; +} + + +sub code($$$$) +{ + my ($self, $namespace, $rule, $check) = @_; + +my $code = ' + Parse::RecDescent::_trace(q{Trying terminal: [' . $self->describe + . ']}, + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{name} . '}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{' . ($rule->hasleftmost($self) ? '' + : $self->describe ) . '})->at($text); + ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) . ' + + ' . ($self->{"lookahead"}<0?'if':'unless') + . ' ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and ' + . ($check->{itempos}? 'do {'.Parse::RecDescent::Production::incitempos().' 1} and ' : '') + . ' $text =~ s/\A' . quotemeta($self->{"pattern"}) . '//) + { + '.($self->{"lookahead"} ? '$text = $_savetext;' : '').' + $expectation->failed(); + Parse::RecDescent::_trace(qq{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $& . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{'.$self->{hashname}.'}=$&; + ' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .' +'; + + return $code; +} + +1; + +package Parse::RecDescent::InterpLit; + +sub sethashname { $_[0]->{hashname} = '__STRING' . ++$_[1]->{strcount} . '__'; } + +sub issubrule { undef } +sub isterminal { 1 } +sub describe ($) { shift->{'description'} } + +sub new ($$$$) +{ + my $class = ref($_[0]) || $_[0]; + + my $pattern = $_[1]; + $pattern =~ s#/#\\/#g; + + my $desc = $pattern; + $desc=~s/\\/\\\\/g; + $desc=~s/}/\\}/g; + $desc=~s/{/\\{/g; + + bless + { + "pattern" => $pattern, + "lookahead" => $_[2], + "line" => $_[3], + "description" => "'$desc'", + }, $class; +} + +sub code($$$$) +{ + my ($self, $namespace, $rule, $check) = @_; + +my $code = ' + Parse::RecDescent::_trace(q{Trying terminal: [' . $self->describe + . ']}, + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{name} . '}, + $tracelevel) + if defined $::RD_TRACE; + $lastsep = ""; + $expectation->is(q{' . ($rule->hasleftmost($self) ? '' + : $self->describe ) . '})->at($text); + ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) . ' + + ' . ($self->{"lookahead"}<0?'if':'unless') + . ' ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and ' + . ($check->{itempos}? 'do {'.Parse::RecDescent::Production::incitempos().' 1} and ' : '') + . ' do { $_tok = "' . $self->{"pattern"} . '"; 1 } and + substr($text,0,length($_tok)) eq $_tok and + do { substr($text,0,length($_tok)) = ""; 1; } + ) + { + '.($self->{"lookahead"} ? '$text = $_savetext;' : '').' + $expectation->failed(); + Parse::RecDescent::_trace(q{<>}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [} + . $_tok . q{])}, + Parse::RecDescent::_tracefirst($text)) + if defined $::RD_TRACE; + push @item, $item{'.$self->{hashname}.'}=$_tok; + ' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .' +'; + + return $code; +} + +1; + +package Parse::RecDescent::Subrule; + +sub issubrule ($) { return $_[0]->{"subrule"} } +sub isterminal { 0 } +sub sethashname {} + +sub describe ($) +{ + my $desc = $_[0]->{"implicit"} || $_[0]->{"subrule"}; + $desc = "" if $_[0]->{"matchrule"}; + return $desc; +} + +sub callsyntax($$) +{ + if ($_[0]->{"matchrule"}) + { + return "&{'$_[1]'.qq{$_[0]->{subrule}}}"; + } + else + { + return $_[1].$_[0]->{"subrule"}; + } +} + +sub new ($$$$;$$$) +{ + my $class = ref($_[0]) || $_[0]; + bless + { + "subrule" => $_[1], + "lookahead" => $_[2], + "line" => $_[3], + "implicit" => $_[4] || undef, + "matchrule" => $_[5], + "argcode" => $_[6] || undef, + }, $class; +} + + +sub code($$$$) +{ + my ($self, $namespace, $rule) = @_; + +' + Parse::RecDescent::_trace(q{Trying subrule: [' . $self->{"subrule"} . ']}, + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{"name"} . '}, + $tracelevel) + if defined $::RD_TRACE; + if (1) { no strict qw{refs}; + $expectation->is(' . ($rule->hasleftmost($self) ? 'q{}' + # WAS : 'qq{'.$self->describe.'}' ) . ')->at($text); + : 'q{'.$self->describe.'}' ) . ')->at($text); + ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) + . ($self->{"lookahead"}<0?'if':'unless') + . ' (defined ($_tok = ' + . $self->callsyntax($namespace.'::') + . '($thisparser,$text,$repeating,' + . ($self->{"lookahead"}?'1':'$_noactions') + . ($self->{argcode} ? ",sub { return $self->{argcode} }" + : ',sub { \\@arg }') + . '))) + { + '.($self->{"lookahead"} ? '$text = $_savetext;' : '').' + Parse::RecDescent::_trace(q{<{subrule} . ']>>}, + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{"name"} .'}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched subrule: [' + . $self->{subrule} . ']<< (return value: [} + . $_tok . q{]}, + + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{"name"} .'}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{' . $self->{subrule} . '}} = $_tok; + push @item, $_tok; + ' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .' + } +' +} + +package Parse::RecDescent::Repetition; + +sub issubrule ($) { return $_[0]->{"subrule"} } +sub isterminal { 0 } +sub sethashname { } + +sub describe ($) +{ + my $desc = $_[0]->{"expected"} || $_[0]->{"subrule"}; + $desc = "" if $_[0]->{"matchrule"}; + return $desc; +} + +sub callsyntax($$) +{ + if ($_[0]->{matchrule}) + { return "sub { goto &{''.qq{$_[1]$_[0]->{subrule}}} }"; } + else + { return "\\&$_[1]$_[0]->{subrule}"; } +} + +sub new ($$$$$$$$$$) +{ + my ($self, $subrule, $repspec, $min, $max, $lookahead, $line, $parser, $matchrule, $argcode) = @_; + my $class = ref($self) || $self; + ($max, $min) = ( $min, $max) if ($max<$min); + + my $desc; + if ($subrule=~/\A_alternation_\d+_of_production_\d+_of_rule/) + { $desc = $parser->{"rules"}{$subrule}->expected } + + if ($lookahead) + { + if ($min>0) + { + return new Parse::RecDescent::Subrule($subrule,$lookahead,$line,$desc,$matchrule,$argcode); + } + else + { + Parse::RecDescent::_error("Not symbol (\"!\") before + \"$subrule\" doesn't make + sense.",$line); + Parse::RecDescent::_hint("Lookahead for negated optional + repetitions (such as + \"!$subrule($repspec)\" can never + succeed, since optional items always + match (zero times at worst). + Did you mean a single \"!$subrule\", + instead?"); + } + } + bless + { + "subrule" => $subrule, + "repspec" => $repspec, + "min" => $min, + "max" => $max, + "lookahead" => $lookahead, + "line" => $line, + "expected" => $desc, + "argcode" => $argcode || undef, + "matchrule" => $matchrule, + }, $class; +} + +sub code($$$$) +{ + my ($self, $namespace, $rule) = @_; + + my ($subrule, $repspec, $min, $max, $lookahead) = + @{$self}{ qw{subrule repspec min max lookahead} }; + +' + Parse::RecDescent::_trace(q{Trying repeated subrule: [' . $self->describe . ']}, + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{"name"} . '}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(' . ($rule->hasleftmost($self) ? 'q{}' + # WAS : 'qq{'.$self->describe.'}' ) . ')->at($text); + : 'q{'.$self->describe.'}' ) . ')->at($text); + ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) .' + unless (defined ($_tok = $thisparser->_parserepeat($text, ' + . $self->callsyntax($namespace.'::') + . ', ' . $min . ', ' . $max . ', ' + . ($self->{"lookahead"}?'1':'$_noactions') + . ',$expectation,' + . ($self->{argcode} ? "sub { return $self->{argcode} }" + : 'undef') + . '))) + { + Parse::RecDescent::_trace(q{<describe . ']>>}, + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{"name"} .'}, + $tracelevel) + if defined $::RD_TRACE; + last; + } + Parse::RecDescent::_trace(q{>>Matched repeated subrule: [' + . $self->{subrule} . ']<< (} + . @$_tok . q{ times)}, + + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{"name"} .'}, + $tracelevel) + if defined $::RD_TRACE; + $item{q{' . "$self->{subrule}($self->{repspec})" . '}} = $_tok; + push @item, $_tok; + ' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .' + +' +} + +package Parse::RecDescent::Result; + +sub issubrule { 0 } +sub isterminal { 0 } +sub describe { '' } + +sub new +{ + my ($class, $pos) = @_; + + bless {}, $class; +} + +sub code($$$$) +{ + my ($self, $namespace, $rule) = @_; + + ' + $return = $item[-1]; + '; +} + +package Parse::RecDescent::Operator; + +my @opertype = ( " non-optional", "n optional" ); + +sub issubrule { 0 } +sub isterminal { 0 } + +sub describe { $_[0]->{"expected"} } +sub sethashname { $_[0]->{hashname} = '__DIRECTIVE' . ++$_[1]->{dircount} . '__'; } + + +sub new +{ + my ($class, $type, $minrep, $maxrep, $leftarg, $op, $rightarg) = @_; + + bless + { + "type" => "${type}op", + "leftarg" => $leftarg, + "op" => $op, + "min" => $minrep, + "max" => $maxrep, + "rightarg" => $rightarg, + "expected" => "<${type}op: ".$leftarg->describe." ".$op->describe." ".$rightarg->describe.">", + }, $class; +} + +sub code($$$$) +{ + my ($self, $namespace, $rule) = @_; + + my ($leftarg, $op, $rightarg) = + @{$self}{ qw{leftarg op rightarg} }; + + my $code = ' + Parse::RecDescent::_trace(q{Trying operator: [' . $self->describe . ']}, + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{"name"} . '}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->is(' . ($rule->hasleftmost($self) ? 'q{}' + # WAS : 'qq{'.$self->describe.'}' ) . ')->at($text); + : 'q{'.$self->describe.'}' ) . ')->at($text); + + $_tok = undef; + OPLOOP: while (1) + { + $repcount = 0; + my @item; + '; + + if ($self->{type} eq "leftop" ) + { + $code .= ' + # MATCH LEFTARG + ' . $leftarg->code(@_[1..2]) . ' + + $repcount++; + + my $savetext = $text; + my $backtrack; + + # MATCH (OP RIGHTARG)(s) + while ($repcount < ' . $self->{max} . ') + { + $backtrack = 0; + ' . $op->code(@_[1..2]) . ' + ' . ($op->isterminal() ? 'pop @item;' : '$backtrack=1;' ) . ' + ' . (ref($op) eq 'Parse::RecDescent::Token' + ? 'if (defined $1) {push @item, $item{'.($self->{name}||$self->{hashname}).'}=$1; $backtrack=1;}' + : "" ) . ' + ' . $rightarg->code(@_[1..2]) . ' + $savetext = $text; + $repcount++; + } + $text = $savetext; + pop @item if $backtrack; + + '; + } + else + { + $code .= ' + my $savetext = $text; + my $backtrack; + # MATCH (LEFTARG OP)(s) + while ($repcount < ' . $self->{max} . ') + { + $backtrack = 0; + ' . $leftarg->code(@_[1..2]) . ' + $repcount++; + $backtrack = 1; + ' . $op->code(@_[1..2]) . ' + $savetext = $text; + ' . ($op->isterminal() ? 'pop @item;' : "" ) . ' + ' . (ref($op) eq 'Parse::RecDescent::Token' ? 'do { push @item, $item{'.($self->{name}||$self->{hashname}).'}=$1; } if defined $1;' : "" ) . ' + } + $text = $savetext; + pop @item if $backtrack; + + # MATCH RIGHTARG + ' . $rightarg->code(@_[1..2]) . ' + $repcount++; + '; + } + + $code .= 'unless (@item) { undef $_tok; last }' unless $self->{min}==0; + + $code .= ' + $_tok = [ @item ]; + last; + } + + unless ($repcount>='.$self->{min}.') + { + Parse::RecDescent::_trace(q{<describe + . ']>>}, + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{"name"} .'}, + $tracelevel) + if defined $::RD_TRACE; + $expectation->failed(); + last; + } + Parse::RecDescent::_trace(q{>>Matched operator: [' + . $self->describe + . ']<< (return value: [} + . qq{@{$_tok||[]}} . q{]}, + Parse::RecDescent::_tracefirst($text), + q{' . $rule->{"name"} .'}, + $tracelevel) + if defined $::RD_TRACE; + + push @item, $item{'.($self->{name}||$self->{hashname}).'}=$_tok||[]; + +'; + return $code; +} + + +package Parse::RecDescent::Expectation; + +sub new ($) +{ + bless { + "failed" => 0, + "expected" => "", + "unexpected" => "", + "lastexpected" => "", + "lastunexpected" => "", + "defexpected" => $_[1], + }; +} + +sub is ($$) +{ + $_[0]->{lastexpected} = $_[1]; return $_[0]; +} + +sub at ($$) +{ + $_[0]->{lastunexpected} = $_[1]; return $_[0]; +} + +sub failed ($) +{ + return unless $_[0]->{lastexpected}; + $_[0]->{expected} = $_[0]->{lastexpected} unless $_[0]->{failed}; + $_[0]->{unexpected} = $_[0]->{lastunexpected} unless $_[0]->{failed}; + $_[0]->{failed} = 1; +} + +sub message ($) +{ + my ($self) = @_; + $self->{expected} = $self->{defexpected} unless $self->{expected}; + $self->{expected} =~ s/_/ /g; + if (!$self->{unexpected} || $self->{unexpected} =~ /\A\s*\Z/s) + { + return "Was expecting $self->{expected}"; + } + else + { + $self->{unexpected} =~ /\s*(.*)/; + return "Was expecting $self->{expected} but found \"$1\" instead"; + } +} + +1; + +package Parse::RecDescent; + +use Carp; +use vars qw ( $AUTOLOAD $VERSION ); + +my $ERRORS = 0; + +$VERSION = '1.94'; + +# BUILDING A PARSER + +my $nextnamespace = "namespace000001"; + +sub _nextnamespace() +{ + return "Parse::RecDescent::" . $nextnamespace++; +} + +sub new ($$$) +{ + my $class = ref($_[0]) || $_[0]; + local $Parse::RecDescent::compiling = $_[2]; + my $name_space_name = defined $_[3] + ? "Parse::RecDescent::".$_[3] + : _nextnamespace(); + my $self = + { + "rules" => {}, + "namespace" => $name_space_name, + "startcode" => '', + "localvars" => '', + "_AUTOACTION" => undef, + "_AUTOTREE" => undef, + }; + if ($::RD_AUTOACTION) + { + my $sourcecode = $::RD_AUTOACTION; + $sourcecode = "{ $sourcecode }" + unless $sourcecode =~ /\A\s*\{.*\}\s*\Z/; + $self->{_check}{itempos} = + $sourcecode =~ /\@itempos\b|\$itempos\s*\[/; + $self->{_AUTOACTION} + = new Parse::RecDescent::Action($sourcecode,0,-1) + } + + bless $self, $class; + shift; + return $self->Replace(@_) +} + +sub Compile($$$$) { + + die "Compilation of Parse::RecDescent grammars not yet implemented\n"; +} + +sub DESTROY {} # SO AUTOLOADER IGNORES IT + +# BUILDING A GRAMMAR.... + +sub Replace ($$) +{ + splice(@_, 2, 0, 1); + return _generate(@_); +} + +sub Extend ($$) +{ + splice(@_, 2, 0, 0); + return _generate(@_); +} + +sub _no_rule ($$;$) +{ + _error("Ruleless $_[0] at start of grammar.",$_[1]); + my $desc = $_[2] ? "\"$_[2]\"" : ""; + _hint("You need to define a rule for the $_[0] $desc + to be part of."); +} + +my $NEGLOOKAHEAD = '\G(\s*\.\.\.\!)'; +my $POSLOOKAHEAD = '\G(\s*\.\.\.)'; +my $RULE = '\G\s*(\w+)[ \t]*:'; +my $PROD = '\G\s*([|])'; +my $TOKEN = q{\G\s*/((\\\\/|[^/])*)/([cgimsox]*)}; +my $MTOKEN = q{\G\s*(m\s*[^\w\s])}; +my $LITERAL = q{\G\s*'((\\\\['\\\\]|[^'])*)'}; +my $INTERPLIT = q{\G\s*"((\\\\["\\\\]|[^"])*)"}; +my $SUBRULE = '\G\s*(\w+)'; +my $MATCHRULE = '\G(\s*{_check}{itempos} = ($grammar =~ /\@itempos\b|\$itempos\s*\[/) + unless $self->{_check}{itempos}; + for (qw(thisoffset thiscolumn prevline prevoffset prevcolumn)) + { + $self->{_check}{$_} = + ($grammar =~ /\$$_/) || $self->{_check}{itempos} + unless $self->{_check}{$_}; + } + my $line; + + my $rule = undef; + my $prod = undef; + my $item = undef; + my $lastgreedy = ''; + pos $grammar = 0; + study $grammar; + + while (pos $grammar < length $grammar) + { + $line = $lines - _linecount($grammar) + 1; + my $commitonly; + my $code = ""; + my @components = (); + if ($grammar =~ m/$COMMENT/gco) + { + _parse("a comment",0,$line); + next; + } + elsif ($grammar =~ m/$NEGLOOKAHEAD/gco) + { + _parse("a negative lookahead",$aftererror,$line); + $lookahead = $lookahead ? -$lookahead : -1; + $lookaheadspec .= $1; + next; # SKIP LOOKAHEAD RESET AT END OF while LOOP + } + elsif ($grammar =~ m/$POSLOOKAHEAD/gco) + { + _parse("a positive lookahead",$aftererror,$line); + $lookahead = $lookahead ? $lookahead : 1; + $lookaheadspec .= $1; + next; # SKIP LOOKAHEAD RESET AT END OF while LOOP + } + elsif ($grammar =~ m/(?=$ACTION)/gco + and do { ($code) = extract_codeblock($grammar); $code }) + { + _parse("an action", $aftererror, $line, $code); + $item = new Parse::RecDescent::Action($code,$lookahead,$line); + $prod and $prod->additem($item) + or $self->_addstartcode($code); + } + elsif ($grammar =~ m/(?=$IMPLICITSUBRULE)/gco + and do { ($code) = extract_codeblock($grammar,'{([',undef,'(',1); + $code }) + { + $code =~ s/\A\s*\(|\)\Z//g; + _parse("an implicit subrule", $aftererror, $line, + "( $code )"); + my $implicit = $rule->nextimplicit; + $self->_generate("$implicit : $code",$replace,1); + my $pos = pos $grammar; + substr($grammar,$pos,0,$implicit); + pos $grammar = $pos;; + } + elsif ($grammar =~ m/$ENDDIRECTIVEMK/gco) + { + + # EXTRACT TRAILING REPETITION SPECIFIER (IF ANY) + + my ($minrep,$maxrep) = (1,$MAXREP); + if ($grammar =~ m/\G[(]/gc) + { + pos($grammar)--; + + if ($grammar =~ m/$OPTIONAL/gco) + { ($minrep, $maxrep) = (0,1) } + elsif ($grammar =~ m/$ANY/gco) + { $minrep = 0 } + elsif ($grammar =~ m/$EXACTLY/gco) + { ($minrep, $maxrep) = ($1,$1) } + elsif ($grammar =~ m/$BETWEEN/gco) + { ($minrep, $maxrep) = ($1,$2) } + elsif ($grammar =~ m/$ATLEAST/gco) + { $minrep = $1 } + elsif ($grammar =~ m/$ATMOST/gco) + { $maxrep = $1 } + elsif ($grammar =~ m/$MANY/gco) + { } + elsif ($grammar =~ m/$BADREP/gco) + { + _parse("an invalid repetition specifier", 0,$line); + _error("Incorrect specification of a repeated directive", + $line); + _hint("Repeated directives cannot have + a maximum repetition of zero, nor can they have + negative components in their ranges."); + } + } + + $prod && $prod->enddirective($line,$minrep,$maxrep); + } + elsif ($grammar =~ m/\G\s*<[^m]/gc) + { + pos($grammar)-=2; + + if ($grammar =~ m/$OPMK/gco) + { + # $DB::single=1; + _parse("a $1-associative operator directive", $aftererror, $line, "<$1op:...>"); + $prod->adddirective($1, $line,$2||''); + } + elsif ($grammar =~ m/$UNCOMMITMK/gco) + { + _parse("an uncommit marker", $aftererror,$line); + $item = new Parse::RecDescent::Directive('$commit=0;1', + $lookahead,$line,""); + $prod and $prod->additem($item) + or _no_rule("",$line); + } + elsif ($grammar =~ m/$QUOTELIKEMK/gco) + { + _parse("an perl quotelike marker", $aftererror,$line); + $item = new Parse::RecDescent::Directive( + 'my ($match,@res); + ($match,$text,undef,@res) = + Text::Balanced::extract_quotelike($text,$skip); + $match ? \@res : undef; + ', $lookahead,$line,""); + $prod and $prod->additem($item) + or _no_rule("",$line); + } + elsif ($grammar =~ m/$CODEBLOCKMK/gco) + { + my $outer = $1||"{}"; + _parse("an perl codeblock marker", $aftererror,$line); + $item = new Parse::RecDescent::Directive( + 'Text::Balanced::extract_codeblock($text,undef,$skip,\''.$outer.'\'); + ', $lookahead,$line,""); + $prod and $prod->additem($item) + or _no_rule("",$line); + } + elsif ($grammar =~ m/$VARIABLEMK/gco) + { + _parse("an perl variable marker", $aftererror,$line); + $item = new Parse::RecDescent::Directive( + 'Text::Balanced::extract_variable($text,$skip); + ', $lookahead,$line,""); + $prod and $prod->additem($item) + or _no_rule("",$line); + } + elsif ($grammar =~ m/$NOCHECKMK/gco) + { + _parse("a disable checking marker", $aftererror,$line); + if ($rule) + { + _error(" directive not at start of grammar", $line); + _hint("The directive can only + be specified at the start of a + grammar (before the first rule + is defined."); + } + else + { + local $::RD_CHECK = 1; + } + } + elsif ($grammar =~ m/$AUTOSTUBMK/gco) + { + _parse("an autostub marker", $aftererror,$line); + $::RD_AUTOSTUB = ""; + } + elsif ($grammar =~ m/$AUTORULEMK/gco) + { + _parse("an autorule marker", $aftererror,$line); + $::RD_AUTOSTUB = $1; + } + elsif ($grammar =~ m/$AUTOTREEMK/gco) + { + _parse("an autotree marker", $aftererror,$line); + if ($rule) + { + _error(" directive not at start of grammar", $line); + _hint("The directive can only + be specified at the start of a + grammar (before the first rule + is defined."); + } + else + { + undef $self->{_AUTOACTION}; + $self->{_AUTOTREE}{NODE} + = new Parse::RecDescent::Action(q{{bless \%item, $item[0]}},0,-1); + $self->{_AUTOTREE}{TERMINAL} + = new Parse::RecDescent::Action(q{{bless {__VALUE__=>$item[1]}, $item[0]}},0,-1); + } + } + + elsif ($grammar =~ m/$REJECTMK/gco) + { + _parse("an reject marker", $aftererror,$line); + $item = new Parse::RecDescent::UncondReject($lookahead,$line,""); + $prod and $prod->additem($item) + or _no_rule("",$line); + } + elsif ($grammar =~ m/(?=$CONDREJECTMK)/gco + and do { ($code) = extract_codeblock($grammar,'{',undef,'<'); + $code }) + { + _parse("a (conditional) reject marker", $aftererror,$line); + $code =~ /\A\s*\Z/s; + $item = new Parse::RecDescent::Directive( + "($1) ? undef : 1", $lookahead,$line,""); + $prod and $prod->additem($item) + or _no_rule("",$line); + } + elsif ($grammar =~ m/(?=$SCOREMK)/gco + and do { ($code) = extract_codeblock($grammar,'{',undef,'<'); + $code }) + { + _parse("a score marker", $aftererror,$line); + $code =~ /\A\s*\Z/s; + $prod and $prod->addscore($1, $lookahead, $line) + or _no_rule($code,$line); + } + elsif ($grammar =~ m/(?=$AUTOSCOREMK)/gco + and do { ($code) = extract_codeblock($grammar,'{',undef,'<'); + $code; + } ) + { + _parse("an autoscore specifier", $aftererror,$line,$code); + $code =~ /\A\s*\Z/s; + + $rule and $rule->addautoscore($1,$self) + or _no_rule($code,$line); + + $item = new Parse::RecDescent::UncondReject($lookahead,$line,$code); + $prod and $prod->additem($item) + or _no_rule($code,$line); + } + elsif ($grammar =~ m/$RESYNCMK/gco) + { + _parse("a resync to newline marker", $aftererror,$line); + $item = new Parse::RecDescent::Directive( + 'if ($text =~ s/\A[^\n]*\n//) { $return = 0; $& } else { undef }', + $lookahead,$line,""); + $prod and $prod->additem($item) + or _no_rule("",$line); + } + elsif ($grammar =~ m/(?=$RESYNCPATMK)/gco + and do { ($code) = extract_bracketed($grammar,'<'); + $code }) + { + _parse("a resync with pattern marker", $aftererror,$line); + $code =~ /\A\s*\Z/s; + $item = new Parse::RecDescent::Directive( + 'if ($text =~ s/\A'.$1.'//) { $return = 0; $& } else { undef }', + $lookahead,$line,$code); + $prod and $prod->additem($item) + or _no_rule($code,$line); + } + elsif ($grammar =~ m/(?=$SKIPMK)/gco + and do { ($code) = extract_codeblock($grammar,'<'); + $code }) + { + _parse("a skip marker", $aftererror,$line); + $code =~ /\A\s*\Z/s; + $item = new Parse::RecDescent::Directive( + 'my $oldskip = $skip; $skip='.$1.'; $oldskip', + $lookahead,$line,$code); + $prod and $prod->additem($item) + or _no_rule($code,$line); + } + elsif ($grammar =~ m/(?=$RULEVARPATMK)/gco + and do { ($code) = extract_codeblock($grammar,'{',undef,'<'); + $code; + } ) + { + _parse("a rule variable specifier", $aftererror,$line,$code); + $code =~ /\A\s*\Z/s; + + $rule and $rule->addvar($1,$self) + or _no_rule($code,$line); + + $item = new Parse::RecDescent::UncondReject($lookahead,$line,$code); + $prod and $prod->additem($item) + or _no_rule($code,$line); + } + elsif ($grammar =~ m/(?=$DEFERPATMK)/gco + and do { ($code) = extract_codeblock($grammar,'{',undef,'<'); + $code; + } ) + { + _parse("a deferred action specifier", $aftererror,$line,$code); + $code =~ s/\A\s*\Z/$1/s; + if ($code =~ /\A\s*[^{]|[^}]\s*\Z/) + { + $code = "{ $code }" + } + + $item = new Parse::RecDescent::Directive( + "push \@{\$thisparser->{deferred}}, sub $code;", + $lookahead,$line,""); + $prod and $prod->additem($item) + or _no_rule("",$line); + + $self->{deferrable} = 1; + } + elsif ($grammar =~ m/(?=$TOKENPATMK)/gco + and do { ($code) = extract_codeblock($grammar,'{',undef,'<'); + $code; + } ) + { + _parse("a token constructor", $aftererror,$line,$code); + $code =~ s/\A\s*\Z/$1/s; + + my $types = eval 'no strict; local $SIG{__WARN__} = sub {0}; my @arr=('.$code.'); @arr' || (); + if (!$types) + { + _error("Incorrect token specification: \"$@\"", $line); + _hint("The directive requires a list + of one or more strings representing possible + types of the specified token. For example: + "); + } + else + { + $item = new Parse::RecDescent::Directive( + 'no strict; + $return = { text => $item[-1] }; + @{$return->{type}}{'.$code.'} = (1..'.$types.');', + $lookahead,$line,""); + $prod and $prod->additem($item) + or _no_rule("",$line); + } + } + elsif ($grammar =~ m/$COMMITMK/gco) + { + _parse("an commit marker", $aftererror,$line); + $item = new Parse::RecDescent::Directive('$commit = 1', + $lookahead,$line,""); + $prod and $prod->additem($item) + or _no_rule("",$line); + } + elsif ($grammar =~ m/$AUTOERRORMK/gco) + { + $commitonly = $1; + _parse("an error marker", $aftererror,$line); + $item = new Parse::RecDescent::Error('',$lookahead,$1,$line); + $prod and $prod->additem($item) + or _no_rule("",$line); + $aftererror = !$commitonly; + } + elsif ($grammar =~ m/(?=$MSGERRORMK)/gco + and do { $commitonly = $1; + ($code) = extract_bracketed($grammar,'<'); + $code }) + { + _parse("an error marker", $aftererror,$line,$code); + $code =~ /\A\s*\Z/s; + $item = new Parse::RecDescent::Error($1,$lookahead,$commitonly,$line); + $prod and $prod->additem($item) + or _no_rule("$code",$line); + $aftererror = !$commitonly; + } + elsif (do { $commitonly = $1; + ($code) = extract_bracketed($grammar,'<'); + $code }) + { + if ($code =~ /^<[A-Z_]+>$/) + { + _error("Token items are not yet + supported: \"$code\"", + $line); + _hint("Items like $code that consist of angle + brackets enclosing a sequence of + uppercase characters will eventually + be used to specify pre-lexed tokens + in a grammar. That functionality is not + yet implemented. Or did you misspell + \"$code\"?"); + } + else + { + _error("Untranslatable item encountered: \"$code\"", + $line); + _hint("Did you misspell \"$code\" + or forget to comment it out?"); + } + } + } + elsif ($grammar =~ m/$RULE/gco) + { + _parseunneg("a rule declaration", 0, + $lookahead,$line) or next; + my $rulename = $1; + if ($rulename =~ /Replace|Extend|Precompile|Save/ ) + { + _warn(2,"Rule \"$rulename\" hidden by method + Parse::RecDescent::$rulename",$line) + and + _hint("The rule named \"$rulename\" cannot be directly + called through the Parse::RecDescent object + for this grammar (although it may still + be used as a subrule of other rules). + It can't be directly called because + Parse::RecDescent::$rulename is already defined (it + is the standard method of all + parsers)."); + } + $rule = new Parse::RecDescent::Rule($rulename,$self,$line,$replace); + $prod->check_pending($line) if $prod; + $prod = $rule->addprod( new Parse::RecDescent::Production ); + $aftererror = 0; + } + elsif ($grammar =~ m/$UNCOMMITPROD/gco) + { + pos($grammar)-=9; + _parseunneg("a new (uncommitted) production", + 0, $lookahead, $line) or next; + + $prod->check_pending($line) if $prod; + $prod = new Parse::RecDescent::Production($line,1); + $rule and $rule->addprod($prod) + or _no_rule("",$line); + $aftererror = 0; + } + elsif ($grammar =~ m/$ERRORPROD/gco) + { + pos($grammar)-=6; + _parseunneg("a new (error) production", $aftererror, + $lookahead,$line) or next; + $prod->check_pending($line) if $prod; + $prod = new Parse::RecDescent::Production($line,0,1); + $rule and $rule->addprod($prod) + or _no_rule("",$line); + $aftererror = 0; + } + elsif ($grammar =~ m/$PROD/gco) + { + _parseunneg("a new production", 0, + $lookahead,$line) or next; + $rule + and (!$prod || $prod->check_pending($line)) + and $prod = $rule->addprod(new Parse::RecDescent::Production($line)) + or _no_rule("production",$line); + $aftererror = 0; + } + elsif ($grammar =~ m/$LITERAL/gco) + { + ($code = $1) =~ s/\\\\/\\/g; + _parse("a literal terminal", $aftererror,$line,$1); + $item = new Parse::RecDescent::Literal($code,$lookahead,$line); + $prod and $prod->additem($item) + or _no_rule("literal terminal",$line,"'$1'"); + } + elsif ($grammar =~ m/$INTERPLIT/gco) + { + _parse("an interpolated literal terminal", $aftererror,$line); + $item = new Parse::RecDescent::InterpLit($1,$lookahead,$line); + $prod and $prod->additem($item) + or _no_rule("interpolated literal terminal",$line,"'$1'"); + } + elsif ($grammar =~ m/$TOKEN/gco) + { + _parse("a /../ pattern terminal", $aftererror,$line); + $item = new Parse::RecDescent::Token($1,'/',$3?$3:'',$lookahead,$line); + $prod and $prod->additem($item) + or _no_rule("pattern terminal",$line,"/$1/"); + } + elsif ($grammar =~ m/(?=$MTOKEN)/gco + and do { ($code, undef, @components) + = extract_quotelike($grammar); + $code } + ) + + { + _parse("an m/../ pattern terminal", $aftererror,$line,$code); + $item = new Parse::RecDescent::Token(@components[3,2,8], + $lookahead,$line); + $prod and $prod->additem($item) + or _no_rule("pattern terminal",$line,$code); + } + elsif ($grammar =~ m/(?=$MATCHRULE)/gco + and do { ($code) = extract_bracketed($grammar,'<'); + $code + } + or $grammar =~ m/$SUBRULE/gco + and $code = $1) + { + my $name = $code; + my $matchrule = 0; + if (substr($name,0,1) eq '<') + { + $name =~ s/$MATCHRULE\s*//; + $name =~ s/\s*>\Z//; + $matchrule = 1; + } + + # EXTRACT TRAILING ARG LIST (IF ANY) + + my ($argcode) = extract_codeblock($grammar, "[]",'') || ''; + + # EXTRACT TRAILING REPETITION SPECIFIER (IF ANY) + + if ($grammar =~ m/\G[(]/gc) + { + pos($grammar)--; + + if ($grammar =~ m/$OPTIONAL/gco) + { + _parse("an zero-or-one subrule match", $aftererror,$line,"$code$argcode($1)"); + $item = new Parse::RecDescent::Repetition($name,$1,0,1, + $lookahead,$line, + $self, + $matchrule, + $argcode); + $prod and $prod->additem($item) + or _no_rule("repetition",$line,"$code$argcode($1)"); + + !$matchrule and $rule and $rule->addcall($name); + } + elsif ($grammar =~ m/$ANY/gco) + { + _parse("a zero-or-more subrule match", $aftererror,$line,"$code$argcode($1)"); + if ($2) + { + my $pos = pos $grammar; + substr($grammar,$pos,0, + "(s?) "); + + pos $grammar = $pos; + } + else + { + $item = new Parse::RecDescent::Repetition($name,$1,0,$MAXREP, + $lookahead,$line, + $self, + $matchrule, + $argcode); + $prod and $prod->additem($item) + or _no_rule("repetition",$line,"$code$argcode($1)"); + + !$matchrule and $rule and $rule->addcall($name); + + _check_insatiable($name,$1,$grammar,$line) if $::RD_CHECK; + } + } + elsif ($grammar =~ m/$MANY/gco) + { + _parse("a one-or-more subrule match", $aftererror,$line,"$code$argcode($1)"); + if ($2) + { + # $DB::single=1; + my $pos = pos $grammar; + substr($grammar,$pos,0, + " "); + + pos $grammar = $pos; + } + else + { + $item = new Parse::RecDescent::Repetition($name,$1,1,$MAXREP, + $lookahead,$line, + $self, + $matchrule, + $argcode); + + $prod and $prod->additem($item) + or _no_rule("repetition",$line,"$code$argcode($1)"); + + !$matchrule and $rule and $rule->addcall($name); + + _check_insatiable($name,$1,$grammar,$line) if $::RD_CHECK; + } + } + elsif ($grammar =~ m/$EXACTLY/gco) + { + _parse("an exactly-$1-times subrule match", $aftererror,$line,"$code$argcode($1)"); + if ($2) + { + my $pos = pos $grammar; + substr($grammar,$pos,0, + "($1) "); + + pos $grammar = $pos; + } + else + { + $item = new Parse::RecDescent::Repetition($name,$1,$1,$1, + $lookahead,$line, + $self, + $matchrule, + $argcode); + $prod and $prod->additem($item) + or _no_rule("repetition",$line,"$code$argcode($1)"); + + !$matchrule and $rule and $rule->addcall($name); + } + } + elsif ($grammar =~ m/$BETWEEN/gco) + { + _parse("a $1-to-$2 subrule match", $aftererror,$line,"$code$argcode($1..$2)"); + if ($3) + { + my $pos = pos $grammar; + substr($grammar,$pos,0, + "($1..$2) "); + + pos $grammar = $pos; + } + else + { + $item = new Parse::RecDescent::Repetition($name,"$1..$2",$1,$2, + $lookahead,$line, + $self, + $matchrule, + $argcode); + $prod and $prod->additem($item) + or _no_rule("repetition",$line,"$code$argcode($1..$2)"); + + !$matchrule and $rule and $rule->addcall($name); + } + } + elsif ($grammar =~ m/$ATLEAST/gco) + { + _parse("a $1-or-more subrule match", $aftererror,$line,"$code$argcode($1..)"); + if ($2) + { + my $pos = pos $grammar; + substr($grammar,$pos,0, + "($1..) "); + + pos $grammar = $pos; + } + else + { + $item = new Parse::RecDescent::Repetition($name,"$1..",$1,$MAXREP, + $lookahead,$line, + $self, + $matchrule, + $argcode); + $prod and $prod->additem($item) + or _no_rule("repetition",$line,"$code$argcode($1..)"); + + !$matchrule and $rule and $rule->addcall($name); + _check_insatiable($name,"$1..",$grammar,$line) if $::RD_CHECK; + } + } + elsif ($grammar =~ m/$ATMOST/gco) + { + _parse("a one-to-$1 subrule match", $aftererror,$line,"$code$argcode(..$1)"); + if ($2) + { + my $pos = pos $grammar; + substr($grammar,$pos,0, + "(..$1) "); + + pos $grammar = $pos; + } + else + { + $item = new Parse::RecDescent::Repetition($name,"..$1",1,$1, + $lookahead,$line, + $self, + $matchrule, + $argcode); + $prod and $prod->additem($item) + or _no_rule("repetition",$line,"$code$argcode(..$1)"); + + !$matchrule and $rule and $rule->addcall($name); + } + } + elsif ($grammar =~ m/$BADREP/gco) + { + _parse("an subrule match with invalid repetition specifier", 0,$line); + _error("Incorrect specification of a repeated subrule", + $line); + _hint("Repeated subrules like \"$code$argcode$&\" cannot have + a maximum repetition of zero, nor can they have + negative components in their ranges."); + } + } + else + { + _parse("a subrule match", $aftererror,$line,$code); + my $desc; + if ($name=~/\A_alternation_\d+_of_production_\d+_of_rule/) + { $desc = $self->{"rules"}{$name}->expected } + $item = new Parse::RecDescent::Subrule($name, + $lookahead, + $line, + $desc, + $matchrule, + $argcode); + + $prod and $prod->additem($item) + or _no_rule("(sub)rule",$line,$name); + + !$matchrule and $rule and $rule->addcall($name); + } + } + elsif ($grammar =~ m/$LONECOLON/gco ) + { + _error("Unexpected colon encountered", $line); + _hint("Did you mean \"|\" (to start a new production)? + Or perhaps you forgot that the colon + in a rule definition must be + on the same line as the rule name?"); + } + elsif ($grammar =~ m/$ACTION/gco ) # BAD ACTION, ALREADY FAILED + { + _error("Malformed action encountered", + $line); + _hint("Did you forget the closing curly bracket + or is there a syntax error in the action?"); + } + elsif ($grammar =~ m/$OTHER/gco ) + { + _error("Untranslatable item encountered: \"$1\"", + $line); + _hint("Did you misspell \"$1\" + or forget to comment it out?"); + } + + if ($lookaheadspec =~ tr /././ > 3) + { + $lookaheadspec =~ s/\A\s+//; + $lookahead = $lookahead<0 + ? 'a negative lookahead ("...!")' + : 'a positive lookahead ("...")' ; + _warn(1,"Found two or more lookahead specifiers in a + row.",$line) + and + _hint("Multiple positive and/or negative lookaheads + are simply multiplied together to produce a + single positive or negative lookahead + specification. In this case the sequence + \"$lookaheadspec\" was reduced to $lookahead. + Was this your intention?"); + } + $lookahead = 0; + $lookaheadspec = ""; + + $grammar =~ m/\G\s+/gc; + } + + unless ($ERRORS or $isimplicit or !$::RD_CHECK) + { + $self->_check_grammar(); + } + + unless ($ERRORS or $isimplicit or $Parse::RecDescent::compiling) + { + my $code = $self->_code(); + if (defined $::RD_TRACE) + { + print STDERR "printing code (", length($code),") to RD_TRACE\n"; + local *TRACE_FILE; + open TRACE_FILE, ">RD_TRACE" + and print TRACE_FILE "my \$ERRORS;\n$code" + and close TRACE_FILE; + } + + unless ( eval "$code 1" ) + { + _error("Internal error in generated parser code!"); + $@ =~ s/at grammar/in grammar at/; + _hint($@); + } + } + + if ($ERRORS and !_verbosity("HINT")) + { + local $::RD_HINT = 1; + _hint('Set $::RD_HINT (or -RD_HINT if you\'re using "perl -s") + for hints on fixing these problems.'); + } + if ($ERRORS) { $ERRORS=0; return } + return $self; +} + + +sub _addstartcode($$) +{ + my ($self, $code) = @_; + $code =~ s/\A\s*\{(.*)\}\Z/$1/s; + + $self->{"startcode"} .= "$code;\n"; +} + +# CHECK FOR GRAMMAR PROBLEMS.... + +sub _check_insatiable($$$$) +{ + my ($subrule,$repspec,$grammar,$line) = @_; + pos($grammar)=pos($_[2]); + return if $grammar =~ m/$OPTIONAL/gco || $grammar =~ m/$ANY/gco; + my $min = 1; + if ( $grammar =~ m/$MANY/gco + || $grammar =~ m/$EXACTLY/gco + || $grammar =~ m/$ATMOST/gco + || $grammar =~ m/$BETWEEN/gco && do { $min=$2; 1 } + || $grammar =~ m/$ATLEAST/gco && do { $min=$2; 1 } + || $grammar =~ m/$SUBRULE(?!\s*:)/gco + ) + { + return unless $1 eq $subrule && $min > 0; + _warn(3,"Subrule sequence \"$subrule($repspec) $&\" will + (almost certainly) fail.",$line) + and + _hint("Unless subrule \"$subrule\" performs some cunning + lookahead, the repetition \"$subrule($repspec)\" will + insatiably consume as many matches of \"$subrule\" as it + can, leaving none to match the \"$&\" that follows."); + } +} + +sub _check_grammar ($) +{ + my $self = shift; + my $rules = $self->{"rules"}; + my $rule; + foreach $rule ( values %$rules ) + { + next if ! $rule->{"changed"}; + + # CHECK FOR UNDEFINED RULES + + my $call; + foreach $call ( @{$rule->{"calls"}} ) + { + if (!defined ${$rules}{$call} + &&!defined &{"Parse::RecDescent::$call"}) + { + if (!defined $::RD_AUTOSTUB) + { + _warn(3,"Undefined (sub)rule \"$call\" + used in a production.") + and + _hint("Will you be providing this rule + later, or did you perhaps + misspell \"$call\"? Otherwise + it will be treated as an + immediate ."); + eval "sub $self->{namespace}::$call {undef}"; + } + else # EXPERIMENTAL + { + my $rule = $::RD_AUTOSTUB || qq{'$call'}; + _warn(1,"Autogenerating rule: $call") + and + _hint("A call was made to a subrule + named \"$call\", but no such + rule was specified. However, + since \$::RD_AUTOSTUB + was defined, a rule stub + ($call : $rule) was + automatically created."); + + $self->_generate("$call : $rule",0,1); + } + } + } + + # CHECK FOR LEFT RECURSION + + if ($rule->isleftrec($rules)) + { + _error("Rule \"$rule->{name}\" is left-recursive."); + _hint("Redesign the grammar so it's not left-recursive. + That will probably mean you need to re-implement + repetitions using the '(s)' notation. + For example: \"$rule->{name}(s)\"."); + next; + } + } +} + +# GENERATE ACTUAL PARSER CODE + +sub _code($) +{ + my $self = shift; + my $code = qq{ +package $self->{namespace}; +use strict; +use vars qw(\$skip \$AUTOLOAD $self->{localvars} ); +\$skip = '$skip'; +$self->{startcode} + +{ +local \$SIG{__WARN__} = sub {0}; +# PRETEND TO BE IN Parse::RecDescent NAMESPACE +*$self->{namespace}::AUTOLOAD = sub +{ + no strict 'refs'; + \$AUTOLOAD =~ s/^$self->{namespace}/Parse::RecDescent/; + goto &{\$AUTOLOAD}; +} +} + +}; + $code .= "push \@$self->{namespace}\::ISA, 'Parse::RecDescent';"; + $self->{"startcode"} = ''; + + my $rule; + foreach $rule ( values %{$self->{"rules"}} ) + { + if ($rule->{"changed"}) + { + $code .= $rule->code($self->{"namespace"},$self); + $rule->{"changed"} = 0; + } + } + + return $code; +} + + +# EXECUTING A PARSE.... + +sub AUTOLOAD # ($parser, $text; $linenum, @args) +{ + croak "Could not find method: $AUTOLOAD\n" unless ref $_[0]; + my $class = ref($_[0]) || $_[0]; + my $text = ref($_[1]) ? ${$_[1]} : $_[1]; + $_[0]->{lastlinenum} = $_[2]||_linecount($_[1]); + $_[0]->{lastlinenum} = _linecount($_[1]); + $_[0]->{lastlinenum} += $_[2] if @_ > 2; + $_[0]->{offsetlinenum} = $_[0]->{lastlinenum}; + $_[0]->{fulltext} = $text; + $_[0]->{fulltextlen} = length $text; + $_[0]->{deferred} = []; + $_[0]->{errors} = []; + my @args = @_[3..$#_]; + my $args = sub { [ @args ] }; + + $AUTOLOAD =~ s/$class/$_[0]->{namespace}/; + no strict "refs"; + + croak "Unknown starting rule ($AUTOLOAD) called\n" + unless defined &$AUTOLOAD; + my $retval = &{$AUTOLOAD}($_[0],$text,undef,undef,$args); + + if (defined $retval) + { + foreach ( @{$_[0]->{deferred}} ) { &$_; } + } + else + { + foreach ( @{$_[0]->{errors}} ) { _error(@$_); } + } + + if (ref $_[1]) { ${$_[1]} = $text } + + $ERRORS = 0; + return $retval; +} + +sub _parserepeat($$$$$$$$$$) # RETURNS A REF TO AN ARRAY OF MATCHES +{ + my ($parser, $text, $prod, $min, $max, $_noactions, $expectation, $argcode) = @_; + my @tokens = (); + + my $reps; + for ($reps=0; $reps<$max;) + { + $_[6]->at($text); # $_[6] IS $expectation FROM CALLER + my $_savetext = $text; + my $prevtextlen = length $text; + my $_tok; + if (! defined ($_tok = &$prod($parser,$text,1,$_noactions,$argcode))) + { + $text = $_savetext; + last; + } + push @tokens, $_tok if defined $_tok; + last if ++$reps >= $min and $prevtextlen == length $text; + } + + do { $_[6]->failed(); return undef} if $reps<$min; + + $_[1] = $text; + return [@tokens]; +} + + +# ERROR REPORTING.... + +my $errortext; +my $errorprefix; + +open (ERROR, ">&STDERR"); +format ERROR = +@>>>>>>>>>>>>>>>>>>>>: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +$errorprefix, $errortext +~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $errortext +. + +select ERROR; +$| = 1; + +# TRACING + +my $tracemsg; +my $tracecontext; +my $tracerulename; +use vars '$tracelevel'; + +open (TRACE, ">&STDERR"); +format TRACE = +@>|@|||||||||@^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<| +$tracelevel, $tracerulename, '|', $tracemsg + | ~~ |^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<| + $tracemsg +. + +select TRACE; +$| = 1; + +open (TRACECONTEXT, ">&STDERR"); +format TRACECONTEXT = +@>|@|||||||||@ |^<<<<<<<<<<<<<<<<<<<<<<<<<<< +$tracelevel, $tracerulename, '|', $tracecontext + | ~~ | |^<<<<<<<<<<<<<<<<<<<<<<<<<<< + $tracecontext +. + + +select TRACECONTEXT; +$| = 1; + +select STDOUT; + +sub _verbosity($) +{ + defined $::RD_TRACE + or defined $::RD_HINT and $_[0] =~ /ERRORS|WARN|HINT/ + or defined $::RD_WARN and $_[0] =~ /ERRORS|WARN/ + or defined $::RD_ERRORS and $_[0] =~ /ERRORS/ +} + +sub _error($;$) +{ + $ERRORS++; + return 0 if ! _verbosity("ERRORS"); + $errortext = $_[0]; + $errorprefix = "ERROR" . ($_[1] ? " (line $_[1])" : ""); + $errortext =~ s/\s+/ /g; + print ERROR "\n" if _verbosity("WARN"); + write ERROR; + return 1; +} + +sub _warn($$;$) +{ + return 0 unless _verbosity("WARN") && ($::RD_HINT || $_[0] >= ($::RD_WARN||1)); + $errortext = $_[1]; + $errorprefix = "Warning" . ($_[2] ? " (line $_[2])" : ""); + print ERROR "\n"; + $errortext =~ s/\s+/ /g; + write ERROR; + return 1; +} + +sub _hint($) +{ + return 0 unless defined $::RD_HINT; + $errortext = "$_[0])"; + $errorprefix = "(Hint"; + $errortext =~ s/\s+/ /g; + write ERROR; + return 1; +} + +sub _tracemax($) +{ + if (defined $::RD_TRACE + && $::RD_TRACE =~ /\d+/ + && $::RD_TRACE>1 + && $::RD_TRACE+10..." + . substr($_[0],-$::RD_TRACE/2); + } + else + { + return $_[0]; + } +} + +sub _tracefirst($) +{ + if (defined $::RD_TRACE + && $::RD_TRACE =~ /\d+/ + && $::RD_TRACE>1 + && $::RD_TRACE+10"; + } + else + { + return $_[0]; + } +} + +my $lastcontext = ''; +my $lastrulename = ''; +my $lastlevel = ''; + +sub _trace($;$$$) +{ + $tracemsg = $_[0]; + $tracecontext = $_[1]||$lastcontext; + $tracerulename = $_[2]||$lastrulename; + $tracelevel = $_[3]||$lastlevel; + if ($tracerulename) { $lastrulename = $tracerulename } + if ($tracelevel) { $lastlevel = $tracelevel } + + $tracecontext =~ s/\n/\\n/g; + $tracecontext =~ s/\s+/ /g; + $tracerulename = qq{$tracerulename}; + write TRACE; + if ($tracecontext ne $lastcontext) + { + if ($tracecontext) + { + $lastcontext = _tracefirst($tracecontext); + $tracecontext = qq{"$tracecontext"}; + } + else + { + $tracecontext = qq{}; + } + write TRACECONTEXT; + } +} + +sub _parseunneg($$$$) +{ + _parse($_[0],$_[1],$_[3]); + if ($_[2]<0) + { + _error("Can't negate \"$&\".",$_[3]); + _hint("You can't negate $_[0]. Remove the \"...!\" before + \"$&\"."); + return 0; + } + return 1; +} + +sub _parse($$$;$) +{ + my $what = $_[3] || $&; + $what =~ s/^\s+//; + if ($_[1]) + { + _warn(3,"Found $_[0] ($what) after an unconditional ",$_[2]) + and + _hint("An unconditional always causes the + production containing it to immediately fail. + \u$_[0] that follows an + will never be reached. Did you mean to use + instead?"); + } + + return if ! _verbosity("TRACE"); + $errortext = "Treating \"$what\" as $_[0]"; + $errorprefix = "Parse::RecDescent"; + $errortext =~ s/\s+/ /g; + write ERROR; +} + +sub _linecount($) { + scalar substr($_[0], pos $_[0]||0) =~ tr/\n// +} + + +package main; + +use vars qw ( $RD_ERRORS $RD_WARN $RD_HINT $RD_TRACE $RD_CHECK ); +$::RD_CHECK = 1; +$::RD_ERRORS = 1; +$::RD_WARN = 3; + +1; + diff --git a/lib/Template.pm b/lib/Template.pm new file mode 100644 index 0000000..18e1ec4 --- /dev/null +++ b/lib/Template.pm @@ -0,0 +1,950 @@ +#============================================================= -*-perl-*- +# +# Template +# +# DESCRIPTION +# Module implementing a simple, user-oriented front-end to the Template +# Toolkit. +# +# AUTHOR +# Andy Wardley +# +# COPYRIGHT +# Copyright (C) 1996-2002 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +# REVISION +# $Id: Template.pm,v 2.68 2003/04/29 12:38:58 abw Exp $ +# +#======================================================================== + +package Template; +use base qw( Template::Base ); + +require 5.005; + +use strict; +use vars qw( $VERSION $AUTOLOAD $ERROR $DEBUG $BINMODE ); +use Template::Base; +use Template::Config; +use Template::Constants; +use Template::Provider; +use Template::Service; +use File::Basename; +use File::Path; + +## This is the main version number for the Template Toolkit. +## It is extracted by ExtUtils::MakeMaker and inserted in various places. +$VERSION = '2.10'; +$ERROR = ''; +$DEBUG = 0; + +# we used to default to binary mode for all win32 files but that make +# line endings strange, so we're turning it off and letting users set +# it explicitly as an argument to process() +# $BINMODE = ($^O eq 'MSWin32') ? 1 : 0; +$BINMODE = 0 unless defined $BINMODE; + +# preload all modules if we're running under mod_perl +Template::Config->preload() if $ENV{ MOD_PERL }; + + +#------------------------------------------------------------------------ +# process($input, \%replace, $output) +# +# Main entry point for the Template Toolkit. The Template module +# delegates most of the processing effort to the underlying SERVICE +# object, an instance of the Template::Service class. +#------------------------------------------------------------------------ + +sub process { + my ($self, $template, $vars, $outstream, @opts) = @_; + my ($output, $error); + my $options = (@opts == 1) && UNIVERSAL::isa($opts[0], 'HASH') + ? shift(@opts) : { @opts }; + + $options->{ binmode } = $BINMODE + unless defined $options->{ binmode }; + + # we're using this for testing in t/output.t and t/filter.t so + # don't remove it if you don't want tests to fail... + $self->DEBUG("set binmode\n") if $DEBUG && $options->{ binmode }; + + $output = $self->{ SERVICE }->process($template, $vars); + + if (defined $output) { + $outstream ||= $self->{ OUTPUT }; + unless (ref $outstream) { + my $outpath = $self->{ OUTPUT_PATH }; + $outstream = "$outpath/$outstream" if $outpath; + } + + # send processed template to output stream, checking for error + return ($self->error($error)) + if ($error = &_output($outstream, \$output, $options)); + + return 1; + } + else { + return $self->error($self->{ SERVICE }->error); + } +} + + +#------------------------------------------------------------------------ +# service() +# +# Returns a reference to the the internal SERVICE object which handles +# all requests for this Template object +#------------------------------------------------------------------------ + +sub service { + my $self = shift; + return $self->{ SERVICE }; +} + + +#------------------------------------------------------------------------ +# context() +# +# Returns a reference to the the CONTEXT object withint the SERVICE +# object. +#------------------------------------------------------------------------ + +sub context { + my $self = shift; + return $self->{ SERVICE }->{ CONTEXT }; +} + + +#======================================================================== +# -- PRIVATE METHODS -- +#======================================================================== + +#------------------------------------------------------------------------ +# _init(\%config) +#------------------------------------------------------------------------ +sub _init { + my ($self, $config) = @_; + + # convert any textual DEBUG args to numerical form + my $debug = $config->{ DEBUG }; + $config->{ DEBUG } = Template::Constants::debug_flags($self, $debug) + || return if defined $debug && $debug !~ /^\d+$/; + + # prepare a namespace handler for any CONSTANTS definition + if (my $constants = $config->{ CONSTANTS }) { + my $ns = $config->{ NAMESPACE } ||= { }; + my $cns = $config->{ CONSTANTS_NAMESPACE } || 'constants'; + $constants = Template::Config->constants($constants) + || return $self->error(Template::Config->error); + $ns->{ $cns } = $constants; + } + + $self->{ SERVICE } = $config->{ SERVICE } + || Template::Config->service($config) + || return $self->error(Template::Config->error); + + $self->{ OUTPUT } = $config->{ OUTPUT } || \*STDOUT; + $self->{ OUTPUT_PATH } = $config->{ OUTPUT_PATH }; + + return $self; +} + + +#------------------------------------------------------------------------ +# _output($where, $text) +#------------------------------------------------------------------------ + +sub _output { + my ($where, $textref, $options) = @_; + my $reftype; + my $error = 0; + + # call a CODE reference + if (($reftype = ref($where)) eq 'CODE') { + &$where($$textref); + } + # print to a glob (such as \*STDOUT) + elsif ($reftype eq 'GLOB') { + print $where $$textref; + } + # append output to a SCALAR ref + elsif ($reftype eq 'SCALAR') { + $$where .= $$textref; + } + # push onto ARRAY ref + elsif ($reftype eq 'ARRAY') { + push @$where, $$textref; + } + # call the print() method on an object that implements the method + # (e.g. IO::Handle, Apache::Request, etc) + elsif (UNIVERSAL::can($where, 'print')) { + $where->print($$textref); + } + # a simple string is taken as a filename + elsif (! $reftype) { + local *FP; + # make destination directory if it doesn't exist + my $dir = dirname($where); + eval { mkpath($dir) unless -d $dir; }; + if ($@) { + # strip file name and line number from error raised by die() + ($error = $@) =~ s/ at \S+ line \d+\n?$//; + } + elsif (open(FP, ">$where")) { + binmode FP if $options->{ binmode }; + print FP $$textref; + close FP; + } + else { + $error = "$where: $!"; + } + } + # give up, we've done our best + else { + $error = "output_handler() cannot determine target type ($where)\n"; + } + + return $error; +} + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template - Front-end module to the Template Toolkit + +=head1 SYNOPSIS + + use Template; + + # some useful options (see below for full list) + my $config = { + INCLUDE_PATH => '/search/path', # or list ref + INTERPOLATE => 1, # expand "$var" in plain text + POST_CHOMP => 1, # cleanup whitespace + PRE_PROCESS => 'header', # prefix each template + EVAL_PERL => 1, # evaluate Perl code blocks + }; + + # create Template object + my $template = Template->new($config); + + # define template variables for replacement + my $vars = { + var1 => $value, + var2 => \%hash, + var3 => \@list, + var4 => \&code, + var5 => $object, + }; + + # specify input filename, or file handle, text reference, etc. + my $input = 'myfile.html'; + + # process input template, substituting variables + $template->process($input, $vars) + || die $template->error(); + +=head1 DESCRIPTION + +This documentation describes the Template module which is the direct +Perl interface into the Template Toolkit. It covers the use of the +module and gives a brief summary of configuration options and template +directives. Please see L for the complete reference +manual which goes into much greater depth about the features and use +of the Template Toolkit. The L is also available +as an introductory guide to using the Template Toolkit. + +=head1 METHODS + +=head2 new(\%config) + +The new() constructor method (implemented by the Template::Base base +class) instantiates a new Template object. A reference to a hash +array of configuration items may be passed as a parameter. + + my $tt = Template->new({ + INCLUDE_PATH => '/usr/local/templates', + EVAL_PERL => 1, + }) || die $Template::ERROR, "\n"; + +A reference to a new Template object is returned, or undef on error. +In the latter case, the error message can be retrieved by calling +error() as a class method (e.g. Cerror()>) or by +examining the $ERROR package variable directly +(e.g. C<$Template::ERROR>). + + my $tt = Template->new(\%config) + || die Template->error(), "\n"; + + my $tt = Template->new(\%config) + || die $Template::ERROR, "\n"; + +For convenience, configuration items may also be specified as a list +of items instead of a hash array reference. These are automatically +folded into a hash array by the constructor. + + my $tt = Template->new(INCLUDE_PATH => '/tmp', POST_CHOMP => 1) + || die $Template::ERROR, "\n"; + +=head2 process($template, \%vars, $output, %options) + +The process() method is called to process a template. The first +parameter indicates the input template as one of: a filename relative +to INCLUDE_PATH, if defined; a reference to a text string containing +the template text; or a file handle reference (e.g. IO::Handle or +sub-class) or GLOB (e.g. \*STDIN), from which the template can be +read. A reference to a hash array may be passed as the second +parameter, containing definitions of template variables. + + $text = "[% INCLUDE header %]\nHello world!\n[% INCLUDE footer %]"; + + # filename + $tt->process('welcome.tt2') + || die $tt->error(), "\n"; + + # text reference + $tt->process(\$text) + || die $tt->error(), "\n"; + + # GLOB + $tt->process(\*DATA) + || die $tt->error(), "\n"; + + __END__ + [% INCLUDE header %] + This is a template defined in the __END__ section which is + accessible via the DATA "file handle". + [% INCLUDE footer %] + +By default, the processed template output is printed to STDOUT. The +process() method then returns 1 to indicate success. A third +parameter may be passed to the process() method to specify a different +output location. This value may be one of: a plain string indicating +a filename which will be opened (relative to OUTPUT_PATH, if defined) +and the output written to; a file GLOB opened ready for output; a +reference to a scalar (e.g. a text string) to which output/error is +appended; a reference to a subroutine which is called, passing the +output as a parameter; or any object reference which implements a +'print' method (e.g. IO::Handle, Apache::Request, etc.) which will +be called, passing the generated output as a parameter. + +Examples: + + # output filename + $tt->process('welcome.tt2', $vars, 'welcome.html') + || die $tt->error(), "\n"; + + # reference to output subroutine + sub myout { + my $output = shift; + ... + } + $tt->process('welcome.tt2', $vars, \&myout) + || die $tt->error(), "\n"; + + # reference to output text string + my $output = ''; + $tt->process('welcome.tt2', $vars, \$output) + || die $tt->error(), "\n"; + + print "output: $output\n"; + +In an Apache/mod_perl handler: + + sub handler { + my $req = shift; + + ... + + # direct output to Apache::Request via $req->print($output) + $tt->process($file, $vars, $req) || do { + $req->log_reason($tt->error()); + return SERVER_ERROR; + }; + + return OK; + } + +After the optional third output argument can come an optional +reference to a hash or a list of (name, value) pairs providing further +options for the output. The only option currently supported is +"binmode" which, when set to any true value will ensure that files +created (but not any existing file handles passed) will be set to +binary mode. + + # either: hash reference of options + $tt->process($infile, $vars, $outfile, { binmode => 1 }) + || die $tt->error(), "\n"; + + # or: list of name, value pairs + $tt->process($infile, $vars, $outfile, binmode => 1) + || die $tt->error(), "\n"; + +The OUTPUT configuration item can be used to specify a default output +location other than \*STDOUT. The OUTPUT_PATH specifies a directory +which should be prefixed to all output locations specified as filenames. + + my $tt = Template->new({ + OUTPUT => sub { ... }, # default + OUTPUT_PATH => '/tmp', + ... + }) || die Template->error(), "\n"; + + # use default OUTPUT (sub is called) + $tt->process('welcome.tt2', $vars) + || die $tt->error(), "\n"; + + # write file to '/tmp/welcome.html' + $tt->process('welcome.tt2', $vars, 'welcome.html') + || die $tt->error(), "\n"; + +The process() method returns 1 on success or undef on error. The error +message generated in the latter case can be retrieved by calling the +error() method. See also L which describes how +error handling may be further customised. + +=head2 error() + +When called as a class method, it returns the value of the $ERROR package +variable. Thus, the following are equivalent. + + my $tt = Template->new() + || die Template->error(), "\n"; + + my $tt = Template->new() + || die $Template::ERROR, "\n"; + +When called as an object method, it returns the value of the internal +_ERROR variable, as set by an error condition in a previous call to +process(). + + $tt->process('welcome.tt2') + || die $tt->error(), "\n"; + +Errors are represented in the Template Toolkit by objects of the +Template::Exception class. If the process() method returns a false +value then the error() method can be called to return an object of +this class. The type() and info() methods can called on the object to +retrieve the error type and information string, respectively. The +as_string() method can be called to return a string of the form "$type +- $info". This method is also overloaded onto the stringification +operator allowing the object reference itself to be printed to return +the formatted error string. + + $tt->process('somefile') || do { + my $error = $tt->error(); + print "error type: ", $error->type(), "\n"; + print "error info: ", $error->info(), "\n"; + print $error, "\n"; + }; + +=head2 service() + +The Template module delegates most of the effort of processing templates +to an underlying Template::Service object. This method returns a reference +to that object. + +=head2 context() + +The Template::Service module uses a core Template::Context object for +runtime processing of templates. This method returns a reference to +that object and is equivalent to $template-Eservice-Econtext(); + +=head1 CONFIGURATION SUMMARY + +The following list gives a short summary of each Template Toolkit +configuration option. See L for full details. + +=head2 Template Style and Parsing Options + +=over 4 + +=item START_TAG, END_TAG + +Define tokens that indicate start and end of directives (default: '[%' and +'%]'). + +=item TAG_STYLE + +Set START_TAG and END_TAG according to a pre-defined style (default: +'template', as above). + +=item PRE_CHOMP, POST_CHOMP + +Remove whitespace before/after directives (default: 0/0). + +=item TRIM + +Remove leading and trailing whitespace from template output (default: 0). + +=item INTERPOLATE + +Interpolate variables embedded like $this or ${this} (default: 0). + +=item ANYCASE + +Allow directive keywords in lower case (default: 0 - UPPER only). + +=back + +=head2 Template Files and Blocks + +=over 4 + +=item INCLUDE_PATH + +One or more directories to search for templates. + +=item DELIMITER + +Delimiter for separating paths in INCLUDE_PATH (default: ':'). + +=item ABSOLUTE + +Allow absolute file names, e.g. /foo/bar.html (default: 0). + +=item RELATIVE + +Allow relative filenames, e.g. ../foo/bar.html (default: 0). + +=item DEFAULT + +Default template to use when another not found. + +=item BLOCKS + +Hash array pre-defining template blocks. + +=item AUTO_RESET + +Enabled by default causing BLOCK definitions to be reset each time a +template is processed. Disable to allow BLOCK definitions to persist. + +=item RECURSION + +Flag to permit recursion into templates (default: 0). + +=back + +=head2 Template Variables + +=over 4 + +=item VARIABLES, PRE_DEFINE + +Hash array of variables and values to pre-define in the stash. + +=back + +=head2 Runtime Processing Options + +=over 4 + +=item EVAL_PERL + +Flag to indicate if PERL/RAWPERL blocks should be processed (default: 0). + +=item PRE_PROCESS, POST_PROCESS + +Name of template(s) to process before/after main template. + +=item PROCESS + +Name of template(s) to process instead of main template. + +=item ERROR + +Name of error template or reference to hash array mapping error types to +templates. + +=item OUTPUT + +Default output location or handler. + +=item OUTPUT_PATH + +Directory into which output files can be written. + +=item DEBUG + +Enable debugging messages. + +=back + +=head2 Caching and Compiling Options + +=over 4 + +=item CACHE_SIZE + +Maximum number of compiled templates to cache in memory (default: +undef - cache all) + +=item COMPILE_EXT + +Filename extension for compiled template files (default: undef - don't +compile). + +=item COMPILE_DIR + +Root of directory in which compiled template files should be written +(default: undef - don't compile). + +=back + +=head2 Plugins and Filters + +=over 4 + +=item PLUGINS + +Reference to a hash array mapping plugin names to Perl packages. + +=item PLUGIN_BASE + +One or more base classes under which plugins may be found. + +=item LOAD_PERL + +Flag to indicate regular Perl modules should be loaded if a named plugin +can't be found (default: 0). + +=item FILTERS + +Hash array mapping filter names to filter subroutines or factories. + +=back + +=head2 Compatibility, Customisation and Extension + +=over 4 + +=item V1DOLLAR + +Backwards compatibility flag enabling version 1.* handling (i.e. ignore it) +of leading '$' on variables (default: 0 - '$' indicates interpolation). + +=item LOAD_TEMPLATES + +List of template providers. + +=item LOAD_PLUGINS + +List of plugin providers. + +=item LOAD_FILTERS + +List of filter providers. + +=item TOLERANT + +Set providers to tolerate errors as declinations (default: 0). + +=item SERVICE + +Reference to a custom service object (default: Template::Service). + +=item CONTEXT + +Reference to a custom context object (default: Template::Context). + +=item STASH + +Reference to a custom stash object (default: Template::Stash). + +=item PARSER + +Reference to a custom parser object (default: Template::Parser). + +=item GRAMMAR + +Reference to a custom grammar object (default: Template::Grammar). + +=back + +=head1 DIRECTIVE SUMMARY + +The following list gives a short summary of each Template Toolkit directive. +See L for full details. + +=over 4 + +=item GET + +Evaluate and print a variable or value. + + [% GET variable %] # 'GET' keyword is optional + + [% variable %] + [% hash.key %] + [% list.n %] + [% code(args) %] + [% obj.meth(args) %] + [% "value: $var" %] + +=item CALL + +As per GET but without printing result (e.g. call code) + + [% CALL variable %] + +=item SET + +Assign a values to variables. + + [% SET variable = value %] # 'SET' also optional + + [% variable = other_variable + variable = 'literal text @ $100' + variable = "interpolated text: $var" + list = [ val, val, val, val, ... ] + list = [ val..val ] + hash = { var => val, var => val, ... } + %] + +=item DEFAULT + +Like SET above, but variables are only set if currently unset (i.e. have no +true value). + + [% DEFAULT variable = value %] + +=item INSERT + +Insert a file without any processing performed on the contents. + + [% INSERT legalese.txt %] + +=item INCLUDE + +Process another template file or block and include the output. Variables +are localised. + + [% INCLUDE template %] + [% INCLUDE template var = val, ... %] + +=item PROCESS + +As INCLUDE above, but without localising variables. + + [% PROCESS template %] + [% PROCESS template var = val, ... %] + +=item WRAPPER + +Process the enclosed block WRAPPER ... END block then INCLUDE the +named template, passing the block output in the 'content' variable. + + [% WRAPPER template %] + content... + [% END %] + +=item BLOCK + +Define a named template block for subsequent INCLUDE, PROCESS, etc., + + [% BLOCK template %] + content + [% END %] + +=item FOREACH + +Repeat the enclosed FOREACH ... END block for each value in the list. + + [% FOREACH variable = [ val, val, val ] %] # either + [% FOREACH variable = list %] # or + [% FOREACH list %] # or + content... + [% variable %] + [% END %] + +=item WHILE + +Enclosed WHILE ... END block is processed while condition is true. + + [% WHILE condition %] + content + [% END %] + +=item IF / UNLESS / ELSIF / ELSE + +Enclosed block is processed if the condition is true / false. + + [% IF condition %] + content + [% ELSIF condition %] + content + [% ELSE %] + content + [% END %] + + [% UNLESS condition %] + content + [% # ELSIF/ELSE as per IF, above %] + content + [% END %] + +=item SWITCH / CASE + +Multi-way switch/case statement. + + [% SWITCH variable %] + [% CASE val1 %] + content + [% CASE [ val2, val3 ] %] + content + [% CASE %] # or [% CASE DEFAULT %] + content + [% END %] + +=item MACRO + +Define a named macro. + + [% MACRO name %] + [% MACRO name(arg1, arg2) %] + ... + [% name %] + [% name(val1, val2) %] + +=item FILTER + +Process enclosed FILTER ... END block then pipe through a filter. + + [% FILTER name %] # either + [% FILTER name( params ) %] # or + [% FILTER alias = name( params ) %] # or + content + [% END %] + +=item USE + +Load a "plugin" module, or any regular Perl module if LOAD_PERL option is +set. + + [% USE name %] # either + [% USE name( params ) %] # or + [% USE var = name( params ) %] # or + ... + [% name.method %] + [% var.method %] + +=item PERL / RAWPERL + +Evaluate enclosed blocks as Perl code (requires EVAL_PERL option to be set). + + [% PERL %] + # perl code goes here + $stash->set('foo', 10); + print "set 'foo' to ", $stash->get('foo'), "\n"; + print $context->include('footer', { var => $val }); + [% END %] + + [% RAWPERL %] + # raw perl code goes here, no magic but fast. + $output .= 'some output'; + [% END %] + +=item TRY / THROW / CATCH / FINAL + +Exception handling. + + [% TRY %] + content + [% THROW type info %] + [% CATCH type %] + catch content + [% error.type %] [% error.info %] + [% CATCH %] # or [% CATCH DEFAULT %] + content + [% FINAL %] + this block is always processed + [% END %] + +=item NEXT + +Jump straight to the next item in a FOREACH/WHILE loop. + + [% NEXT %] + +=item LAST + +Break out of FOREACH/WHILE loop. + + [% LAST %] + +=item RETURN + +Stop processing current template and return to including templates. + + [% RETURN %] + +=item STOP + +Stop processing all templates and return to caller. + + [% STOP %] + +=item TAGS + +Define new tag style or characters (default: [% %]). + + [% TAGS html %] + [% TAGS %] + +=item COMMENTS + +Ignored and deleted. + + [% # this is a comment to the end of line + foo = 'bar' + %] + + [%# placing the '#' immediately inside the directive + tag comments out the entire directive + %] + +=back + +=head1 AUTHOR + +Andy Wardley Eabw@andywardley.comE + +L + + + + +=head1 VERSION + +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + diff --git a/lib/Template/Base.pm b/lib/Template/Base.pm new file mode 100644 index 0000000..b66d9c8 --- /dev/null +++ b/lib/Template/Base.pm @@ -0,0 +1,290 @@ +#============================================================= -*-perl-*- +# +# Template::Base +# +# DESCRIPTION +# Base class module implementing common functionality for various other +# Template Toolkit modules. +# +# AUTHOR +# Andy Wardley +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#------------------------------------------------------------------------ +# +# $Id: Base.pm,v 2.62 2003/04/24 09:14:38 abw Exp $ +# +#======================================================================== + +package Template::Base; + +require 5.004; + +use strict; +use vars qw( $VERSION ); +use Template::Constants; + +$VERSION = sprintf("%d.%02d", q$Revision: 2.62 $ =~ /(\d+)\.(\d+)/); + + +#------------------------------------------------------------------------ +# new(\%params) +# +# General purpose constructor method which expects a hash reference of +# configuration parameters, or a list of name => value pairs which are +# folded into a hash. Blesses a hash into an object and calls its +# _init() method, passing the parameter hash reference. Returns a new +# object derived from Template::Base, or undef on error. +#------------------------------------------------------------------------ + +sub new { + my $class = shift; + my ($argnames, @args, $arg, $cfg); +# $class->error(''); # always clear package $ERROR var? + + { no strict qw( refs ); + $argnames = \@{"$class\::BASEARGS"} || [ ]; + } + + # shift off all mandatory args, returning error if undefined or null + foreach $arg (@$argnames) { + return $class->error("no $arg specified") + unless ($cfg = shift); + push(@args, $cfg); + } + + # fold all remaining args into a hash, or use provided hash ref +# local $" = ', '; +# print STDERR "args: [@_]\n"; + $cfg = defined $_[0] && UNIVERSAL::isa($_[0], 'HASH') ? shift : { @_ }; + + my $self = bless { + map { ($_ => shift @args) } @$argnames, + _ERROR => '', + DEBUG => 0, + }, $class; + + return $self->_init($cfg) ? $self : $class->error($self->error); +} + + +#------------------------------------------------------------------------ +# error() +# error($msg, ...) +# +# May be called as a class or object method to set or retrieve the +# package variable $ERROR (class method) or internal member +# $self->{ _ERROR } (object method). The presence of parameters indicates +# that the error value should be set. Undef is then returned. In the +# abscence of parameters, the current error value is returned. +#------------------------------------------------------------------------ + +sub error { + my $self = shift; + my $errvar; + + { + no strict qw( refs ); + $errvar = ref $self ? \$self->{ _ERROR } : \${"$self\::ERROR"}; + } + if (@_) { + $$errvar = ref($_[0]) ? shift : join('', @_); + return undef; + } + else { + return $$errvar; + } +} + + +#------------------------------------------------------------------------ +# _init() +# +# Initialisation method called by the new() constructor and passing a +# reference to a hash array containing any configuration items specified +# as constructor arguments. Should return $self on success or undef on +# error, via a call to the error() method to set the error message. +#------------------------------------------------------------------------ + +sub _init { + my ($self, $config) = @_; + return $self; +} + + +sub DEBUG { + my $self = shift; + print STDERR "DEBUG: ", @_; +} + +sub debug { + my $self = shift; + my $msg = join('', @_); + my ($pkg, $file, $line) = caller(); + + unless ($msg =~ /\n$/) { + $msg .= ($self->{ DEBUG } & Template::Constants::DEBUG_CALLER) + ? " at $file line $line\n" + : "\n"; + } + + print STDERR "[$pkg] $msg"; +} + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Base - Base class module implementing common functionality + +=head1 SYNOPSIS + + package My::Module; + use base qw( Template::Base ); + + sub _init { + my ($self, $config) = @_; + $self->{ doodah } = $config->{ doodah } + || return $self->error("No 'doodah' specified"); + return $self; + } + + package main; + + my $object = My::Module->new({ doodah => 'foobar' }) + || die My::Module->error(); + +=head1 DESCRIPTION + +Base class module which implements a constructor and error reporting +functionality for various Template Toolkit modules. + +=head1 PUBLIC METHODS + +=head2 new(\%config) + +Constructor method which accepts a reference to a hash array or a list +of C value> parameters which are folded into a hash. The +_init() method is then called, passing the configuration hash and should +return true/false to indicate success or failure. A new object reference +is returned, or undef on error. Any error message raised can be examined +via the error() class method or directly via the package variable ERROR +in the derived class. + + my $module = My::Module->new({ ... }) + || die My::Module->error(), "\n"; + + my $module = My::Module->new({ ... }) + || die "constructor error: $My::Module::ERROR\n"; + +=head2 error($msg, ...) + +May be called as an object method to get/set the internal _ERROR member +or as a class method to get/set the $ERROR variable in the derived class's +package. + + my $module = My::Module->new({ ... }) + || die My::Module->error(), "\n"; + + $module->do_something() + || die $module->error(), "\n"; + +When called with parameters (multiple params are concatenated), this +method will set the relevant variable and return undef. This is most +often used within object methods to report errors to the caller. + + package My::Module; + + sub foobar { + my $self = shift; + + # some other code... + + return $self->error('some kind of error...') + if $some_condition; + } + +=head2 debug($msg, ...) + +Generates a debugging message by concatenating all arguments +passed into a string and printing it to STDERR. A prefix is +added to indicate the module of the caller. + + package My::Module; + + sub foobar { + my $self = shift; + + $self->debug('called foobar()'); + + # some other code... + } + +When the foobar() method is called, the following message +is sent to STDERR: + + [My::Module] called foobar() + +Objects can set an internal DEBUG value which the debug() +method will examine. If this value sets the relevant bits +to indicate DEBUG_CALLER then the file and line number of +the caller will be appened to the message. + + use Template::Constants qw( :debug ); + + my $module = My::Module->new({ + DEBUG => DEBUG_SERVICE | DEBUG_CONTEXT | DEBUG_CALLER, + }); + + $module->foobar(); + +This generates an error message such as: + + [My::Module] called foobar() at My/Module.pm line 6 + +=head1 AUTHOR + +Andy Wardley Eabw@andywardley.comE + +L + + + + +=head1 VERSION + +2.62, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L diff --git a/lib/Template/Config.pm b/lib/Template/Config.pm new file mode 100644 index 0000000..dbe3a53 --- /dev/null +++ b/lib/Template/Config.pm @@ -0,0 +1,457 @@ +#============================================================= -*-perl-*- +# +# Template::Config +# +# DESCRIPTION +# Template Toolkit configuration module. +# +# AUTHOR +# Andy Wardley +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#------------------------------------------------------------------------ +# +# $Id: Config.pm,v 2.62 2003/04/24 09:14:38 abw Exp $ +# +#======================================================================== + +package Template::Config; + +require 5.004; + +use strict; +use base qw( Template::Base ); +use vars qw( $VERSION $DEBUG $ERROR $INSTDIR + $PARSER $PROVIDER $PLUGINS $FILTERS $ITERATOR + $LATEX_PATH $PDFLATEX_PATH $DVIPS_PATH + $STASH $SERVICE $CONTEXT $CONSTANTS @PRELOAD ); + +$VERSION = sprintf("%d.%02d", q$Revision: 2.62 $ =~ /(\d+)\.(\d+)/); +$DEBUG = 0 unless defined $DEBUG; +$ERROR = ''; +$CONTEXT = 'Template::Context'; +$FILTERS = 'Template::Filters'; +$ITERATOR = 'Template::Iterator'; +$PARSER = 'Template::Parser'; +$PLUGINS = 'Template::Plugins'; +$PROVIDER = 'Template::Provider'; +$SERVICE = 'Template::Service'; +$STASH = 'Template::Stash'; +$CONSTANTS = 'Template::Namespace::Constants'; + +@PRELOAD = ( $CONTEXT, $FILTERS, $ITERATOR, $PARSER, + $PLUGINS, $PROVIDER, $SERVICE, $STASH ); + +# the following is set at installation time by the Makefile.PL +$INSTDIR = ''; + +# LaTeX executable paths set at installation time by the Makefile.PL +# Empty strings cause the latex(pdf|dvi|ps) filters to throw an error. +$LATEX_PATH = ''; +$PDFLATEX_PATH = ''; +$DVIPS_PATH = ''; + +#======================================================================== +# --- CLASS METHODS --- +#======================================================================== + +#------------------------------------------------------------------------ +# preload($module, $module, ...) +# +# Preloads all the standard TT modules that are likely to be used, along +# with any other passed as arguments. +#------------------------------------------------------------------------ + +sub preload { + my $class = shift; + + foreach my $module (@PRELOAD, @_) { + $class->load($module) || return; + }; + return 1; +} + + +#------------------------------------------------------------------------ +# load($module) +# +# Load a module via require(). Any occurences of '::' in the module name +# are be converted to '/' and '.pm' is appended. Returns 1 on success +# or undef on error. Use $class->error() to examine the error string. +#------------------------------------------------------------------------ + +sub load { + my ($class, $module) = @_; + $module =~ s[::][/]g; + $module .= '.pm'; +# print STDERR "loading $module\n" +# if $DEBUG; + eval { + require $module; + }; + return $@ ? $class->error("failed to load $module: $@") : 1; +} + + +#------------------------------------------------------------------------ +# parser(\%params) +# +# Instantiate a new parser object of the class whose name is denoted by +# the package variable $PARSER (default: Template::Parser). Returns +# a reference to a newly instantiated parser object or undef on error. +# The class error() method can be called without arguments to examine +# the error message generated by this failure. +#------------------------------------------------------------------------ + +sub parser { + my $class = shift; + my $params = defined($_[0]) && UNIVERSAL::isa($_[0], 'HASH') + ? shift : { @_ }; + + return undef unless $class->load($PARSER); + return $PARSER->new($params) + || $class->error("failed to create parser: ", $PARSER->error); +} + + +#------------------------------------------------------------------------ +# provider(\%params) +# +# Instantiate a new template provider object (default: Template::Provider). +# Returns an object reference or undef on error, as above. +#------------------------------------------------------------------------ + +sub provider { + my $class = shift; + my $params = defined($_[0]) && UNIVERSAL::isa($_[0], 'HASH') + ? shift : { @_ }; + + return undef unless $class->load($PROVIDER); + return $PROVIDER->new($params) + || $class->error("failed to create template provider: ", + $PROVIDER->error); +} + + +#------------------------------------------------------------------------ +# plugins(\%params) +# +# Instantiate a new plugins provider object (default: Template::Plugins). +# Returns an object reference or undef on error, as above. +#------------------------------------------------------------------------ + +sub plugins { + my $class = shift; + my $params = defined($_[0]) && UNIVERSAL::isa($_[0], 'HASH') + ? shift : { @_ }; + + return undef unless $class->load($PLUGINS); + return $PLUGINS->new($params) + || $class->error("failed to create plugin provider: ", + $PLUGINS->error); +} + + +#------------------------------------------------------------------------ +# filters(\%params) +# +# Instantiate a new filters provider object (default: Template::Filters). +# Returns an object reference or undef on error, as above. +#------------------------------------------------------------------------ + +sub filters { + my $class = shift; + my $params = defined($_[0]) && UNIVERSAL::isa($_[0], 'HASH') + ? shift : { @_ }; + + return undef unless $class->load($FILTERS); + return $FILTERS->new($params) + || $class->error("failed to create filter provider: ", + $FILTERS->error); +} + + +#------------------------------------------------------------------------ +# iterator(\@list) +# +# Instantiate a new Template::Iterator object (default: Template::Iterator). +# Returns an object reference or undef on error, as above. +#------------------------------------------------------------------------ + +sub iterator { + my $class = shift; + my $list = shift; + + return undef unless $class->load($ITERATOR); + return $ITERATOR->new($list, @_) + || $class->error("failed to create iterator: ", $ITERATOR->error); +} + + +#------------------------------------------------------------------------ +# stash(\%vars) +# +# Instantiate a new template variable stash object (default: +# Template::Stash). Returns object or undef, as above. +#------------------------------------------------------------------------ + +sub stash { + my $class = shift; + my $params = defined($_[0]) && UNIVERSAL::isa($_[0], 'HASH') + ? shift : { @_ }; + + return undef unless $class->load($STASH); + return $STASH->new($params) + || $class->error("failed to create stash: ", $STASH->error); +} + + +#------------------------------------------------------------------------ +# context(\%params) +# +# Instantiate a new template context object (default: Template::Context). +# Returns object or undef, as above. +#------------------------------------------------------------------------ + +sub context { + my $class = shift; + my $params = defined($_[0]) && UNIVERSAL::isa($_[0], 'HASH') + ? shift : { @_ }; + + return undef unless $class->load($CONTEXT); + return $CONTEXT->new($params) + || $class->error("failed to create context: ", $CONTEXT->error); +} + + +#------------------------------------------------------------------------ +# service(\%params) +# +# Instantiate a new template context object (default: Template::Service). +# Returns object or undef, as above. +#------------------------------------------------------------------------ + +sub service { + my $class = shift; + my $params = defined($_[0]) && UNIVERSAL::isa($_[0], 'HASH') + ? shift : { @_ }; + + return undef unless $class->load($SERVICE); + return $SERVICE->new($params) + || $class->error("failed to create context: ", $SERVICE->error); +} + + +#------------------------------------------------------------------------ +# constants(\%params) +# +# Instantiate a new namespace handler for compile time constant folding +# (default: Template::Namespace::Constants). +# Returns object or undef, as above. +#------------------------------------------------------------------------ + +sub constants { + my $class = shift; + my $params = defined($_[0]) && UNIVERSAL::isa($_[0], 'HASH') + ? shift : { @_ }; + + return undef unless $class->load($CONSTANTS); + return $CONSTANTS->new($params) + || $class->error("failed to create constants namespace: ", + $CONSTANTS->error); +} + + +#------------------------------------------------------------------------ +# instdir($dir) +# +# Returns the root installation directory appended with any local +# component directory passed as an argument. +#------------------------------------------------------------------------ + +sub instdir { + my ($class, $dir) = @_; + my $inst = $INSTDIR + || return $class->error("no installation directory"); + $inst =~ s[/$][]g; + $inst .= "/$dir" if $dir; + return $inst; +} + +#------------------------------------------------------------------------ +# latexpaths() +# +# Returns a reference to a three element array: +# [latex_path, pdf2latex_path, dvips_path] +# These values are determined by Makefile.PL at installation time +# and are used by the latex(pdf|dvi|ps) filters. +#------------------------------------------------------------------------ + +sub latexpaths { + return [$LATEX_PATH, $PDFLATEX_PATH, $DVIPS_PATH]; +} + +#======================================================================== +# This should probably be moved somewhere else in the long term, but for +# now it ensures that Template::TieString is available even if the +# Template::Directive module hasn't been loaded, as is the case when +# using compiled templates and Template::Parser hasn't yet been loaded +# on demand. +#======================================================================== + +#------------------------------------------------------------------------ +# simple package for tying $output variable to STDOUT, used by perl() +#------------------------------------------------------------------------ + +package Template::TieString; + +sub TIEHANDLE { + my ($class, $textref) = @_; + bless $textref, $class; +} +sub PRINT { + my $self = shift; + $$self .= join('', @_); +} + + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Config - Factory module for instantiating other TT2 modules + +=head1 SYNOPSIS + + use Template::Config; + +=head1 DESCRIPTION + +This module implements various methods for loading and instantiating +other modules that comprise the Template Toolkit. It provides a consistent +way to create toolkit components and allows custom modules to be used in +place of the regular ones. + +Package variables such as $STASH, $SERVICE, $CONTEXT, etc., contain +the default module/package name for each component (Template::Stash, +Template::Service and Template::Context, respectively) and are used by +the various factory methods (stash(), service() and context()) to load +the appropriate module. Changing these package variables will cause +subsequent calls to the relevant factory method to load and instantiate +an object from the new class. + +=head1 PUBLIC METHODS + +=head2 load($module) + +Load a module via require(). Any occurences of '::' in the module name +are be converted to '/' and '.pm' is appended. Returns 1 on success +or undef on error. Use $class-Eerror() to examine the error string. + +=head2 preload() + +This method preloads all the other Template::* modules that are likely +to be used. It is called by the Template module when running under +mod_perl ($ENV{MOD_PERL} is set). + +=head2 parser(\%config) + +Instantiate a new parser object of the class whose name is denoted by +the package variable $PARSER (default: Template::Parser). Returns +a reference to a newly instantiated parser object or undef on error. + +=head2 provider(\%config) + +Instantiate a new template provider object (default: Template::Provider). +Returns an object reference or undef on error, as above. + +=head2 plugins(\%config) + +Instantiate a new plugins provider object (default: Template::Plugins). +Returns an object reference or undef on error, as above. + +=head2 filters(\%config) + +Instantiate a new filter provider object (default: Template::Filters). +Returns an object reference or undef on error, as above. + +=head2 stash(\%vars) + +Instantiate a new stash object (Template::Stash or Template::Stash::XS +depending on the default set at installation time) using the contents +of the optional hash array passed by parameter as initial variable +definitions. Returns an object reference or undef on error, as above. + +=head2 context(\%config) + +Instantiate a new template context object (default: Template::Context). +Returns an object reference or undef on error, as above. + +=head2 service(\%config) + +Instantiate a new template service object (default: Template::Service). +Returns an object reference or undef on error, as above. + +=head2 instdir($dir) + +Returns the root directory of the Template Toolkit installation under +which optional components are installed. Any relative directory specified +as an argument will be appended to the returned directory. + + # e.g. returns '/usr/local/tt2' + my $ttroot = Template::Config->instdir() + || die "$Template::Config::ERROR\n"; + + # e.g. returns '/usr/local/tt2/templates' + my $template = Template::Config->instdir('templates') + || die "$Template::Config::ERROR\n"; + +Returns undef and sets $Template::Config::ERROR appropriately if the +optional components of the Template Toolkit have not been installed. + +=head1 AUTHOR + +Andy Wardley Eabw@andywardley.comE + +L + + + + +=head1 VERSION + +2.62, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L diff --git a/lib/Template/Constants.pm b/lib/Template/Constants.pm new file mode 100644 index 0000000..60af6bb --- /dev/null +++ b/lib/Template/Constants.pm @@ -0,0 +1,277 @@ +#============================================================= -*-Perl-*- +# +# Template::Constants.pm +# +# DESCRIPTION +# Definition of constants for the Template Toolkit. +# +# AUTHOR +# Andy Wardley +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#---------------------------------------------------------------------------- +# +# $Id: Constants.pm,v 2.62 2003/04/24 09:14:38 abw Exp $ +# +#============================================================================ + +package Template::Constants; + +require 5.004; +require Exporter; + +use strict; +use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS ); +use vars qw( $DEBUG_OPTIONS @STATUS @ERROR @CHOMP @DEBUG); + +@ISA = qw( Exporter ); +$VERSION = sprintf("%d.%02d", q$Revision: 2.62 $ =~ /(\d+)\.(\d+)/); + + +#======================================================================== +# ----- EXPORTER ----- +#======================================================================== + +# STATUS constants returned by directives +use constant STATUS_OK => 0; # ok +use constant STATUS_RETURN => 1; # ok, block ended by RETURN +use constant STATUS_STOP => 2; # ok, stoppped by STOP +use constant STATUS_DONE => 3; # ok, iterator done +use constant STATUS_DECLINED => 4; # ok, declined to service request +use constant STATUS_ERROR => 255; # error condition + +# ERROR constants for indicating exception types +use constant ERROR_RETURN => 'return'; # return a status code +use constant ERROR_FILE => 'file'; # file error: I/O, parse, recursion +use constant ERROR_VIEW => 'view'; # view error +use constant ERROR_UNDEF => 'undef'; # undefined variable value used +use constant ERROR_PERL => 'perl'; # error in [% PERL %] block +use constant ERROR_FILTER => 'filter'; # filter error +use constant ERROR_PLUGIN => 'plugin'; # plugin error + +# CHOMP constants for PRE_CHOMP and POST_CHOMP +use constant CHOMP_NONE => 0; # do not remove whitespace +use constant CHOMP_ALL => 1; # remove whitespace +use constant CHOMP_COLLAPSE => 2; # collapse whitespace to a single space + +# DEBUG constants to enable various debugging options +use constant DEBUG_OFF => 0; # do nothing +use constant DEBUG_ON => 1; # basic debugging flag +use constant DEBUG_UNDEF => 2; # throw undef on undefined variables +use constant DEBUG_VARS => 4; # general variable debugging +use constant DEBUG_DIRS => 8; # directive debugging +use constant DEBUG_STASH => 16; # general stash debugging +use constant DEBUG_CONTEXT => 32; # context debugging +use constant DEBUG_PARSER => 64; # parser debugging +use constant DEBUG_PROVIDER => 128; # provider debugging +use constant DEBUG_PLUGINS => 256; # plugins debugging +use constant DEBUG_FILTERS => 512; # filters debugging +use constant DEBUG_SERVICE => 1024; # context debugging +use constant DEBUG_ALL => 2047; # everything + +# extra debugging flags +use constant DEBUG_CALLER => 4096; # add caller file/line +use constant DEBUG_FLAGS => 4096; # bitmask to extraxt flags + +$DEBUG_OPTIONS = { + &DEBUG_OFF => off => off => &DEBUG_OFF, + &DEBUG_ON => on => on => &DEBUG_ON, + &DEBUG_UNDEF => undef => undef => &DEBUG_UNDEF, + &DEBUG_VARS => vars => vars => &DEBUG_VARS, + &DEBUG_DIRS => dirs => dirs => &DEBUG_DIRS, + &DEBUG_STASH => stash => stash => &DEBUG_STASH, + &DEBUG_CONTEXT => context => context => &DEBUG_CONTEXT, + &DEBUG_PARSER => parser => parser => &DEBUG_PARSER, + &DEBUG_PROVIDER => provider => provider => &DEBUG_PROVIDER, + &DEBUG_PLUGINS => plugins => plugins => &DEBUG_PLUGINS, + &DEBUG_FILTERS => filters => filters => &DEBUG_FILTERS, + &DEBUG_SERVICE => service => service => &DEBUG_SERVICE, + &DEBUG_ALL => all => all => &DEBUG_ALL, + &DEBUG_CALLER => caller => caller => &DEBUG_CALLER, +}; + +@STATUS = qw( STATUS_OK STATUS_RETURN STATUS_STOP STATUS_DONE + STATUS_DECLINED STATUS_ERROR ); +@ERROR = qw( ERROR_FILE ERROR_VIEW ERROR_UNDEF ERROR_PERL + ERROR_RETURN ERROR_FILTER ERROR_PLUGIN ); +@CHOMP = qw( CHOMP_NONE CHOMP_ALL CHOMP_COLLAPSE ); +@DEBUG = qw( DEBUG_OFF DEBUG_ON DEBUG_UNDEF DEBUG_VARS + DEBUG_DIRS DEBUG_STASH DEBUG_CONTEXT DEBUG_PARSER + DEBUG_PROVIDER DEBUG_PLUGINS DEBUG_FILTERS DEBUG_SERVICE + DEBUG_ALL DEBUG_CALLER DEBUG_FLAGS ); + +@EXPORT_OK = ( @STATUS, @ERROR, @CHOMP, @DEBUG ); +%EXPORT_TAGS = ( + 'all' => [ @EXPORT_OK ], + 'status' => [ @STATUS ], + 'error' => [ @ERROR ], + 'chomp' => [ @CHOMP ], + 'debug' => [ @DEBUG ], +); + + +sub debug_flags { + my ($self, $debug) = @_; + my (@flags, $flag, $value); + $debug = $self unless defined($debug) || ref($self); + + if ($debug =~ /^\d+$/) { + foreach $flag (@DEBUG) { + next if $flag =~ /^DEBUG_(OFF|ALL|FLAGS)$/; + + # don't trash the original + my $copy = $flag; + $flag =~ s/^DEBUG_//; + $flag = lc $flag; + return $self->error("no value for flag: $flag") + unless defined($value = $DEBUG_OPTIONS->{ $flag }); + $flag = $value; + + if ($debug & $flag) { + $value = $DEBUG_OPTIONS->{ $flag }; + return $self->error("no value for flag: $flag") unless defined $value; + push(@flags, $value); + } + } + return wantarray ? @flags : join(', ', @flags); + } + else { + @flags = split(/\W+/, $debug); + $debug = 0; + foreach $flag (@flags) { + $value = $DEBUG_OPTIONS->{ $flag }; + return $self->error("unknown debug flag: $flag") unless defined $value; + $debug |= $value; + } + return $debug; + } +} + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Constants - Defines constants for the Template Toolkit + +=head1 SYNOPSIS + + use Template::Constants qw( :status :error :all ); + +=head1 DESCRIPTION + +The Template::Constants modules defines, and optionally exports into the +caller's namespace, a number of constants used by the Template package. + +Constants may be used by specifying the Template::Constants package +explicitly: + + use Template::Constants; + + print Template::Constants::STATUS_DECLINED; + +Constants may be imported into the caller's namespace by naming them as +options to the C statement: + + use Template::Constants qw( STATUS_DECLINED ); + + print STATUS_DECLINED; + +Alternatively, one of the following tagset identifiers may be specified +to import sets of constants; :status, :error, :all. + + use Template::Constants qw( :status ); + + print STATUS_DECLINED; + +See L for more information on exporting variables. + +=head1 EXPORTABLE TAG SETS + +The following tag sets and associated constants are defined: + + :status + STATUS_OK # no problem, continue + STATUS_RETURN # ended current block then continue (ok) + STATUS_STOP # controlled stop (ok) + STATUS_DONE # iterator is all done (ok) + STATUS_DECLINED # provider declined to service request (ok) + STATUS_ERROR # general error condition (not ok) + + :error + ERROR_RETURN # return a status code (e.g. 'stop') + ERROR_FILE # file error: I/O, parse, recursion + ERROR_UNDEF # undefined variable value used + ERROR_PERL # error in [% PERL %] block + ERROR_FILTER # filter error + ERROR_PLUGIN # plugin error + + :chomp # for PRE_CHOMP and POST_CHOMP + CHOMP_NONE # do not remove whitespace + CHOMP_ALL # remove whitespace + CHOMP_COLLAPSE # collapse whitespace to a single space + + :debug + DEBUG_OFF # do nothing + DEBUG_ON # basic debugging flag + DEBUG_UNDEF # throw undef on undefined variables + DEBUG_VARS # general variable debugging + DEBUG_DIRS # directive debugging + DEBUG_STASH # general stash debugging + DEBUG_CONTEXT # context debugging + DEBUG_PARSER # parser debugging + DEBUG_PROVIDER # provider debugging + DEBUG_PLUGINS # plugins debugging + DEBUG_FILTERS # filters debugging + DEBUG_SERVICE # context debugging + DEBUG_ALL # everything + DEBUG_CALLER # add caller file/line info + DEBUG_FLAGS # bitmap used internally + + :all All the above constants. + +=head1 AUTHOR + +Andy Wardley Eabw@andywardley.comE + +L + + + + +=head1 VERSION + +2.62, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L, L diff --git a/lib/Template/Context.pm b/lib/Template/Context.pm new file mode 100644 index 0000000..6fb29ca --- /dev/null +++ b/lib/Template/Context.pm @@ -0,0 +1,1549 @@ +#============================================================= -*-Perl-*- +# +# Template::Context +# +# DESCRIPTION +# Module defining a context in which a template document is processed. +# This is the runtime processing interface through which templates +# can access the functionality of the Template Toolkit. +# +# AUTHOR +# Andy Wardley +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +# REVISION +# $Id: Context.pm,v 2.81 2003/07/24 11:32:35 abw Exp $ +# +#============================================================================ + +package Template::Context; + +require 5.004; + +use strict; +use vars qw( $VERSION $DEBUG $AUTOLOAD $DEBUG_FORMAT ); +use base qw( Template::Base ); + +use Template::Base; +use Template::Config; +use Template::Constants; +use Template::Exception; + +$VERSION = sprintf("%d.%02d", q$Revision: 2.81 $ =~ /(\d+)\.(\d+)/); +$DEBUG_FORMAT = "\n## \$file line \$line : [% \$text %] ##\n"; + + +#======================================================================== +# ----- PUBLIC METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# template($name) +# +# General purpose method to fetch a template and return it in compiled +# form. In the usual case, the $name parameter will be a simple string +# containing the name of a template (e.g. 'header'). It may also be +# a reference to Template::Document object (or sub-class) or a Perl +# sub-routine. These are considered to be compiled templates and are +# returned intact. Finally, it may be a reference to any other kind +# of valid input source accepted by Template::Provider (e.g. scalar +# ref, glob, IO handle, etc). +# +# Templates may be cached at one of 3 different levels. The internal +# BLOCKS member is a local cache which holds references to all +# template blocks used or imported via PROCESS since the context's +# reset() method was last called. This is checked first and if the +# template is not found, the method then walks down the BLOCKSTACK +# list. This contains references to the block definition tables in +# any enclosing Template::Documents that we're visiting (e.g. we've +# been called via an INCLUDE and we want to access a BLOCK defined in +# the template that INCLUDE'd us). If nothing is defined, then we +# iterate through the LOAD_TEMPLATES providers list as a 'chain of +# responsibility' (see Design Patterns) asking each object to fetch() +# the template if it can. +# +# Returns the compiled template. On error, undef is returned and +# the internal ERROR value (read via error()) is set to contain an +# error message of the form "$name: $error". +#------------------------------------------------------------------------ + +sub template { + my ($self, $name) = @_; + my ($prefix, $blocks, $defblocks, $provider, $template, $error); + my ($shortname, $blockname, $providers); + + $self->debug("template($name)") if $self->{ DEBUG }; + + # references to Template::Document (or sub-class) objects objects, or + # CODE references are assumed to be pre-compiled templates and are + # returned intact + return $name + if UNIVERSAL::isa($name, 'Template::Document') + || ref($name) eq 'CODE'; + + $shortname = $name; + + unless (ref $name) { + + $self->debug("looking for block [$name]") if $self->{ DEBUG }; + + # we first look in the BLOCKS hash for a BLOCK that may have + # been imported from a template (via PROCESS) + return $template + if ($template = $self->{ BLOCKS }->{ $name }); + + # then we iterate through the BLKSTACK list to see if any of the + # Template::Documents we're visiting define this BLOCK + foreach $blocks (@{ $self->{ BLKSTACK } }) { + return $template + if $blocks && ($template = $blocks->{ $name }); + } + + # now it's time to ask the providers, so we look to see if any + # prefix is specified to indicate the desired provider set. + if ($^O eq 'MSWin32') { + # let C:/foo through + $prefix = $1 if $shortname =~ s/^(\w{2,})://o; + } + else { + $prefix = $1 if $shortname =~ s/^(\w+)://; + } + + if (defined $prefix) { + $providers = $self->{ PREFIX_MAP }->{ $prefix } + || return $self->throw(Template::Constants::ERROR_FILE, + "no providers for template prefix '$prefix'"); + } + } + $providers = $self->{ PREFIX_MAP }->{ default } + || $self->{ LOAD_TEMPLATES } + unless $providers; + + + # Finally we try the regular template providers which will + # handle references to files, text, etc., as well as templates + # reference by name. If + + $blockname = ''; + while ($shortname) { + $self->debug("asking providers for [$shortname] [$blockname]") + if $self->{ DEBUG }; + + foreach my $provider (@$providers) { + ($template, $error) = $provider->fetch($shortname, $prefix); + if ($error) { + if ($error == Template::Constants::STATUS_ERROR) { + # $template contains exception object + if (UNIVERSAL::isa($template, 'Template::Exception') + && $template->type() eq Template::Constants::ERROR_FILE) { + $self->throw($template); + } + else { + $self->throw( Template::Constants::ERROR_FILE, $template ); + } + } + # DECLINE is ok, carry on + } + elsif (length $blockname) { + return $template + if $template = $template->blocks->{ $blockname }; + } + else { + return $template; + } + } + + last if ref $shortname || ! $self->{ EXPOSE_BLOCKS }; + $shortname =~ s{/([^/]+)$}{} || last; + $blockname = length $blockname ? "$1/$blockname" : $1; + } + + $self->throw(Template::Constants::ERROR_FILE, "$name: not found"); +} + + +#------------------------------------------------------------------------ +# plugin($name, \@args) +# +# Calls on each of the LOAD_PLUGINS providers in turn to fetch() (i.e. load +# and instantiate) a plugin of the specified name. Additional parameters +# passed are propagated to the new() constructor for the plugin. +# Returns a reference to a new plugin object or other reference. On +# error, undef is returned and the appropriate error message is set for +# subsequent retrieval via error(). +#------------------------------------------------------------------------ + +sub plugin { + my ($self, $name, $args) = @_; + my ($provider, $plugin, $error); + + $self->debug("plugin($name, ", defined $args ? @$args : '[ ]', ')') + if $self->{ DEBUG }; + + # request the named plugin from each of the LOAD_PLUGINS providers in turn + foreach my $provider (@{ $self->{ LOAD_PLUGINS } }) { + ($plugin, $error) = $provider->fetch($name, $args, $self); + return $plugin unless $error; + if ($error == Template::Constants::STATUS_ERROR) { + $self->throw($plugin) if ref $plugin; + $self->throw(Template::Constants::ERROR_PLUGIN, $plugin); + } + } + + $self->throw(Template::Constants::ERROR_PLUGIN, "$name: plugin not found"); +} + + +#------------------------------------------------------------------------ +# filter($name, \@args, $alias) +# +# Similar to plugin() above, but querying the LOAD_FILTERS providers to +# return filter instances. An alias may be provided which is used to +# save the returned filter in a local cache. +#------------------------------------------------------------------------ + +sub filter { + my ($self, $name, $args, $alias) = @_; + my ($provider, $filter, $error); + + $self->debug("filter($name, ", + defined $args ? @$args : '[ ]', + defined $alias ? $alias : '', ')') + if $self->{ DEBUG }; + + # use any cached version of the filter if no params provided + return $filter + if ! $args && ! ref $name + && ($filter = $self->{ FILTER_CACHE }->{ $name }); + + # request the named filter from each of the FILTERS providers in turn + foreach my $provider (@{ $self->{ LOAD_FILTERS } }) { + ($filter, $error) = $provider->fetch($name, $args, $self); + last unless $error; + if ($error == Template::Constants::STATUS_ERROR) { + $self->throw($filter) if ref $filter; + $self->throw(Template::Constants::ERROR_FILTER, $filter); + } + # return $self->error($filter) + # if $error == &Template::Constants::STATUS_ERROR; + } + + return $self->error("$name: filter not found") + unless $filter; + + # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + # commented out by abw on 19 Nov 2001 to fix problem with xmlstyle + # plugin which may re-define a filter by calling define_filter() + # multiple times. With the automatic aliasing/caching below, any + # new filter definition isn't seen. Don't think this will cause + # any problems as filters explicitly supplied with aliases will + # still work as expected. + # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + # alias defaults to name if undefined + # $alias = $name + # unless defined($alias) or ref($name) or $args; + + # cache FILTER if alias is valid + $self->{ FILTER_CACHE }->{ $alias } = $filter + if $alias; + + return $filter; +} + + +#------------------------------------------------------------------------ +# view(\%config) +# +# Create a new Template::View bound to this context. +#------------------------------------------------------------------------ + +sub view { + my $self = shift; + require Template::View; + return Template::View->new($self, @_) + || $self->throw(&Template::Constants::ERROR_VIEW, + $Template::View::ERROR); +} + + +#------------------------------------------------------------------------ +# process($template, \%params) [% PROCESS template var=val ... %] +# process($template, \%params, $local) [% INCLUDE template var=val ... %] +# +# Processes the template named or referenced by the first parameter. +# The optional second parameter may reference a hash array of variable +# definitions. These are set before the template is processed by +# calling update() on the stash. Note that, unless the third parameter +# is true, the context is not localised and these, and any other +# variables set in the template will retain their new values after this +# method returns. The third parameter is in place so that this method +# can handle INCLUDE calls: the stash will be localized. +# +# Returns the output of processing the template. Errors are thrown +# as Template::Exception objects via die(). +#------------------------------------------------------------------------ + +sub process { + my ($self, $template, $params, $localize) = @_; + my ($trim, $blocks) = @$self{ qw( TRIM BLOCKS ) }; + my (@compiled, $name, $compiled); + my ($stash, $tblocks, $error, $tmpout); + my $output = ''; + + $template = [ $template ] unless ref $template eq 'ARRAY'; + + $self->debug("process([ ", join(', '), @$template, ' ], ', + defined $params ? $params : '', ', ', + $localize ? '' : '', ')') + if $self->{ DEBUG }; + + # fetch compiled template for each name specified + foreach $name (@$template) { + push(@compiled, $self->template($name)); + } + + if ($localize) { + # localise the variable stash with any parameters passed + $stash = $self->{ STASH } = $self->{ STASH }->clone($params); + } else { + # update stash with any new parameters passed + $self->{ STASH }->update($params); + $stash = $self->{ STASH }; + } + + eval { + foreach $name (@$template) { + $compiled = shift @compiled; + my $element = ref $compiled eq 'CODE' + ? { (name => (ref $name ? '' : $name), modtime => time()) } + : $compiled; + $stash->set('component', $element); + + unless ($localize) { + # merge any local blocks defined in the Template::Document + # into our local BLOCKS cache + @$blocks{ keys %$tblocks } = values %$tblocks + if UNIVERSAL::isa($compiled, 'Template::Document') + && ($tblocks = $compiled->blocks()); + } + + if (ref $compiled eq 'CODE') { + $tmpout = &$compiled($self); + } + elsif (ref $compiled) { + $tmpout = $compiled->process($self); + } + else { + $self->throw('file', + "invalid template reference: $compiled"); + } + + if ($trim) { + for ($tmpout) { + s/^\s+//; + s/\s+$//; + } + } + $output .= $tmpout; + } + }; + $error = $@; + + if ($localize) { + # ensure stash is delocalised before dying + $self->{ STASH } = $self->{ STASH }->declone(); + } + + $self->throw(ref $error + ? $error : (Template::Constants::ERROR_FILE, $error)) + if $error; + + return $output; +} + + +#------------------------------------------------------------------------ +# include($template, \%params) [% INCLUDE template var = val, ... %] +# +# Similar to process() above but processing the template in a local +# context. Any variables passed by reference to a hash as the second +# parameter will be set before the template is processed and then +# revert to their original values before the method returns. Similarly, +# any changes made to non-global variables within the template will +# persist only until the template is processed. +# +# Returns the output of processing the template. Errors are thrown +# as Template::Exception objects via die(). +#------------------------------------------------------------------------ + +sub include { + my ($self, $template, $params) = @_; + return $self->process($template, $params, 'localize me!'); +} + +#------------------------------------------------------------------------ +# insert($file) +# +# Insert the contents of a file without parsing. +#------------------------------------------------------------------------ + +sub insert { + my ($self, $file) = @_; + my ($prefix, $providers, $text, $error); + my $output = ''; + + my $files = ref $file eq 'ARRAY' ? $file : [ $file ]; + + $self->debug("insert([ ", join(', '), @$files, " ])") + if $self->{ DEBUG }; + + + FILE: foreach $file (@$files) { + my $name = $file; + + if ($^O eq 'MSWin32') { + # let C:/foo through + $prefix = $1 if $name =~ s/^(\w{2,})://o; + } + else { + $prefix = $1 if $name =~ s/^(\w+)://; + } + + if (defined $prefix) { + $providers = $self->{ PREFIX_MAP }->{ $prefix } + || return $self->throw(Template::Constants::ERROR_FILE, + "no providers for file prefix '$prefix'"); + } + else { + $providers = $self->{ PREFIX_MAP }->{ default } + || $self->{ LOAD_TEMPLATES }; + } + + foreach my $provider (@$providers) { + ($text, $error) = $provider->load($name, $prefix); + next FILE unless $error; + if ($error == Template::Constants::STATUS_ERROR) { + $self->throw($text) if ref $text; + $self->throw(Template::Constants::ERROR_FILE, $text); + } + } + $self->throw(Template::Constants::ERROR_FILE, "$file: not found"); + } + continue { + $output .= $text; + } + return $output; +} + + +#------------------------------------------------------------------------ +# throw($type, $info, \$output) [% THROW errtype "Error info" %] +# +# Throws a Template::Exception object by calling die(). This method +# may be passed a reference to an existing Template::Exception object; +# a single value containing an error message which is used to +# instantiate a Template::Exception of type 'undef'; or a pair of +# values representing the exception type and info from which a +# Template::Exception object is instantiated. e.g. +# +# $context->throw($exception); +# $context->throw("I'm sorry Dave, I can't do that"); +# $context->throw('denied', "I'm sorry Dave, I can't do that"); +# +# An optional third parameter can be supplied in the last case which +# is a reference to the current output buffer containing the results +# of processing the template up to the point at which the exception +# was thrown. The RETURN and STOP directives, for example, use this +# to propagate output back to the user, but it can safely be ignored +# in most cases. +# +# This method rides on a one-way ticket to die() oblivion. It does not +# return in any real sense of the word, but should get caught by a +# surrounding eval { } block (e.g. a BLOCK or TRY) and handled +# accordingly, or returned to the caller as an uncaught exception. +#------------------------------------------------------------------------ + +sub throw { + my ($self, $error, $info, $output) = @_; + local $" = ', '; + + # die! die! die! + if (UNIVERSAL::isa($error, 'Template::Exception')) { + die $error; + } + elsif (defined $info) { + die (Template::Exception->new($error, $info, $output)); + } + else { + $error ||= ''; + die (Template::Exception->new('undef', $error, $output)); + } + + # not reached +} + + +#------------------------------------------------------------------------ +# catch($error, \$output) +# +# Called by various directives after catching an error thrown via die() +# from within an eval { } block. The first parameter contains the errror +# which may be a sanitized reference to a Template::Exception object +# (such as that raised by the throw() method above, a plugin object, +# and so on) or an error message thrown via die from somewhere in user +# code. The latter are coerced into 'undef' Template::Exception objects. +# Like throw() above, a reference to a scalar may be passed as an +# additional parameter to represent the current output buffer +# localised within the eval block. As exceptions are thrown upwards +# and outwards from nested blocks, the catch() method reconstructs the +# correct output buffer from these fragments, storing it in the +# exception object for passing further onwards and upwards. +# +# Returns a reference to a Template::Exception object.. +#------------------------------------------------------------------------ + +sub catch { + my ($self, $error, $output) = @_; + + if (UNIVERSAL::isa($error, 'Template::Exception')) { + $error->text($output) if $output; + return $error; + } + else { + return Template::Exception->new('undef', $error, $output); + } +} + + +#------------------------------------------------------------------------ +# localise(\%params) +# delocalise() +# +# The localise() method creates a local copy of the current stash, +# allowing the existing state of variables to be saved and later +# restored via delocalise(). +# +# A reference to a hash array may be passed containing local variable +# definitions which should be added to the cloned namespace. These +# values persist until delocalisation. +#------------------------------------------------------------------------ + +sub localise { + my $self = shift; + $self->{ STASH } = $self->{ STASH }->clone(@_); +} + +sub delocalise { + my $self = shift; + $self->{ STASH } = $self->{ STASH }->declone(); +} + + +#------------------------------------------------------------------------ +# visit($blocks) +# +# Each Template::Document calls the visit() method on the context +# before processing itself. It passes a reference to the hash array +# of named BLOCKs defined within the document, allowing them to be +# added to the internal BLKSTACK list which is subsequently used by +# template() to resolve templates. +# from a provider. +#------------------------------------------------------------------------ + +sub visit { + my ($self, $blocks) = @_; + unshift(@{ $self->{ BLKSTACK } }, $blocks) +} + + +#------------------------------------------------------------------------ +# leave() +# +# The leave() method is called when the document has finished +# processing itself. This removes the entry from the BLKSTACK list +# that was added visit() above. For persistance of BLOCK definitions, +# the process() method (i.e. the PROCESS directive) does some extra +# magic to copy BLOCKs into a shared hash. +#------------------------------------------------------------------------ + +sub leave { + my $self = shift; + shift(@{ $self->{ BLKSTACK } }); +} + + +#------------------------------------------------------------------------ +# define_block($name, $block) +# +# Adds a new BLOCK definition to the local BLOCKS cache. $block may +# be specified as a reference to a sub-routine or Template::Document +# object or as text which is compiled into a template. Returns a true +# value (the $block reference or compiled block reference) if +# succesful or undef on failure. Call error() to retrieve the +# relevent error message (i.e. compilation failure). +#------------------------------------------------------------------------ + +sub define_block { + my ($self, $name, $block) = @_; + $block = $self->template(\$block) + || return undef + unless ref $block; + $self->{ BLOCKS }->{ $name } = $block; +} + + +#------------------------------------------------------------------------ +# define_filter($name, $filter, $is_dynamic) +# +# Adds a new FILTER definition to the local FILTER_CACHE. +#------------------------------------------------------------------------ + +sub define_filter { + my ($self, $name, $filter, $is_dynamic) = @_; + my ($result, $error); + $filter = [ $filter, 1 ] if $is_dynamic; + + foreach my $provider (@{ $self->{ LOAD_FILTERS } }) { + ($result, $error) = $provider->store($name, $filter); + return 1 unless $error; + $self->throw(&Template::Constants::ERROR_FILTER, $result) + if $error == &Template::Constants::STATUS_ERROR; + } + $self->throw(&Template::Constants::ERROR_FILTER, + "FILTER providers declined to store filter $name"); +} + + +#------------------------------------------------------------------------ +# reset() +# +# Reset the state of the internal BLOCKS hash to clear any BLOCK +# definitions imported via the PROCESS directive. Any original +# BLOCKS definitions passed to the constructor will be restored. +#------------------------------------------------------------------------ + +sub reset { + my ($self, $blocks) = @_; + $self->{ BLKSTACK } = [ ]; + $self->{ BLOCKS } = { %{ $self->{ INIT_BLOCKS } } }; +} + + +#------------------------------------------------------------------------ +# stash() +# +# Simple accessor methods to return the STASH values. This is likely +# to be called quite often so we provide a direct method rather than +# relying on the slower AUTOLOAD. +#------------------------------------------------------------------------ + +sub stash { + return $_[0]->{ STASH }; +} + + +#------------------------------------------------------------------------ +# define_vmethod($type, $name, \&sub) +# +# Passes $type, $name, and &sub on to stash->define_vmethod(). +#------------------------------------------------------------------------ +sub define_vmethod { + my $self = shift; + $self->stash->define_vmethod(@_); +} + + +#------------------------------------------------------------------------ +# debugging($command, @args, \%params) +# +# Method for controlling the debugging status of the context. The first +# argument can be 'on' or 'off' to enable/disable debugging, 'format' +# to define the format of the debug message, or 'msg' to generate a +# debugging message reporting the file, line, message text, etc., +# according to the current debug format. +#------------------------------------------------------------------------ + +sub debugging { + my $self = shift; + my $hash = ref $_[-1] eq 'HASH' ? pop : { }; + my @args = @_; + +# print "*** debug(@args)\n"; + if (@args) { + if ($args[0] =~ /^on|1$/i) { + $self->{ DEBUG_DIRS } = 1; + shift(@args); + } + elsif ($args[0] =~ /^off|0$/i) { + $self->{ DEBUG_DIRS } = 0; + shift(@args); + } + } + + if (@args) { + if ($args[0] =~ /^msg$/i) { + return unless $self->{ DEBUG_DIRS }; + my $format = $self->{ DEBUG_FORMAT }; + $format = $DEBUG_FORMAT unless defined $format; + $format =~ s/\$(\w+)/$hash->{ $1 }/ge; + return $format; + } + elsif ($args[0] =~ /^format$/i) { + $self->{ DEBUG_FORMAT } = $args[1]; + } + # else ignore + } + + return ''; +} + + +#------------------------------------------------------------------------ +# AUTOLOAD +# +# Provides pseudo-methods for read-only access to various internal +# members. For example, templates(), plugins(), filters(), +# eval_perl(), load_perl(), etc. These aren't called very often, or +# may never be called at all. +#------------------------------------------------------------------------ + +sub AUTOLOAD { + my $self = shift; + my $method = $AUTOLOAD; + my $result; + + $method =~ s/.*:://; + return if $method eq 'DESTROY'; + + warn "no such context method/member: $method\n" + unless defined ($result = $self->{ uc $method }); + + return $result; +} + + +#------------------------------------------------------------------------ +# DESTROY +# +# Stash may contain references back to the Context via macro closures, +# etc. This breaks the circular references. +#------------------------------------------------------------------------ + +sub DESTROY { + my $self = shift; + undef $self->{ STASH }; +} + + + +#======================================================================== +# -- PRIVATE METHODS -- +#======================================================================== + +#------------------------------------------------------------------------ +# _init(\%config) +# +# Initialisation method called by Template::Base::new() +#------------------------------------------------------------------------ + +sub _init { + my ($self, $config) = @_; + my ($name, $item, $method, $block, $blocks); + my @itemlut = ( + LOAD_TEMPLATES => 'provider', + LOAD_PLUGINS => 'plugins', + LOAD_FILTERS => 'filters' + ); + + # LOAD_TEMPLATE, LOAD_PLUGINS, LOAD_FILTERS - lists of providers + while (($name, $method) = splice(@itemlut, 0, 2)) { + $item = $config->{ $name } + || Template::Config->$method($config) + || return $self->error($Template::Config::ERROR); + $self->{ $name } = ref $item eq 'ARRAY' ? $item : [ $item ]; + } + + my $providers = $self->{ LOAD_TEMPLATES }; + my $prefix_map = $self->{ PREFIX_MAP } = $config->{ PREFIX_MAP } || { }; + while (my ($key, $val) = each %$prefix_map) { + $prefix_map->{ $key } = [ ref $val ? $val : + map { $providers->[$_] } + split(/\D+/, $val) ] + unless ref $val eq 'ARRAY'; +# print(STDERR "prefix $key => $val => [", +# join(', ', @{ $prefix_map->{ $key } }), "]\n"); + } + + # STASH + $self->{ STASH } = $config->{ STASH } || do { + my $predefs = $config->{ VARIABLES } + || $config->{ PRE_DEFINE } + || { }; + + # hack to get stash to know about debug mode + $predefs->{ _DEBUG } = ( ($config->{ DEBUG } || 0) + & &Template::Constants::DEBUG_UNDEF ) ? 1 : 0 + unless defined $predefs->{ _DEBUG }; + + Template::Config->stash($predefs) + || return $self->error($Template::Config::ERROR); + }; + + # compile any template BLOCKS specified as text + $blocks = $config->{ BLOCKS } || { }; + $self->{ INIT_BLOCKS } = $self->{ BLOCKS } = { + map { + $block = $blocks->{ $_ }; + $block = $self->template(\$block) + || return undef + unless ref $block; + ($_ => $block); + } + keys %$blocks + }; + + # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + # RECURSION - flag indicating is recursion into templates is supported + # EVAL_PERL - flag indicating if PERL blocks should be processed + # TRIM - flag to remove leading and trailing whitespace from output + # BLKSTACK - list of hashes of BLOCKs defined in current template(s) + # CONFIG - original configuration hash + # EXPOSE_BLOCKS - make blocks visible as pseudo-files + # DEBUG_FORMAT - format for generating template runtime debugging messages + # DEBUG - format for generating template runtime debugging messages + + $self->{ RECURSION } = $config->{ RECURSION } || 0; + $self->{ EVAL_PERL } = $config->{ EVAL_PERL } || 0; + $self->{ TRIM } = $config->{ TRIM } || 0; + $self->{ BLKSTACK } = [ ]; + $self->{ CONFIG } = $config; + $self->{ EXPOSE_BLOCKS } = defined $config->{ EXPOSE_BLOCKS } + ? $config->{ EXPOSE_BLOCKS } + : 0; + + $self->{ DEBUG_FORMAT } = $config->{ DEBUG_FORMAT }; + $self->{ DEBUG_DIRS } = ($config->{ DEBUG } || 0) + & Template::Constants::DEBUG_DIRS; + $self->{ DEBUG } = defined $config->{ DEBUG } + ? $config->{ DEBUG } & ( Template::Constants::DEBUG_CONTEXT + | Template::Constants::DEBUG_FLAGS ) + : $DEBUG; + + return $self; +} + + +#------------------------------------------------------------------------ +# _dump() +# +# Debug method which returns a string representing the internal state +# of the context object. +#------------------------------------------------------------------------ + +sub _dump { + my $self = shift; + my $output = "[Template::Context] {\n"; + my $format = " %-16s => %s\n"; + my $key; + + foreach $key (qw( RECURSION EVAL_PERL TRIM )) { + $output .= sprintf($format, $key, $self->{ $key }); + } + foreach my $pname (qw( LOAD_TEMPLATES LOAD_PLUGINS LOAD_FILTERS )) { + my $provtext = "[\n"; + foreach my $prov (@{ $self->{ $pname } }) { + $provtext .= $prov->_dump(); +# $provtext .= ",\n"; + } + $provtext =~ s/\n/\n /g; + $provtext =~ s/\s+$//; + $provtext .= ",\n ]"; + $output .= sprintf($format, $pname, $provtext); + } + $output .= sprintf($format, STASH => $self->{ STASH }->_dump()); + $output .= '}'; + return $output; +} + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Context - Runtime context in which templates are processed + +=head1 SYNOPSIS + + use Template::Context; + + # constructor + $context = Template::Context->new(\%config) + || die $Template::Context::ERROR; + + # fetch (load and compile) a template + $template = $context->template($template_name); + + # fetch (load and instantiate) a plugin object + $plugin = $context->plugin($name, \@args); + + # fetch (return or create) a filter subroutine + $filter = $context->filter($name, \@args, $alias); + + # process/include a template, errors are thrown via die() + $output = $context->process($template, \%vars); + $output = $context->include($template, \%vars); + + # raise an exception via die() + $context->throw($error_type, $error_message, \$output_buffer); + + # catch an exception, clean it up and fix output buffer + $exception = $context->catch($exception, \$output_buffer); + + # save/restore the stash to effect variable localisation + $new_stash = $context->localise(\%vars); + $old_stash = $context->delocalise(); + + # add new BLOCK or FILTER definitions + $context->define_block($name, $block); + $context->define_filter($name, \&filtersub, $is_dynamic); + + # reset context, clearing any imported BLOCK definitions + $context->reset(); + + # methods for accessing internal items + $stash = $context->stash(); + $tflag = $context->trim(); + $epflag = $context->eval_perl(); + $providers = $context->templates(); + $providers = $context->plugins(); + $providers = $context->filters(); + ... + +=head1 DESCRIPTION + +The Template::Context module defines an object class for representing +a runtime context in which templates are processed. It provides an +interface to the fundamental operations of the Template Toolkit +processing engine through which compiled templates (i.e. Perl code +constructed from the template source) can process templates, load +plugins and filters, raise exceptions and so on. + +A default Template::Context object is created by the Template module. +Any Template::Context options may be passed to the Template new() +constructor method and will be forwarded to the Template::Context +constructor. + + use Template; + + my $template = Template->new({ + TRIM => 1, + EVAL_PERL => 1, + BLOCKS => { + header => 'This is the header', + footer => 'This is the footer', + }, + }); + +Similarly, the Template::Context constructor will forward all configuration +parameters onto other default objects (e.g. Template::Provider, Template::Plugins, +Template::Filters, etc.) that it may need to instantiate. + + $context = Template::Context->new({ + INCLUDE_PATH => '/home/abw/templates', # provider option + TAG_STYLE => 'html', # parser option + }); + +A Template::Context object (or subclass/derivative) can be explicitly +instantiated and passed to the Template new() constructor method as +the CONTEXT item. + + use Template; + use Template::Context; + + my $context = Template::Context->new({ TRIM => 1 }); + my $template = Template->new({ CONTEXT => $context }); + +The Template module uses the Template::Config context() factory method +to create a default context object when required. The +$Template::Config::CONTEXT package variable may be set to specify an +alternate context module. This will be loaded automatically and its +new() constructor method called by the context() factory method when +a default context object is required. + + use Template; + + $Template::Config::CONTEXT = 'MyOrg::Template::Context'; + + my $template = Template->new({ + EVAL_PERL => 1, + EXTRA_MAGIC => 'red hot', # your extra config items + ... + }); + +=head1 METHODS + +=head2 new(\%params) + +The new() constructor method is called to instantiate a Template::Context +object. Configuration parameters may be specified as a HASH reference or +as a list of (name =E value) pairs. + + my $context = Template::Context->new({ + INCLUDE_PATH => 'header', + POST_PROCESS => 'footer', + }); + + my $context = Template::Context->new( EVAL_PERL => 1 ); + +The new() method returns a Template::Context object (or sub-class) or +undef on error. In the latter case, a relevant error message can be +retrieved by the error() class method or directly from the +$Template::Context::ERROR package variable. + + my $context = Template::Context->new(\%config) + || die Template::Context->error(); + + my $context = Template::Context->new(\%config) + || die $Template::Context::ERROR; + +The following configuration items may be specified. + +=over 4 + + +=item VARIABLES, PRE_DEFINE + +The VARIABLES option (or PRE_DEFINE - they're equivalent) can be used +to specify a hash array of template variables that should be used to +pre-initialise the stash when it is created. These items are ignored +if the STASH item is defined. + + my $context = Template::Context->new({ + VARIABLES => { + title => 'A Demo Page', + author => 'Joe Random Hacker', + version => 3.14, + }, + }; + +or + + my $context = Template::Context->new({ + PRE_DEFINE => { + title => 'A Demo Page', + author => 'Joe Random Hacker', + version => 3.14, + }, + }; + + + + + +=item BLOCKS + +The BLOCKS option can be used to pre-define a default set of template +blocks. These should be specified as a reference to a hash array +mapping template names to template text, subroutines or Template::Document +objects. + + my $context = Template::Context->new({ + BLOCKS => { + header => 'The Header. [% title %]', + footer => sub { return $some_output_text }, + another => Template::Document->new({ ... }), + }, + }); + + + + + +=item TRIM + +The TRIM option can be set to have any leading and trailing whitespace +automatically removed from the output of all template files and BLOCKs. + +By example, the following BLOCK definition + + [% BLOCK foo %] + Line 1 of foo + [% END %] + +will be processed is as "\nLine 1 of foo\n". When INCLUDEd, the surrounding +newlines will also be introduced. + + before + [% INCLUDE foo %] + after + +output: + before + + Line 1 of foo + + after + +With the TRIM option set to any true value, the leading and trailing +newlines (which count as whitespace) will be removed from the output +of the BLOCK. + + before + Line 1 of foo + after + +The TRIM option is disabled (0) by default. + + + + + + +=item EVAL_PERL + +This flag is used to indicate if PERL and/or RAWPERL blocks should be +evaluated. By default, it is disabled and any PERL or RAWPERL blocks +encountered will raise exceptions of type 'perl' with the message +'EVAL_PERL not set'. Note however that any RAWPERL blocks should +always contain valid Perl code, regardless of the EVAL_PERL flag. The +parser will fail to compile templates that contain invalid Perl code +in RAWPERL blocks and will throw a 'file' exception. + +When using compiled templates (see +L and +L), +the EVAL_PERL has an affect when the template is compiled, and again +when the templates is subsequently processed, possibly in a different +context to the one that compiled it. + +If the EVAL_PERL is set when a template is compiled, then all PERL and +RAWPERL blocks will be included in the compiled template. If the +EVAL_PERL option isn't set, then Perl code will be generated which +B throws a 'perl' exception with the message 'EVAL_PERL not +set' B the compiled template code is run. + +Thus, you must have EVAL_PERL set if you want your compiled templates +to include PERL and RAWPERL blocks. + +At some point in the future, using a different invocation of the +Template Toolkit, you may come to process such a pre-compiled +template. Assuming the EVAL_PERL option was set at the time the +template was compiled, then the output of any RAWPERL blocks will be +included in the compiled template and will get executed when the +template is processed. This will happen regardless of the runtime +EVAL_PERL status. + +Regular PERL blocks are a little more cautious, however. If the +EVAL_PERL flag isn't set for the I context, that is, the +one which is trying to process it, then it will throw the familiar 'perl' +exception with the message, 'EVAL_PERL not set'. + +Thus you can compile templates to include PERL blocks, but optionally +disable them when you process them later. Note however that it is +possible for a PERL block to contain a Perl "BEGIN { # some code }" +block which will always get run regardless of the runtime EVAL_PERL +status. Thus, if you set EVAL_PERL when compiling templates, it is +assumed that you trust the templates to Do The Right Thing. Otherwise +you must accept the fact that there's no bulletproof way to prevent +any included code from trampling around in the living room of the +runtime environment, making a real nuisance of itself if it really +wants to. If you don't like the idea of such uninvited guests causing +a bother, then you can accept the default and keep EVAL_PERL disabled. + + + + + + + +=item RECURSION + +The template processor will raise a file exception if it detects +direct or indirect recursion into a template. Setting this option to +any true value will allow templates to include each other recursively. + + + +=item LOAD_TEMPLATES + +The LOAD_TEMPLATE option can be used to provide a reference to a list +of Template::Provider objects or sub-classes thereof which will take +responsibility for loading and compiling templates. + + my $context = Template::Context->new({ + LOAD_TEMPLATES => [ + MyOrg::Template::Provider->new({ ... }), + Template::Provider->new({ ... }), + ], + }); + +When a PROCESS, INCLUDE or WRAPPER directive is encountered, the named +template may refer to a locally defined BLOCK or a file relative to +the INCLUDE_PATH (or an absolute or relative path if the appropriate +ABSOLUTE or RELATIVE options are set). If a BLOCK definition can't be +found (see the Template::Context template() method for a discussion of +BLOCK locality) then each of the LOAD_TEMPLATES provider objects is +queried in turn via the fetch() method to see if it can supply the +required template. Each provider can return a compiled template, an +error, or decline to service the request in which case the +responsibility is passed to the next provider. If none of the +providers can service the request then a 'not found' error is +returned. The same basic provider mechanism is also used for the +INSERT directive but it bypasses any BLOCK definitions and doesn't +attempt is to parse or process the contents of the template file. + +This is an implementation of the 'Chain of Responsibility' +design pattern as described in +"Design Patterns", Erich Gamma, Richard Helm, Ralph Johnson, John +Vlissides), Addision-Wesley, ISBN 0-201-63361-2, page 223 +. + +If LOAD_TEMPLATES is undefined, a single default provider will be +instantiated using the current configuration parameters. For example, +the Template::Provider INCLUDE_PATH option can be specified in the Template::Context configuration and will be correctly passed to the provider's +constructor method. + + my $context = Template::Context->new({ + INCLUDE_PATH => '/here:/there', + }); + + + + + +=item LOAD_PLUGINS + +The LOAD_PLUGINS options can be used to specify a list of provider +objects (i.e. they implement the fetch() method) which are responsible +for loading and instantiating template plugin objects. The +Template::Content plugin() method queries each provider in turn in a +"Chain of Responsibility" as per the template() and filter() methods. + + my $context = Template::Context->new({ + LOAD_PLUGINS => [ + MyOrg::Template::Plugins->new({ ... }), + Template::Plugins->new({ ... }), + ], + }); + +By default, a single Template::Plugins object is created using the +current configuration hash. Configuration items destined for the +Template::Plugins constructor may be added to the Template::Context +constructor. + + my $context = Template::Context->new({ + PLUGIN_BASE => 'MyOrg::Template::Plugins', + LOAD_PERL => 1, + }); + + + + + +=item LOAD_FILTERS + +The LOAD_FILTERS option can be used to specify a list of provider +objects (i.e. they implement the fetch() method) which are responsible +for returning and/or creating filter subroutines. The +Template::Context filter() method queries each provider in turn in a +"Chain of Responsibility" as per the template() and plugin() methods. + + my $context = Template::Context->new({ + LOAD_FILTERS => [ + MyTemplate::Filters->new(), + Template::Filters->new(), + ], + }); + +By default, a single Template::Filters object is created for the +LOAD_FILTERS list. + + + +=item STASH + +A reference to a Template::Stash object or sub-class which will take +responsibility for managing template variables. + + my $stash = MyOrg::Template::Stash->new({ ... }); + my $context = Template::Context->new({ + STASH => $stash, + }); + +If unspecified, a default stash object is created using the VARIABLES +configuration item to initialise the stash variables. These may also +be specified as the PRE_DEFINE option for backwards compatibility with +version 1. + + my $context = Template::Context->new({ + VARIABLES => { + id => 'abw', + name => 'Andy Wardley', + }, + }; + + + +=item DEBUG + +The DEBUG option can be used to enable various debugging features +of the Template::Context module. + + use Template::Constants qw( :debug ); + + my $template = Template->new({ + DEBUG => DEBUG_CONTEXT | DEBUG_DIRS, + }); + +The DEBUG value can include any of the following. Multiple values +should be combined using the logical OR operator, '|'. + +=over 4 + +=item DEBUG_CONTEXT + +Enables general debugging messages for the +L module. + +=item DEBUG_DIRS + +This option causes the Template Toolkit to generate comments +indicating the source file, line and original text of each directive +in the template. These comments are embedded in the template output +using the format defined in the DEBUG_FORMAT configuration item, or a +simple default format if unspecified. + +For example, the following template fragment: + + + Hello World + +would generate this output: + + ## input text line 1 : ## + Hello + ## input text line 2 : World ## + World + + +=back + + + + + +=back + +=head2 template($name) + +Returns a compiled template by querying each of the LOAD_TEMPLATES providers +(instances of Template::Provider, or sub-class) in turn. + + $template = $context->template('header'); + +On error, a Template::Exception object of type 'file' is thrown via +die(). This can be caught by enclosing the call to template() in an +eval block and examining $@. + + eval { + $template = $context->template('header'); + }; + if ($@) { + print "failed to fetch template: $@\n"; + } + +=head2 plugin($name, \@args) + +Instantiates a plugin object by querying each of the LOAD_PLUGINS +providers. The default LOAD_PLUGINS provider is a Template::Plugins +object which attempts to load plugin modules, according the various +configuration items such as PLUGIN_BASE, LOAD_PERL, etc., and then +instantiate an object via new(). A reference to a list of constructor +arguments may be passed as the second parameter. These are forwarded +to the plugin constructor. + +Returns a reference to a plugin (which is generally an object, but +doesn't have to be). Errors are thrown as Template::Exception objects +of type 'plugin'. + + $plugin = $context->plugin('DBI', 'dbi:msql:mydbname'); + +=head2 filter($name, \@args, $alias) + +Instantiates a filter subroutine by querying the LOAD_FILTERS providers. +The default LOAD_FILTERS providers is a Template::Filters object. +Additional arguments may be passed by list reference along with an +optional alias under which the filter will be cached for subsequent +use. The filter is cached under its own $name if $alias is undefined. +Subsequent calls to filter($name) will return the cached entry, if +defined. Specifying arguments bypasses the caching mechanism and +always creates a new filter. Errors are thrown as Template::Exception +objects of typre 'filter'. + + # static filter (no args) + $filter = $context->filter('html'); + + # dynamic filter (args) aliased to 'padright' + $filter = $context->filter('format', '%60s', 'padright'); + + # retrieve previous filter via 'padright' alias + $filter = $context->filter('padright'); + +=head2 process($template, \%vars) + +Processes a template named or referenced by the first parameter and returns +the output generated. An optional reference to a hash array may be passed +as the second parameter, containing variable definitions which will be set +before the template is processed. The template is processed in the current +context, with no localisation of variables performed. Errors are thrown +as Template::Exception objects via die(). + + $output = $context->process('header', { title => 'Hello World' }); + +=head2 include($template, \%vars) + +Similar to process() above, but using localised variables. Changes made to +any variables will only persist until the include() method completes. + + $output = $context->include('header', { title => 'Hello World' }); + +=head2 throw($error_type, $error_message, \$output) + +Raises an exception in the form of a Template::Exception object by +calling die(). This method may be passed a reference to an existing +Template::Exception object; a single value containing an error message +which is used to instantiate a Template::Exception of type 'undef'; or +a pair of values representing the exception type and info from which a +Template::Exception object is instantiated. e.g. + + $context->throw($exception); + $context->throw("I'm sorry Dave, I can't do that"); + $context->throw('denied', "I'm sorry Dave, I can't do that"); + +The optional third parameter may be a reference to the current output +buffer. This is then stored in the exception object when created, +allowing the catcher to examine and use the output up to the point at +which the exception was raised. + + $output .= 'blah blah blah'; + $output .= 'more rhubarb'; + $context->throw('yack', 'Too much yacking', \$output); + +=head2 catch($exception, \$output) + +Catches an exception thrown, either as a reference to a +Template::Exception object or some other value. In the latter case, +the error string is promoted to a Template::Exception object of +'undef' type. This method also accepts a reference to the current +output buffer which is passed to the Template::Exception constructor, +or is appended to the output buffer stored in an existing +Template::Exception object, if unique (i.e. not the same reference). +By this process, the correct state of the output buffer can be +reconstructed for simple or nested throws. + +=head2 define_block($name, $block) + +Adds a new block definition to the internal BLOCKS cache. The first +argument should contain the name of the block and the second a reference +to a Template::Document object or template sub-routine, or template text +which is automatically compiled into a template sub-routine. Returns +a true value (the sub-routine or Template::Document reference) on +success or undef on failure. The relevant error message can be +retrieved by calling the error() method. + +=head2 define_filter($name, \&filter, $is_dynamic) + +Adds a new filter definition by calling the store() method on each of +the LOAD_FILTERS providers until accepted (in the usual case, this is +accepted straight away by the one and only Template::Filters +provider). The first argument should contain the name of the filter +and the second a reference to a filter subroutine. The optional +third argument can be set to any true value to indicate that the +subroutine is a dynamic filter factory. Returns a true value or +throws a 'filter' exception on error. + +=head2 localise(\%vars) + +Clones the stash to create a context with localised variables. Returns a +reference to the newly cloned stash object which is also stored +internally. + + $stash = $context->localise(); + +=head2 delocalise() + +Restore the stash to its state prior to localisation. + + $stash = $context->delocalise(); + +=head2 visit(\%blocks) + +This method is called by Template::Document objects immediately before +they process their content. It is called to register any local BLOCK +definitions with the context object so that they may be subsequently +delivered on request. + +=head2 leave() + +Compliment to visit(), above. Called by Template::Document objects +immediately after they process their content. + +=head2 reset() + +Clears the local BLOCKS cache of any BLOCK definitions. Any initial set of +BLOCKS specified as a configuration item to the constructor will be reinstated. + +=head2 AUTOLOAD + +An AUTOLOAD method provides access to context configuration items. + + $stash = $context->stash(); + $tflag = $context->trim(); + $epflag = $context->eval_perl(); + ... + +=head1 AUTHOR + +Andy Wardley Eabw@andywardley.comE + +L + + + + +=head1 VERSION + +2.81, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L, L, L, L, L, L, L, L diff --git a/lib/Template/Directive.pm b/lib/Template/Directive.pm new file mode 100644 index 0000000..67982d3 --- /dev/null +++ b/lib/Template/Directive.pm @@ -0,0 +1,1004 @@ +#================================================================= -*-Perl-*- +# +# Template::Directive +# +# DESCRIPTION +# Factory module for constructing templates from Perl code. +# +# AUTHOR +# Andy Wardley +# +# WARNING +# Much of this module is hairy, even furry in places. It needs +# a lot of tidying up and may even be moved into a different place +# altogether. The generator code is often inefficient, particulary in +# being very anal about pretty-printing the Perl code all neatly, but +# at the moment, that's still high priority for the sake of easier +# debugging. +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#---------------------------------------------------------------------------- +# +# $Id: Directive.pm,v 2.17 2002/08/08 11:59:15 abw Exp $ +# +#============================================================================ + +package Template::Directive; + +require 5.004; + +use strict; +use Template::Base; +use Template::Constants; +use Template::Exception; + +use base qw( Template::Base ); +use vars qw( $VERSION $DEBUG $PRETTY $WHILE_MAX ); + +$VERSION = sprintf("%d.%02d", q$Revision: 2.17 $ =~ /(\d+)\.(\d+)/); + +$WHILE_MAX = 1000 unless defined $WHILE_MAX; +$PRETTY = 0 unless defined $PRETTY; +my $OUTPUT = '$output .= '; + + +sub _init { + my ($self, $config) = @_; + $self->{ NAMESPACE } = $config->{ NAMESPACE }; + return $self; +} + + +sub pad { + my ($text, $pad) = @_; + $pad = ' ' x ($pad * 4); + $text =~ s/^(?!#line)/$pad/gm; + $text; +} + +#======================================================================== +# FACTORY METHODS +# +# These methods are called by the parser to construct directive instances. +#======================================================================== + +#------------------------------------------------------------------------ +# template($block) +#------------------------------------------------------------------------ + +sub template { + my ($class, $block) = @_; + $block = pad($block, 2) if $PRETTY; + + return "sub { return '' }" unless $block =~ /\S/; + + return <stash; + my \$output = ''; + my \$error; + + eval { BLOCK: { +$block + } }; + if (\$@) { + \$error = \$context->catch(\$@, \\\$output); + die \$error unless \$error->type eq 'return'; + } + + return \$output; +} +EOF +} + + +#------------------------------------------------------------------------ +# anon_block($block) [% BLOCK %] ... [% END %] +#------------------------------------------------------------------------ + +sub anon_block { + my ($class, $block) = @_; + $block = pad($block, 2) if $PRETTY; + + return <catch(\$@, \\\$output); + die \$error unless \$error->type eq 'return'; + } + + \$output; +}; +EOF +} + + +#------------------------------------------------------------------------ +# block($blocktext) +#------------------------------------------------------------------------ + +sub block { + my ($class, $block) = @_; + return join("\n", @{ $block || [] }); +} + + +#------------------------------------------------------------------------ +# textblock($text) +#------------------------------------------------------------------------ + +sub textblock { + my ($class, $text) = @_; + return "$OUTPUT " . &text($class, $text) . ';'; +} + + +#------------------------------------------------------------------------ +# text($text) +#------------------------------------------------------------------------ + +sub text { + my ($class, $text) = @_; + for ($text) { + s/(["\$\@\\])/\\$1/g; + s/\n/\\n/g; + } + return '"' . $text . '"'; +} + + +#------------------------------------------------------------------------ +# quoted(\@items) "foo$bar" +#------------------------------------------------------------------------ + +sub quoted { + my ($class, $items) = @_; + return '' unless @$items; + return ("('' . " . $items->[0] . ')') if scalar @$items == 1; + return '(' . join(' . ', @$items) . ')'; +# my $r = '(' . join(' . ', @$items) . ' . "")'; +# print STDERR "[$r]\n"; +# return $r; +} + + +#------------------------------------------------------------------------ +# ident(\@ident) foo.bar(baz) +#------------------------------------------------------------------------ + +sub ident { + my ($class, $ident) = @_; + return "''" unless @$ident; + my $ns; + + # does the first element of the identifier have a NAMESPACE + # handler defined? + if (ref $class && @$ident > 2 && ($ns = $class->{ NAMESPACE })) { + my $key = $ident->[0]; + $key =~ s/^'(.+)'$/$1/s; + if ($ns = $ns->{ $key }) { + return $ns->ident($ident); + } + } + + if (scalar @$ident <= 2 && ! $ident->[1]) { + $ident = $ident->[0]; + } + else { + $ident = '[' . join(', ', @$ident) . ']'; + } + return "\$stash->get($ident)"; +} + +#------------------------------------------------------------------------ +# identref(\@ident) \foo.bar(baz) +#------------------------------------------------------------------------ + +sub identref { + my ($class, $ident) = @_; + return "''" unless @$ident; + if (scalar @$ident <= 2 && ! $ident->[1]) { + $ident = $ident->[0]; + } + else { + $ident = '[' . join(', ', @$ident) . ']'; + } + return "\$stash->getref($ident)"; +} + + +#------------------------------------------------------------------------ +# assign(\@ident, $value, $default) foo = bar +#------------------------------------------------------------------------ + +sub assign { + my ($class, $var, $val, $default) = @_; + + if (ref $var) { + if (scalar @$var == 2 && ! $var->[1]) { + $var = $var->[0]; + } + else { + $var = '[' . join(', ', @$var) . ']'; + } + } + $val .= ', 1' if $default; + return "\$stash->set($var, $val)"; +} + + +#------------------------------------------------------------------------ +# args(\@args) foo, bar, baz = qux +#------------------------------------------------------------------------ + +sub args { + my ($class, $args) = @_; + my $hash = shift @$args; + push(@$args, '{ ' . join(', ', @$hash) . ' }') + if @$hash; + + return '0' unless @$args; + return '[ ' . join(', ', @$args) . ' ]'; +} + +#------------------------------------------------------------------------ +# filenames(\@names) +#------------------------------------------------------------------------ + +sub filenames { + my ($class, $names) = @_; + if (@$names > 1) { + $names = '[ ' . join(', ', @$names) . ' ]'; + } + else { + $names = shift @$names; + } + return $names; +} + + +#------------------------------------------------------------------------ +# get($expr) [% foo %] +#------------------------------------------------------------------------ + +sub get { + my ($class, $expr) = @_; + return "$OUTPUT $expr;"; +} + + +#------------------------------------------------------------------------ +# call($expr) [% CALL bar %] +#------------------------------------------------------------------------ + +sub call { + my ($class, $expr) = @_; + $expr .= ';'; + return $expr; +} + + +#------------------------------------------------------------------------ +# set(\@setlist) [% foo = bar, baz = qux %] +#------------------------------------------------------------------------ + +sub set { + my ($class, $setlist) = @_; + my $output; + while (my ($var, $val) = splice(@$setlist, 0, 2)) { + $output .= &assign($class, $var, $val) . ";\n"; + } + chomp $output; + return $output; +} + + +#------------------------------------------------------------------------ +# default(\@setlist) [% DEFAULT foo = bar, baz = qux %] +#------------------------------------------------------------------------ + +sub default { + my ($class, $setlist) = @_; + my $output; + while (my ($var, $val) = splice(@$setlist, 0, 2)) { + $output .= &assign($class, $var, $val, 1) . ";\n"; + } + chomp $output; + return $output; +} + + +#------------------------------------------------------------------------ +# insert(\@nameargs) [% INSERT file %] +# # => [ [ $file, ... ], \@args ] +#------------------------------------------------------------------------ + +sub insert { + my ($class, $nameargs) = @_; + my ($file, $args) = @$nameargs; + $file = $class->filenames($file); + return "$OUTPUT \$context->insert($file);"; +} + + +#------------------------------------------------------------------------ +# include(\@nameargs) [% INCLUDE template foo = bar %] +# # => [ [ $file, ... ], \@args ] +#------------------------------------------------------------------------ + +sub include { + my ($class, $nameargs) = @_; + my ($file, $args) = @$nameargs; + my $hash = shift @$args; + $file = $class->filenames($file); + $file .= @$hash ? ', { ' . join(', ', @$hash) . ' }' : ''; + return "$OUTPUT \$context->include($file);"; +} + + +#------------------------------------------------------------------------ +# process(\@nameargs) [% PROCESS template foo = bar %] +# # => [ [ $file, ... ], \@args ] +#------------------------------------------------------------------------ + +sub process { + my ($class, $nameargs) = @_; + my ($file, $args) = @$nameargs; + my $hash = shift @$args; + $file = $class->filenames($file); + $file .= @$hash ? ', { ' . join(', ', @$hash) . ' }' : ''; + return "$OUTPUT \$context->process($file);"; +} + + +#------------------------------------------------------------------------ +# if($expr, $block, $else) [% IF foo < bar %] +# ... +# [% ELSE %] +# ... +# [% END %] +#------------------------------------------------------------------------ + +sub if { + my ($class, $expr, $block, $else) = @_; + my @else = $else ? @$else : (); + $else = pop @else; + $block = pad($block, 1) if $PRETTY; + + my $output = "if ($expr) {\n$block\n}\n"; + + foreach my $elsif (@else) { + ($expr, $block) = @$elsif; + $block = pad($block, 1) if $PRETTY; + $output .= "elsif ($expr) {\n$block\n}\n"; + } + if (defined $else) { + $else = pad($else, 1) if $PRETTY; + $output .= "else {\n$else\n}\n"; + } + + return $output; +} + + +#------------------------------------------------------------------------ +# foreach($target, $list, $args, $block) [% FOREACH x = [ foo bar ] %] +# ... +# [% END %] +#------------------------------------------------------------------------ + +sub foreach { + my ($class, $target, $list, $args, $block) = @_; + $args = shift @$args; + $args = @$args ? ', { ' . join(', ', @$args) . ' }' : ''; + + my ($loop_save, $loop_set, $loop_restore, $setiter); + if ($target) { + $loop_save = 'eval { $oldloop = ' . &ident($class, ["'loop'"]) . ' }'; + $loop_set = "\$stash->{'$target'} = \$value"; + $loop_restore = "\$stash->set('loop', \$oldloop)"; + } + else { + $loop_save = '$stash = $context->localise()'; +# $loop_set = "\$stash->set('import', \$value) " +# . "if ref \$value eq 'HASH'"; + $loop_set = "\$stash->get(['import', [\$value]]) " + . "if ref \$value eq 'HASH'"; + $loop_restore = '$stash = $context->delocalise()'; + } + $block = pad($block, 3) if $PRETTY; + + return <iterator(\$list) + || die \$Template::Config::ERROR, "\\n"; + } + + (\$value, \$error) = \$list->get_first(); + $loop_save; + \$stash->set('loop', \$list); + eval { +LOOP: while (! \$error) { + $loop_set; +$block; + (\$value, \$error) = \$list->get_next(); + } + }; + $loop_restore; + die \$@ if \$@; + \$error = 0 if \$error && \$error eq Template::Constants::STATUS_DONE; + die \$error if \$error; +}; +EOF +} + +#------------------------------------------------------------------------ +# next() [% NEXT %] +# +# Next iteration of a FOREACH loop (experimental) +#------------------------------------------------------------------------ + +sub next { + return <get_next(); +next LOOP; +EOF +} + + +#------------------------------------------------------------------------ +# wrapper(\@nameargs, $block) [% WRAPPER template foo = bar %] +# # => [ [$file,...], \@args ] +#------------------------------------------------------------------------ + +sub wrapper { + my ($class, $nameargs, $block) = @_; + my ($file, $args) = @$nameargs; + my $hash = shift @$args; + + local $" = ', '; +# print STDERR "wrapper([@$file], { @$hash })\n"; + + return $class->multi_wrapper($file, $hash, $block) + if @$file > 1; + $file = shift @$file; + + $block = pad($block, 1) if $PRETTY; + push(@$hash, "'content'", '$output'); + $file .= @$hash ? ', { ' . join(', ', @$hash) . ' }' : ''; + + return <include($file); +}; +EOF +} + + +sub multi_wrapper { + my ($class, $file, $hash, $block) = @_; + $block = pad($block, 1) if $PRETTY; + + push(@$hash, "'content'", '$output'); + $hash = @$hash ? ', { ' . join(', ', @$hash) . ' }' : ''; + + $file = join(', ', reverse @$file); +# print STDERR "multi wrapper: $file\n"; + + return <include(\$_$hash); + } + \$output; +}; +EOF +} + + +#------------------------------------------------------------------------ +# while($expr, $block) [% WHILE x < 10 %] +# ... +# [% END %] +#------------------------------------------------------------------------ + +sub while { + my ($class, $expr, $block) = @_; + $block = pad($block, 2) if $PRETTY; + + return < $WHILE_MAX iterations)\\n" + unless \$failsafe; +}; +EOF +} + + +#------------------------------------------------------------------------ +# switch($expr, \@case) [% SWITCH %] +# [% CASE foo %] +# ... +# [% END %] +#------------------------------------------------------------------------ + +sub switch { + my ($class, $expr, $case) = @_; + my @case = @$case; + my ($match, $block, $default); + my $caseblock = ''; + + $default = pop @case; + + foreach $case (@case) { + $match = $case->[0]; + $block = $case->[1]; + $block = pad($block, 1) if $PRETTY; + $caseblock .= <[0] || do { + $default ||= $catch->[1]; + next; + }; + $mblock = $catch->[1]; + $mblock = pad($mblock, 1) if $PRETTY; + push(@$handlers, "'$match'"); + $catchblock .= $n++ + ? "elsif (\$handler eq '$match') {\n$mblock\n}\n" + : "if (\$handler eq '$match') {\n$mblock\n}\n"; + } + $catchblock .= "\$error = 0;"; + $catchblock = pad($catchblock, 3) if $PRETTY; + if ($default) { + $default = pad($default, 1) if $PRETTY; + $default = "else {\n # DEFAULT\n$default\n \$error = '';\n}"; + } + else { + $default = '# NO DEFAULT'; + } + $default = pad($default, 2) if $PRETTY; + + $handlers = join(', ', @$handlers); +return <catch(\$@, \\\$output); + die \$error if \$error->type =~ /^return|stop\$/; + \$stash->set('error', \$error); + \$stash->set('e', \$error); + if (defined (\$handler = \$error->select_handler($handlers))) { +$catchblock + } +$default + } +$final +}; +EOF +} + + +#------------------------------------------------------------------------ +# throw(\@nameargs) [% THROW foo "bar error" %] +# # => [ [$type], \@args ] +#------------------------------------------------------------------------ + +sub throw { + my ($class, $nameargs) = @_; + my ($type, $args) = @$nameargs; + my $hash = shift(@$args); + my $info = shift(@$args); + $type = shift @$type; # uses same parser production as INCLUDE + # etc., which allow multiple names + # e.g. INCLUDE foo+bar+baz + + if (! $info) { + $args = "$type, undef"; + } + elsif (@$hash || @$args) { + local $" = ', '; + my $i = 0; + $args = "$type, { args => [ " + . join(', ', $info, @$args) + . ' ], ' + . join(', ', + (map { "'" . $i++ . "' => $_" } ($info, @$args)), + @$hash) + . ' }'; + } + else { + $args = "$type, $info"; + } + + return "\$context->throw($args, \\\$output);"; +} + + +#------------------------------------------------------------------------ +# clear() [% CLEAR %] +# +# NOTE: this is redundant, being hard-coded (for now) into Parser.yp +#------------------------------------------------------------------------ + +sub clear { + return "\$output = '';"; +} + +#------------------------------------------------------------------------ +# break() [% BREAK %] +# +# NOTE: this is redundant, being hard-coded (for now) into Parser.yp +#------------------------------------------------------------------------ + +sub break { + return 'last LOOP;'; +} + +#------------------------------------------------------------------------ +# return() [% RETURN %] +#------------------------------------------------------------------------ + +sub return { + return "\$context->throw('return', '', \\\$output);"; +} + +#------------------------------------------------------------------------ +# stop() [% STOP %] +#------------------------------------------------------------------------ + +sub stop { + return "\$context->throw('stop', '', \\\$output);"; +} + + +#------------------------------------------------------------------------ +# use(\@lnameargs) [% USE alias = plugin(args) %] +# # => [ [$file, ...], \@args, $alias ] +#------------------------------------------------------------------------ + +sub use { + my ($class, $lnameargs) = @_; + my ($file, $args, $alias) = @$lnameargs; + $file = shift @$file; # same production rule as INCLUDE + $alias ||= $file; + $args = &args($class, $args); + $file .= ", $args" if $args; +# my $set = &assign($class, $alias, '$plugin'); + return "# USE\n" + . "\$stash->set($alias,\n" + . " \$context->plugin($file));"; +} + +#------------------------------------------------------------------------ +# view(\@nameargs, $block) [% VIEW name args %] +# # => [ [$file, ... ], \@args ] +#------------------------------------------------------------------------ + +sub view { + my ($class, $nameargs, $block, $defblocks) = @_; + my ($name, $args) = @$nameargs; + my $hash = shift @$args; + $name = shift @$name; # same production rule as INCLUDE + $block = pad($block, 1) if $PRETTY; + + if (%$defblocks) { + $defblocks = join(",\n", map { "'$_' => $defblocks->{ $_ }" } + keys %$defblocks); + $defblocks = pad($defblocks, 1) if $PRETTY; + $defblocks = "{\n$defblocks\n}"; + push(@$hash, "'blocks'", $defblocks); + } + $hash = @$hash ? '{ ' . join(', ', @$hash) . ' }' : ''; + + return <get('view'); + my \$view = \$context->view($hash); + \$stash->set($name, \$view); + \$stash->set('view', \$view); + +$block + + \$stash->set('view', \$oldv); + \$view->seal(); + \$output; +}; +EOF +} + + +#------------------------------------------------------------------------ +# perl($block) +#------------------------------------------------------------------------ + +sub perl { + my ($class, $block) = @_; + $block = pad($block, 1) if $PRETTY; + + return <throw('perl', 'EVAL_PERL not set') + unless \$context->eval_perl(); + +$OUTPUT do { + my \$output = "package Template::Perl;\\n"; + +$block + + local(\$Template::Perl::context) = \$context; + local(\$Template::Perl::stash) = \$stash; + + my \$result = ''; + tie *Template::Perl::PERLOUT, 'Template::TieString', \\\$result; + my \$save_stdout = select *Template::Perl::PERLOUT; + + eval \$output; + select \$save_stdout; + \$context->throw(\$@) if \$@; + \$result; +}; +EOF +} + + +#------------------------------------------------------------------------ +# no_perl() +#------------------------------------------------------------------------ + +sub no_perl { + my $class = shift; + return "\$context->throw('perl', 'EVAL_PERL not set');"; +} + + +#------------------------------------------------------------------------ +# rawperl($block) +# +# NOTE: perhaps test context EVAL_PERL switch at compile time rather than +# runtime? +#------------------------------------------------------------------------ + +sub rawperl { + my ($class, $block, $line) = @_; + for ($block) { + s/^\n+//; + s/\n+$//; + } + $block = pad($block, 1) if $PRETTY; + $line = $line ? " (starting line $line)" : ''; + + return <filter($name) + || \$context->throw(\$context->error); + +$block + + &\$filter(\$output); +}; +EOF +} + + +#------------------------------------------------------------------------ +# capture($name, $block) +#------------------------------------------------------------------------ + +sub capture { + my ($class, $name, $block) = @_; + + if (ref $name) { + if (scalar @$name == 2 && ! $name->[1]) { + $name = $name->[0]; + } + else { + $name = '[' . join(', ', @$name) . ']'; + } + } + $block = pad($block, 1) if $PRETTY; + + return <set($name, do { + my \$output = ''; +$block + \$output; +}); +EOF + +} + + +#------------------------------------------------------------------------ +# macro($name, $block, \@args) +#------------------------------------------------------------------------ + +sub macro { + my ($class, $ident, $block, $args) = @_; + $block = pad($block, 2) if $PRETTY; + + if ($args) { + my $nargs = scalar @$args; + $args = join(', ', map { "'$_'" } @$args); + $args = $nargs > 1 + ? "\@args{ $args } = splice(\@_, 0, $nargs)" + : "\$args{ $args } = shift"; + + return <set('$ident', sub { + my \$output = ''; + my (%args, \$params); + $args; + \$params = shift; + \$params = { } unless ref(\$params) eq 'HASH'; + \$params = { \%args, %\$params }; + + my \$stash = \$context->localise(\$params); + eval { +$block + }; + \$stash = \$context->delocalise(); + die \$@ if \$@; + return \$output; +}); +EOF + + } + else { + return <set('$ident', sub { + my \$params = \$_[0] if ref(\$_[0]) eq 'HASH'; + my \$output = ''; + + my \$stash = \$context->localise(\$params); + eval { +$block + }; + \$stash = \$context->delocalise(); + die \$@ if \$@; + return \$output; +}); +EOF + } +} + + +sub debug { + my ($class, $nameargs) = @_; + my ($file, $args) = @$nameargs; + my $hash = shift @$args; + $args = join(', ', @$file, @$args); + $args .= @$hash ? ', { ' . join(', ', @$hash) . ' }' : ''; + return "$OUTPUT \$context->debugging($args); ## DEBUG ##"; +} + + +1; + +__END__ + diff --git a/lib/Template/Document.pm b/lib/Template/Document.pm new file mode 100644 index 0000000..9e01548 --- /dev/null +++ b/lib/Template/Document.pm @@ -0,0 +1,482 @@ +##============================================================= -*-Perl-*- +# +# Template::Document +# +# DESCRIPTION +# Module defining a class of objects which encapsulate compiled +# templates, storing additional block definitions and metadata +# as well as the compiled Perl sub-routine representing the main +# template content. +# +# AUTHOR +# Andy Wardley +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#---------------------------------------------------------------------------- +# +# $Id: Document.pm,v 2.65 2003/04/24 09:14:38 abw Exp $ +# +#============================================================================ + +package Template::Document; + +require 5.004; + +use strict; +use vars qw( $VERSION $ERROR $COMPERR $DEBUG $AUTOLOAD ); +use base qw( Template::Base ); +use Template::Constants; + +$VERSION = sprintf("%d.%02d", q$Revision: 2.65 $ =~ /(\d+)\.(\d+)/); + + +#======================================================================== +# ----- PUBLIC METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# new(\%document) +# +# Creates a new self-contained Template::Document object which +# encapsulates a compiled Perl sub-routine, $block, any additional +# BLOCKs defined within the document ($defblocks, also Perl sub-routines) +# and additional $metadata about the document. +#------------------------------------------------------------------------ + +sub new { + my ($class, $doc) = @_; + my ($block, $defblocks, $metadata) = @$doc{ qw( BLOCK DEFBLOCKS METADATA ) }; + $defblocks ||= { }; + $metadata ||= { }; + + # evaluate Perl code in $block to create sub-routine reference if necessary + unless (ref $block) { + local $SIG{__WARN__} = \&catch_warnings; + $COMPERR = ''; + + # DON'T LOOK NOW! - blindly untainting can make you go blind! + $block =~ /(.*)/s; + $block = $1; + + $block = eval $block; +# $COMPERR .= "[$@]" if $@; +# return $class->error($COMPERR) + return $class->error($@) + unless defined $block; + } + + # same for any additional BLOCK definitions + @$defblocks{ keys %$defblocks } = + # MORE BLIND UNTAINTING - turn away if you're squeamish + map { + ref($_) + ? $_ + : ( /(.*)/s && eval($1) or return $class->error($@) ) + } values %$defblocks; + + bless { + %$metadata, + _BLOCK => $block, + _DEFBLOCKS => $defblocks, + _HOT => 0, + }, $class; +} + + +#------------------------------------------------------------------------ +# block() +# +# Returns a reference to the internal sub-routine reference, _BLOCK, +# that constitutes the main document template. +#------------------------------------------------------------------------ + +sub block { + return $_[0]->{ _BLOCK }; +} + + +#------------------------------------------------------------------------ +# blocks() +# +# Returns a reference to a hash array containing any BLOCK definitions +# from the template. The hash keys are the BLOCK nameand the values +# are references to Template::Document objects. Returns 0 (# an empty hash) +# if no blocks are defined. +#------------------------------------------------------------------------ + +sub blocks { + return $_[0]->{ _DEFBLOCKS }; +} + + +#------------------------------------------------------------------------ +# process($context) +# +# Process the document in a particular context. Checks for recursion, +# registers the document with the context via visit(), processes itself, +# and then unwinds with a large gin and tonic. +#------------------------------------------------------------------------ + +sub process { + my ($self, $context) = @_; + my $defblocks = $self->{ _DEFBLOCKS }; + my $output; + + + # check we're not already visiting this template + return $context->throw(Template::Constants::ERROR_FILE, + "recursion into '$self->{ name }'") + if $self->{ _HOT } && ! $context->{ RECURSION }; ## RETURN ## + + $context->visit($defblocks); + $self->{ _HOT } = 1; + eval { + my $block = $self->{ _BLOCK }; + $output = &$block($context); + }; + $self->{ _HOT } = 0; + $context->leave(); + + die $context->catch($@) + if $@; + + return $output; +} + + +#------------------------------------------------------------------------ +# AUTOLOAD +# +# Provides pseudo-methods for read-only access to various internal +# members. +#------------------------------------------------------------------------ + +sub AUTOLOAD { + my $self = shift; + my $method = $AUTOLOAD; + + $method =~ s/.*:://; + return if $method eq 'DESTROY'; +# my ($pkg, $file, $line) = caller(); +# print STDERR "called $self->AUTOLOAD($method) from $file line $line\n"; + return $self->{ $method }; +} + + +#======================================================================== +# ----- PRIVATE METHODS ----- +#======================================================================== + + +#------------------------------------------------------------------------ +# _dump() +# +# Debug method which returns a string representing the internal state +# of the object. +#------------------------------------------------------------------------ + +sub _dump { + my $self = shift; + my $dblks; + my $output = "$self : $self->{ name }\n"; + + $output .= "BLOCK: $self->{ _BLOCK }\nDEFBLOCKS:\n"; + + if ($dblks = $self->{ _DEFBLOCKS }) { + foreach my $b (keys %$dblks) { + $output .= " $b: $dblks->{ $b }\n"; + } + } + + return $output; +} + + +#======================================================================== +# ----- CLASS METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# as_perl($content) +# +# This method expects a reference to a hash passed as the first argument +# containing 3 items: +# METADATA # a hash of template metadata +# BLOCK # string containing Perl sub definition for main block +# DEFBLOCKS # hash containing further subs for addional BLOCK defs +# It returns a string containing Perl code which, when evaluated and +# executed, will instantiate a new Template::Document object with the +# above data. On error, it returns undef with an appropriate error +# message set in $ERROR. +#------------------------------------------------------------------------ + +sub as_perl { + my ($class, $content) = @_; + my ($block, $defblocks, $metadata) = @$content{ qw( BLOCK DEFBLOCKS METADATA ) }; + + $block =~ s/\n/\n /g; + $block =~ s/\s+$//; + + $defblocks = join('', map { + my $code = $defblocks->{ $_ }; + $code =~ s/\n/\n /g; + $code =~ s/\s*$//; + " '$_' => $code,\n"; + } keys %$defblocks); + $defblocks =~ s/\s+$//; + + $metadata = join('', map { + my $x = $metadata->{ $_ }; + $x =~ s/(['\\])/\\$1/g; + " '$_' => '$x',\n"; + } keys %$metadata); + $metadata =~ s/\s+$//; + + return <new({ + METADATA => { +$metadata + }, + BLOCK => $block, + DEFBLOCKS => { +$defblocks + }, +}); +EOF +} + + +#------------------------------------------------------------------------ +# write_perl_file($filename, \%content) +# +# This method calls as_perl() to generate the Perl code to represent a +# compiled template with the content passed as the second argument. +# It then writes this to the file denoted by the first argument. +# +# Returns 1 on success. On error, sets the $ERROR package variable +# to contain an error message and returns undef. +#------------------------------------------------------------------------ + +sub write_perl_file { + my ($class, $file, $content) = @_; + my ($fh, $tmpfile); + + return $class->error("invalid filename: $file") + unless $file =~ /^(.+)$/s; + + eval { + require File::Temp; + require File::Basename; + ($fh, $tmpfile) = File::Temp::tempfile( + DIR => File::Basename::dirname($file) + ); + print $fh $class->as_perl($content) || die $!; + close($fh); + }; + return $class->error($@) if $@; + return rename($tmpfile, $file) + || $class->error($!); +} + + +#------------------------------------------------------------------------ +# catch_warnings($msg) +# +# Installed as +#------------------------------------------------------------------------ + +sub catch_warnings { + $COMPERR .= join('', @_); +} + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Document - Compiled template document object + +=head1 SYNOPSIS + + use Template::Document; + + $doc = Template::Document->new({ + BLOCK => sub { # some perl code; return $some_text }, + DEFBLOCKS => { + header => sub { # more perl code; return $some_text }, + footer => sub { # blah blah blah; return $some_text }, + }, + METADATA => { + author => 'Andy Wardley', + version => 3.14, + } + }) || die $Template::Document::ERROR; + + print $doc->process($context); + +=head1 DESCRIPTION + +This module defines an object class whose instances represent compiled +template documents. The Template::Parser module creates a +Template::Document instance to encapsulate a template as it is compiled +into Perl code. + +The constructor method, new(), expects a reference to a hash array +containing the BLOCK, DEFBLOCKS and METADATA items. The BLOCK item +should contain a reference to a Perl subroutine or a textual +representation of Perl code, as generated by the Template::Parser +module, which is then evaluated into a subroutine reference using +eval(). The DEFLOCKS item should reference a hash array containing +further named BLOCKs which may be defined in the template. The keys +represent BLOCK names and the values should be subroutine references +or text strings of Perl code as per the main BLOCK item. The METADATA +item should reference a hash array of metadata items relevant to the +document. + +The process() method can then be called on the instantiated +Template::Document object, passing a reference to a Template::Content +object as the first parameter. This will install any locally defined +blocks (DEFBLOCKS) in the the contexts() BLOCKS cache (via a call to +visit()) so that they may be subsequently resolved by the context. The +main BLOCK subroutine is then executed, passing the context reference +on as a parameter. The text returned from the template subroutine is +then returned by the process() method, after calling the context leave() +method to permit cleanup and de-registration of named BLOCKS previously +installed. + +An AUTOLOAD method provides access to the METADATA items for the document. +The Template::Service module installs a reference to the main +Template::Document object in the stash as the 'template' variable. +This allows metadata items to be accessed from within templates, +including PRE_PROCESS templates. + +header: + + + + [% template.title %] + </head> + ... + +Template::Document objects are usually created by the Template::Parser +but can be manually instantiated or sub-classed to provide custom +template components. + +=head1 METHODS + +=head2 new(\%config) + +Constructor method which accept a reference to a hash array containing the +structure as shown in this example: + + $doc = Template::Document->new({ + BLOCK => sub { # some perl code; return $some_text }, + DEFBLOCKS => { + header => sub { # more perl code; return $some_text }, + footer => sub { # blah blah blah; return $some_text }, + }, + METADATA => { + author => 'Andy Wardley', + version => 3.14, + } + }) || die $Template::Document::ERROR; + +BLOCK and DEFBLOCKS items may be expressed as references to Perl subroutines +or as text strings containing Perl subroutine definitions, as is generated +by the Template::Parser module. These are evaluated into subroutine references +using eval(). + +Returns a new Template::Document object or undef on error. The error() class +method can be called, or the $ERROR package variable inspected to retrieve +the relevant error message. + +=head2 process($context) + +Main processing routine for the compiled template document. A reference to +a Template::Context object should be passed as the first parameter. The +method installs any locally defined blocks via a call to the context +visit() method, processes it's own template, passing the context reference +by parameter and then calls leave() in the context to allow cleanup. + + print $doc->process($context); + +Returns a text string representing the generated output for the template. +Errors are thrown via die(). + +=head2 block() + +Returns a reference to the main BLOCK subroutine. + +=head2 blocks() + +Returns a reference to the hash array of named DEFBLOCKS subroutines. + +=head2 AUTOLOAD + +An autoload method returns METADATA items. + + print $doc->author(); + +=head1 PACKAGE SUB-ROUTINES + +=head2 write_perl_file(\%config) + +This package subroutine is provided to effect persistance of compiled +templates. If the COMPILE_EXT option (to indicate a file extension +for saving compiled templates) then the Template::Parser module calls +this subroutine before calling the new() constructor. At this stage, +the parser has a representation of the template as text strings +containing Perl code. We can write that to a file, enclosed in a +small wrapper which will allow us to susequently require() the file +and have Perl parse and compile it into a Template::Document. Thus we +have persistance of compiled templates. + +=head1 AUTHOR + +Andy Wardley E<lt>abw@andywardley.comE<gt> + +L<http://www.andywardley.com/|http://www.andywardley.com/> + + + + +=head1 VERSION + +2.65, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L<Template|Template>, L<Template::Parser|Template::Parser> diff --git a/lib/Template/Exception.pm b/lib/Template/Exception.pm new file mode 100644 index 0000000..cf60cb3 --- /dev/null +++ b/lib/Template/Exception.pm @@ -0,0 +1,244 @@ +#============================================================= -*-Perl-*- +# +# Template::Exception +# +# DESCRIPTION +# Module implementing a generic exception class used for error handling +# in the Template Toolkit. +# +# AUTHOR +# Andy Wardley <abw@kfs.org> +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#------------------------------------------------------------------------ +# +# $Id: Exception.pm,v 2.59 2003/04/24 09:14:38 abw Exp $ +# +#======================================================================== + + +package Template::Exception; + +require 5.005; + +use strict; +use vars qw( $VERSION ); + +use constant TYPE => 0; +use constant INFO => 1; +use constant TEXT => 2; +use overload q|""| => "as_string", fallback => 1; + + +$VERSION = sprintf("%d.%02d", q$Revision: 2.59 $ =~ /(\d+)\.(\d+)/); + + +#------------------------------------------------------------------------ +# new($type, $info, \$text) +# +# Constructor method used to instantiate a new Template::Exception +# object. The first parameter should contain the exception type. This +# can be any arbitrary string of the caller's choice to represent a +# specific exception. The second parameter should contain any +# information (i.e. error message or data reference) relevant to the +# specific exception event. The third optional parameter may be a +# reference to a scalar containing output text from the template +# block up to the point where the exception was thrown. +#------------------------------------------------------------------------ + +sub new { + my ($class, $type, $info, $textref) = @_; + bless [ $type, $info, $textref ], $class; +} + + +#------------------------------------------------------------------------ +# type() +# info() +# type_info() +# +# Accessor methods to return the internal TYPE and INFO fields. +#------------------------------------------------------------------------ + +sub type { + $_[0]->[ TYPE ]; +} + +sub info { + $_[0]->[ INFO ]; +} + +sub type_info { + my $self = shift; + @$self[ TYPE, INFO ]; +} + +#------------------------------------------------------------------------ +# text() +# text(\$pretext) +# +# Method to return the text referenced by the TEXT member. A text +# reference may be passed as a parameter to supercede the existing +# member. The existing text is added to the *end* of the new text +# before being stored. This facility is provided for template blocks +# to gracefully de-nest when an exception occurs and allows them to +# reconstruct their output in the correct order. +#------------------------------------------------------------------------ + +sub text { + my ($self, $newtextref) = @_; + my $textref = $self->[ TEXT ]; + + if ($newtextref) { + $$newtextref .= $$textref if $textref && $textref ne $newtextref; + $self->[ TEXT ] = $newtextref; + return ''; + + } + elsif ($textref) { + return $$textref; + } + else { + return ''; + } +} + + +#------------------------------------------------------------------------ +# as_string() +# +# Accessor method to return a string indicating the exception type and +# information. +#------------------------------------------------------------------------ + +sub as_string { + my $self = shift; + return $self->[ TYPE ] . ' error - ' . $self->[ INFO ]; +} + + +#------------------------------------------------------------------------ +# select_handler(@types) +# +# Selects the most appropriate handler for the exception TYPE, from +# the list of types passed in as parameters. The method returns the +# item which is an exact match for TYPE or the closest, more +# generic handler (e.g. foo being more generic than foo.bar, etc.) +#------------------------------------------------------------------------ + +sub select_handler { + my ($self, @options) = @_; + my $type = $self->[ TYPE ]; + my %hlut; + @hlut{ @options } = (1) x @options; + + while ($type) { + return $type if $hlut{ $type }; + + # strip .element from the end of the exception type to find a + # more generic handler + $type =~ s/\.?[^\.]*$//; + } + return undef; +} + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Exception - Exception handling class module + +=head1 SYNOPSIS + + use Template::Exception; + + my $exception = Template::Exception->new($type, $info); + $type = $exception->type; + $info = $exception->info; + ($type, $info) = $exception->type_info; + + print $exception->as_string(); + + $handler = $exception->select_handler(\@candidates); + +=head1 DESCRIPTION + +The Template::Exception module defines an object class for +representing exceptions within the template processing life cycle. +Exceptions can be raised by modules within the Template Toolkit, or +can be generated and returned by user code bound to template +variables. + + +Exceptions can be raised in a template using the THROW directive, + + [% THROW user.login 'no user id: please login' %] + +or by calling the throw() method on the current Template::Context object, + + $context->throw('user.passwd', 'Incorrect Password'); + $context->throw('Incorrect Password'); # type 'undef' + +or from Perl code by calling die() with a Template::Exception object, + + die (Template::Exception->new('user.denied', 'Invalid User ID')); + +or by simply calling die() with an error string. This is +automagically caught and converted to an exception of 'undef' +type which can then be handled in the usual way. + + die "I'm sorry Dave, I can't do that"; + + + +Each exception is defined by its type and a information component +(e.g. error message). The type can be any identifying string and may +contain dotted components (e.g. 'foo', 'foo.bar', 'foo.bar.baz'). +Exception types are considered to be hierarchical such that 'foo.bar' +would be a specific type of the more general 'foo' type. + +=head1 AUTHOR + +Andy Wardley E<lt>abw@andywardley.comE<gt> + +L<http://www.andywardley.com/|http://www.andywardley.com/> + + + + +=head1 VERSION + +2.59, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L<Template|Template>, L<Template::Context|Template::Context> diff --git a/lib/Template/Filters.pm b/lib/Template/Filters.pm new file mode 100644 index 0000000..8667c6a --- /dev/null +++ b/lib/Template/Filters.pm @@ -0,0 +1,1438 @@ +#============================================================= -*-Perl-*- +# +# Template::Filters +# +# DESCRIPTION +# Defines filter plugins as used by the FILTER directive. +# +# AUTHORS +# Andy Wardley <abw@kfs.org>, with a number of filters contributed +# by Leslie Michael Orchard <deus_x@nijacode.com> +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#---------------------------------------------------------------------------- +# +# $Id: Filters.pm,v 2.72 2003/07/01 12:43:55 darren Exp $ +# +#============================================================================ + +package Template::Filters; + +require 5.004; + +use strict; +use base qw( Template::Base ); +use vars qw( $VERSION $DEBUG $FILTERS $URI_ESCAPES $PLUGIN_FILTER ); +use Template::Constants; + +$VERSION = sprintf("%d.%02d", q$Revision: 2.72 $ =~ /(\d+)\.(\d+)/); + + +#------------------------------------------------------------------------ +# standard filters, defined in one of the following forms: +# name => \&static_filter +# name => [ \&subref, $is_dynamic ] +# If the $is_dynamic flag is set then the sub-routine reference +# is called to create a new filter each time it is requested; if +# not set, then it is a single, static sub-routine which is returned +# for every filter request for that name. +#------------------------------------------------------------------------ + +$FILTERS = { + # static filters + 'html' => \&html_filter, + 'html_para' => \&html_paragraph, + 'html_break' => \&html_para_break, + 'html_para_break' => \&html_para_break, + 'html_line_break' => \&html_line_break, + 'uri' => \&uri_filter, + 'upper' => sub { uc $_[0] }, + 'lower' => sub { lc $_[0] }, + 'ucfirst' => sub { ucfirst $_[0] }, + 'lcfirst' => sub { lcfirst $_[0] }, + 'stderr' => sub { print STDERR @_; return '' }, + 'trim' => sub { for ($_[0]) { s/^\s+//; s/\s+$// }; $_[0] }, + 'null' => sub { return '' }, + 'collapse' => sub { for ($_[0]) { s/^\s+//; s/\s+$//; s/\s+/ /g }; + $_[0] }, + + # dynamic filters + 'html_entity' => [ \&html_entity_filter_factory, 1 ], + 'indent' => [ \&indent_filter_factory, 1 ], + 'format' => [ \&format_filter_factory, 1 ], + 'truncate' => [ \&truncate_filter_factory, 1 ], + 'repeat' => [ \&repeat_filter_factory, 1 ], + 'replace' => [ \&replace_filter_factory, 1 ], + 'remove' => [ \&remove_filter_factory, 1 ], + 'eval' => [ \&eval_filter_factory, 1 ], + 'evaltt' => [ \&eval_filter_factory, 1 ], # alias + 'perl' => [ \&perl_filter_factory, 1 ], + 'evalperl' => [ \&perl_filter_factory, 1 ], # alias + 'redirect' => [ \&redirect_filter_factory, 1 ], + 'file' => [ \&redirect_filter_factory, 1 ], # alias + 'stdout' => [ \&stdout_filter_factory, 1 ], + 'latex' => [ \&latex_filter_factory, 1 ], +}; + +# name of module implementing plugin filters +$PLUGIN_FILTER = 'Template::Plugin::Filter'; + + +#======================================================================== +# -- PUBLIC METHODS -- +#======================================================================== + +#------------------------------------------------------------------------ +# fetch($name, \@args, $context) +# +# Attempts to instantiate or return a reference to a filter sub-routine +# named by the first parameter, $name, with additional constructor +# arguments passed by reference to a list as the second parameter, +# $args. A reference to the calling Template::Context object is +# passed as the third paramter. +# +# Returns a reference to a filter sub-routine or a pair of values +# (undef, STATUS_DECLINED) or ($error, STATUS_ERROR) to decline to +# deliver the filter or to indicate an error. +#------------------------------------------------------------------------ + +sub fetch { + my ($self, $name, $args, $context) = @_; + my ($factory, $is_dynamic, $filter, $error); + + $self->debug("fetch($name, ", + defined $args ? ('[ ', join(', ', @$args), ' ]') : '<no args>', ', ', + defined $context ? $context : '<no context>', + ')') if $self->{ DEBUG }; + + # allow $name to be specified as a reference to + # a plugin filter object; any other ref is + # assumed to be a coderef and hence already a filter; + # non-refs are assumed to be regular name lookups + + if (ref $name) { + if (UNIVERSAL::isa($name, $PLUGIN_FILTER)) { + $factory = $name->factory() + || return $self->error($name->error()); + } + else { + return $name; + } + } + else { + return (undef, Template::Constants::STATUS_DECLINED) + unless ($factory = $self->{ FILTERS }->{ $name } + || $FILTERS->{ $name }); + } + + # factory can be an [ $code, $dynamic ] or just $code + if (ref $factory eq 'ARRAY') { + ($factory, $is_dynamic) = @$factory; + } + else { + $is_dynamic = 0; + } + + if (ref $factory eq 'CODE') { + if ($is_dynamic) { + # if the dynamic flag is set then the sub-routine is a + # factory which should be called to create the actual + # filter... + eval { + ($filter, $error) = &$factory($context, $args ? @$args : ()); + }; + $error ||= $@; + $error = "invalid FILTER for '$name' (not a CODE ref)" + unless $error || ref($filter) eq 'CODE'; + } + else { + # ...otherwise, it's a static filter sub-routine + $filter = $factory; + } + } + else { + $error = "invalid FILTER entry for '$name' (not a CODE ref)"; + } + + if ($error) { + return $self->{ TOLERANT } + ? (undef, Template::Constants::STATUS_DECLINED) + : ($error, Template::Constants::STATUS_ERROR) ; + } + else { + return $filter; + } +} + + +#------------------------------------------------------------------------ +# store($name, \&filter) +# +# Stores a new filter in the internal FILTERS hash. The first parameter +# is the filter name, the second a reference to a subroutine or +# array, as per the standard $FILTERS entries. +#------------------------------------------------------------------------ + +sub store { + my ($self, $name, $filter) = @_; + + $self->debug("store($name, $filter)") if $self->{ DEBUG }; + + $self->{ FILTERS }->{ $name } = $filter; + return 1; +} + + +#======================================================================== +# -- PRIVATE METHODS -- +#======================================================================== + +#------------------------------------------------------------------------ +# _init(\%config) +# +# Private initialisation method. +#------------------------------------------------------------------------ + +sub _init { + my ($self, $params) = @_; + + $self->{ FILTERS } = $params->{ FILTERS } || { }; + $self->{ TOLERANT } = $params->{ TOLERANT } || 0; + $self->{ DEBUG } = ( $params->{ DEBUG } || 0 ) + & Template::Constants::DEBUG_FILTERS; + + + return $self; +} + + + +#------------------------------------------------------------------------ +# _dump() +# +# Debug method +#------------------------------------------------------------------------ + +sub _dump { + my $self = shift; + my $output = "[Template::Filters] {\n"; + my $format = " %-16s => %s\n"; + my $key; + + foreach $key (qw( TOLERANT )) { + my $val = $self->{ $key }; + $val = '<undef>' unless defined $val; + $output .= sprintf($format, $key, $val); + } + + my $filters = $self->{ FILTERS }; + $filters = join('', map { + sprintf(" $format", $_, $filters->{ $_ }); + } keys %$filters); + $filters = "{\n$filters }"; + + $output .= sprintf($format, 'FILTERS (local)' => $filters); + + $filters = $FILTERS; + $filters = join('', map { + my $f = $filters->{ $_ }; + my ($ref, $dynamic) = ref $f eq 'ARRAY' ? @$f : ($f, 0); + sprintf(" $format", $_, $dynamic ? 'dynamic' : 'static'); + } sort keys %$filters); + $filters = "{\n$filters }"; + + $output .= sprintf($format, 'FILTERS (global)' => $filters); + + $output .= '}'; + return $output; +} + + +#======================================================================== +# -- STATIC FILTER SUBS -- +#======================================================================== + +#------------------------------------------------------------------------ +# uri_filter() [% FILTER uri %] +# +# URI escape a string. This code is borrowed from Gisle Aas' URI::Escape +# module. For something so simple, I can't see any validation in making +# the user install the URI modules just for this, so we cut and paste. +# +# URI::Escape is Copyright 1995-2000 Gisle Aas. +#------------------------------------------------------------------------ + +sub uri_filter { + my $text = shift; + + # construct and cache a lookup table for escapes (faster than + # doing a sprintf() for every character in every string each + # time) + $URI_ESCAPES ||= { + map { ( chr($_), sprintf("%%%02X", $_) ) } (0..255), + }; + + $text =~ s/([^;\/?:@&=+\$,A-Za-z0-9\-_.!~*'()])/$URI_ESCAPES->{$1}/g; + $text; +} + + +#------------------------------------------------------------------------ +# html_filter() [% FILTER html %] +# +# Convert any '<', '>' or '&' characters to the HTML equivalents, '<', +# '>' and '&', respectively. +#------------------------------------------------------------------------ + +sub html_filter { + my $text = shift; + for ($text) { + s/&/&/g; + s/</</g; + s/>/>/g; + s/"/"/g; + } + return $text; +} + + +#------------------------------------------------------------------------ +# html_paragraph() [% FILTER html_para %] +# +# Wrap each paragraph of text (delimited by two or more newlines) in the +# <p>...</p> HTML tags. +#------------------------------------------------------------------------ + +sub html_paragraph { + my $text = shift; + return "<p>\n" + . join("\n</p>\n\n<p>\n", split(/(?:\r?\n){2,}/, $text)) + . "</p>\n"; +} + + +#------------------------------------------------------------------------ +# html_para_break() [% FILTER html_para_break %] +# +# Join each paragraph of text (delimited by two or more newlines) with +# <br><br> HTML tags. +#------------------------------------------------------------------------ + +sub html_para_break { + my $text = shift; + $text =~ s|(\r?\n){2,}|$1<br />$1<br />$1|g; + return $text; +} + +#------------------------------------------------------------------------ +# html_line_break() [% FILTER html_line_break %] +# +# replaces any newlines with <br> HTML tags. +#------------------------------------------------------------------------ + +sub html_line_break { + my $text = shift; + $text =~ s|(\r?\n)|<br />$1|g; + return $text; +} + +#======================================================================== +# -- DYNAMIC FILTER FACTORIES -- +#======================================================================== + +#------------------------------------------------------------------------ +# html_entity_filter_factory(\%options) [% FILTER html %] +# +# Dynamic version of the static html filter which attempts to locate the +# Apache::Util or HTML::Entities modules to perform full entity encoding +# of the text passed. Returns an exception if one or other of the +# modules can't be located. +#------------------------------------------------------------------------ + +sub html_entity_filter_factory { + my $context = shift; + + # if Apache::Util is installed then we use it + eval { + require Apache::Util; + Apache::Util::escape_html(''); + }; + return \&Apache::Util::escape_html + unless $@; + + # otherwise if HTML::Entities is installed then we use that + eval { + require HTML::Entities; + }; + return \&HTML::Entities::encode_entities + unless $@; + + return (undef, Template::Exception->new( html_entity => + 'cannot locate Apache::Util or HTML::Entities' )); + +} + + +#------------------------------------------------------------------------ +# indent_filter_factory($pad) [% FILTER indent(pad) %] +# +# Create a filter to indent text by a fixed pad string or when $pad is +# numerical, a number of space. +#------------------------------------------------------------------------ + +sub indent_filter_factory { + my ($context, $pad) = @_; + $pad = 4 unless defined $pad; + $pad = ' ' x $pad if $pad =~ /^\d+$/; + + return sub { + my $text = shift; + $text = '' unless defined $text; + $text =~ s/^/$pad/mg; + return $text; + } +} + +#------------------------------------------------------------------------ +# format_filter_factory() [% FILTER format(format) %] +# +# Create a filter to format text according to a printf()-like format +# string. +#------------------------------------------------------------------------ + +sub format_filter_factory { + my ($context, $format) = @_; + $format = '%s' unless defined $format; + + return sub { + my $text = shift; + $text = '' unless defined $text; + return join("\n", map{ sprintf($format, $_) } split(/\n/, $text)); + } +} + + +#------------------------------------------------------------------------ +# repeat_filter_factory($n) [% FILTER repeat(n) %] +# +# Create a filter to repeat text n times. +#------------------------------------------------------------------------ + +sub repeat_filter_factory { + my ($context, $iter) = @_; + $iter = 1 unless defined $iter and length $iter; + + return sub { + my $text = shift; + $text = '' unless defined $text; + return join('\n', $text) x $iter; + } +} + + +#------------------------------------------------------------------------ +# replace_filter_factory($s, $r) [% FILTER replace(search, replace) %] +# +# Create a filter to replace 'search' text with 'replace' +#------------------------------------------------------------------------ + +sub replace_filter_factory { + my ($context, $search, $replace) = @_; + $search = '' unless defined $search; + $replace = '' unless defined $replace; + + return sub { + my $text = shift; + $text = '' unless defined $text; + $text =~ s/$search/$replace/g; + return $text; + } +} + + +#------------------------------------------------------------------------ +# remove_filter_factory($text) [% FILTER remove(text) %] +# +# Create a filter to remove 'search' string from the input text. +#------------------------------------------------------------------------ + +sub remove_filter_factory { + my ($context, $search) = @_; + + return sub { + my $text = shift; + $text = '' unless defined $text; + $text =~ s/$search//g; + return $text; + } +} + + +#------------------------------------------------------------------------ +# truncate_filter_factory($n) [% FILTER truncate(n) %] +# +# Create a filter to truncate text after n characters. +#------------------------------------------------------------------------ + +sub truncate_filter_factory { + my ($context, $len) = @_; + $len = 32 unless defined $len; + + return sub { + my $text = shift; + return $text if length $text < $len; + return substr($text, 0, $len - 3) . "..."; + } +} + + +#------------------------------------------------------------------------ +# eval_filter_factory [% FILTER eval %] +# +# Create a filter to evaluate template text. +#------------------------------------------------------------------------ + +sub eval_filter_factory { + my $context = shift; + + return sub { + my $text = shift; + $context->process(\$text); + } +} + + +#------------------------------------------------------------------------ +# perl_filter_factory [% FILTER perl %] +# +# Create a filter to process Perl text iff the context EVAL_PERL flag +# is set. +#------------------------------------------------------------------------ + +sub perl_filter_factory { + my $context = shift; + my $stash = $context->stash; + + return (undef, Template::Exception->new('perl', 'EVAL_PERL is not set')) + unless $context->eval_perl(); + + return sub { + my $text = shift; + local($Template::Perl::context) = $context; + local($Template::Perl::stash) = $stash; + my $out = eval <<EOF; +package Template::Perl; +\$stash = \$context->stash(); +$text +EOF + $context->throw($@) if $@; + return $out; + } +} + + +#------------------------------------------------------------------------ +# redirect_filter_factory($context, $file) [% FILTER redirect(file) %] +# +# Create a filter to redirect the block text to a file. +#------------------------------------------------------------------------ + +sub redirect_filter_factory { + my ($context, $file, $options) = @_; + my $outpath = $context->config->{ OUTPUT_PATH }; + + return (undef, Template::Exception->new('redirect', + 'OUTPUT_PATH is not set')) + unless $outpath; + + $options = { binmode => $options } unless ref $options; + + sub { + my $text = shift; + my $outpath = $context->config->{ OUTPUT_PATH } + || return ''; + $outpath .= "/$file"; + my $error = Template::_output($outpath, \$text, $options); + die Template::Exception->new('redirect', $error) + if $error; + return ''; + } +} + + +#------------------------------------------------------------------------ +# stdout_filter_factory($context, $binmode) [% FILTER stdout(binmode) %] +# +# Create a filter to print a block to stdout, with an optional binmode. +#------------------------------------------------------------------------ + +sub stdout_filter_factory { + my ($context, $options) = @_; + + $options = { binmode => $options } unless ref $options; + + sub { + my $text = shift; + binmode(STDOUT) if $options->{ binmode }; + print STDOUT $text; + return ''; + } +} + + +#------------------------------------------------------------------------ +# latex_filter_factory($context, $outputType) [% FILTER latex(outputType) %] +# +# Return a filter sub that converts a (hopefully) complete LaTeX source +# file to either "ps", "dvi", or "pdf". Output type should be "ps", "dvi" +# or "pdf" (pdf is default). +# +# Creates a temporary directory below File::Spec->tmpdir() (often /tmp) +# and writes the text into doc.tex. It then runs either pdflatex or +# latex and optionally dvips. Based on the exit status either returns +# the entire doc.(pdf|ps|dvi) output or throws an error with a summary +# of the error messages from doc.log. +# +# Written by Craig Barratt, Apr 28 2001. +# Win32 additions by Richard Tietjen. +#------------------------------------------------------------------------ +use File::Path; +use File::Spec; +use Cwd; + +sub latex_filter_factory +{ + my($context, $output) = @_; + + $output = lc($output); + my $fName = "latex"; + my($LaTeXPath, $PdfLaTeXPath, $DviPSPath) + = @{Template::Config->latexpaths()}; + if ( $output eq "ps" || $output eq "dvi" ) { + $context->throw($fName, + "latex not installed (see Template::Config::LATEX_PATH)") + if ( $LaTeXPath eq "" ); + } else { + $output = "pdf"; + $LaTeXPath = $PdfLaTeXPath; + $context->throw($fName, + "pdflatex not installed (see Template::Config::PDFLATEX_PATH)") + if ( $LaTeXPath eq "" ); + } + if ( $output eq "ps" && $DviPSPath eq "" ) { + $context->throw($fName, + "dvips not installed (see Template::Config::DVIPS_PATH)"); + } + if ( $^O !~ /^(MacOS|os2|VMS)$/i ) { + return sub { + local(*FH); + my $text = shift; + my $tmpRootDir = File::Spec->tmpdir(); + my $cnt = 0; + my($tmpDir, $fileName, $devnull); + my $texDoc = 'doc'; + + do { + $tmpDir = File::Spec->catdir($tmpRootDir, + "tt2latex$$" . "_$cnt"); + $cnt++; + } while ( -e $tmpDir ); + mkpath($tmpDir, 0, 0700); + $context->throw($fName, "can't create temp dir $tmpDir") + if ( !-d $tmpDir ); + $fileName = File::Spec->catfile($tmpDir, "$texDoc.tex"); + $devnull = File::Spec->devnull(); + if ( !open(FH, ">$fileName") ) { + rmtree($tmpDir); + $context->throw($fName, "can't open $fileName for output"); + } + print(FH $text); + close(FH); + + # latex must run in tmpDir directory + my $currDir = cwd(); + if ( !chdir($tmpDir) ) { + rmtree($tmpDir); + $context->throw($fName, "can't chdir $tmpDir"); + } + # + # We don't need to quote the backslashes on windows, but we + # do on other OSs + # + my $LaTeX_arg = "\\nonstopmode\\input{$texDoc}"; + $LaTeX_arg = "'$LaTeX_arg'" if ( $^O ne 'MSWin32' ); + if ( system("$LaTeXPath $LaTeX_arg" + . " 1>$devnull 2>$devnull 0<$devnull") ) { + my $texErrs = ""; + $fileName = File::Spec->catfile($tmpDir, "$texDoc.log"); + if ( open(FH, "<$fileName") ) { + my $state = 0; + # + # Try to extract just the interesting errors from + # the verbose log file + # + while ( <FH> ) { + # + # TeX errors seems to start with a "!" at the + # start of the line, and are followed several + # lines later by a line designator of the + # form "l.nnn" where nnn is the line number. + # We make sure we pick up every /^!/ line, and + # the first /^l.\d/ line after each /^!/ line. + # + if ( /^(!.*)/ ) { + $texErrs .= $1 . "\n"; + $state = 1; + } + if ( $state == 1 && /^(l\.\d.*)/ ) { + $texErrs .= $1 . "\n"; + $state = 0; + } + } + close(FH); + } else { + $texErrs = "Unable to open $fileName\n"; + } + my $ok = chdir($currDir); + rmtree($tmpDir); + $context->throw($fName, "can't chdir $currDir") if ( !$ok ); + $context->throw($fName, "latex exited with errors:\n$texErrs"); + } + if ( $output eq "ps" ) { + $fileName = File::Spec->catfile($tmpDir, "$texDoc.dvi"); + if ( system("$DviPSPath $texDoc -o" + . " 1>$devnull 2>$devnull 0<$devnull") ) { + my $ok = chdir($currDir); + rmtree($tmpDir); + $context->throw($fName, "can't chdir $currDir") if ( !$ok ); + $context->throw($fName, "can't run $DviPSPath $fileName"); + } + } + if ( !chdir($currDir) ) { + rmtree($tmpDir); + $context->throw($fName, "can't chdir $currDir"); + } + + my $retStr; + $fileName = File::Spec->catfile($tmpDir, "$texDoc.$output"); + if ( open(FH, $fileName) ) { + local $/ = undef; # slurp file in one go + binmode(FH); + $retStr = <FH>; + close(FH); + } else { + rmtree($tmpDir); + $context->throw($fName, "Can't open output file $fileName"); + } + rmtree($tmpDir); + return $retStr; + } + } else { + $context->throw("$fName not yet supported on $^O OS." + . " Please contribute code!!"); + } +} + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Filters - Post-processing filters for template blocks + +=head1 SYNOPSIS + + use Template::Filters; + + $filters = Template::Filters->new(\%config); + + ($filter, $error) = $filters->fetch($name, \@args, $context); + +=head1 DESCRIPTION + +The Template::Filters module implements a provider for creating and/or +returning subroutines that implement the standard filters. Additional +custom filters may be provided via the FILTERS options. + +=head1 METHODS + +=head2 new(\%params) + +Constructor method which instantiates and returns a reference to a +Template::Filters object. A reference to a hash array of configuration +items may be passed as a parameter. These are described below. + + my $filters = Template::Filters->new({ + FILTERS => { ... }, + }); + + my $template = Template->new({ + LOAD_FILTERS => [ $filters ], + }); + +A default Template::Filters module is created by the Template.pm module +if the LOAD_FILTERS option isn't specified. All configuration parameters +are forwarded to the constructor. + + $template = Template->new({ + FILTERS => { ... }, + }); + +=head2 fetch($name, \@args, $context) + +Called to request that a filter of a given name be provided. The name +of the filter should be specified as the first parameter. This should +be one of the standard filters or one specified in the FILTERS +configuration hash. The second argument should be a reference to an +array containing configuration parameters for the filter. This may be +specified as 0, or undef where no parameters are provided. The third +argument should be a reference to the current Template::Context +object. + +The method returns a reference to a filter sub-routine on success. It +may also return (undef, STATUS_DECLINE) to decline the request, to allow +delegation onto other filter providers in the LOAD_FILTERS chain of +responsibility. On error, ($error, STATUS_ERROR) is returned where $error +is an error message or Template::Exception object indicating the error +that occurred. + +When the TOLERANT option is set, errors are automatically downgraded to +a STATUS_DECLINE response. + + +=head1 CONFIGURATION OPTIONS + +The following list details the configuration options that can be provided +to the Template::Filters new() constructor. + +=over 4 + + + + +=item FILTERS + +The FILTERS option can be used to specify custom filters which can +then be used with the FILTER directive like any other. These are +added to the standard filters which are available by default. Filters +specified via this option will mask any standard filters of the same +name. + +The FILTERS option should be specified as a reference to a hash array +in which each key represents the name of a filter. The corresponding +value should contain a reference to an array containing a subroutine +reference and a flag which indicates if the filter is static (0) or +dynamic (1). A filter may also be specified as a solitary subroutine +reference and is assumed to be static. + + $filters = Template::Filters->new({ + FILTERS => { + 'sfilt1' => \&static_filter, # static + 'sfilt2' => [ \&static_filter, 0 ], # same as above + 'dfilt1' => [ \&dyanamic_filter_factory, 1 ], + }, + }); + +Additional filters can be specified at any time by calling the +define_filter() method on the current Template::Context object. +The method accepts a filter name, a reference to a filter +subroutine and an optional flag to indicate if the filter is +dynamic. + + my $context = $template->context(); + $context->define_filter('new_html', \&new_html); + $context->define_filter('new_repeat', \&new_repeat, 1); + +Static filters are those where a single subroutine reference is used +for all invocations of a particular filter. Filters that don't accept +any configuration parameters (e.g. 'html') can be implemented +statically. The subroutine reference is simply returned when that +particular filter is requested. The subroutine is called to filter +the output of a template block which is passed as the only argument. +The subroutine should return the modified text. + + sub static_filter { + my $text = shift; + # do something to modify $text... + return $text; + } + +The following template fragment: + + [% FILTER sfilt1 %] + Blah blah blah. + [% END %] + +is approximately equivalent to: + + &static_filter("\nBlah blah blah.\n"); + +Filters that can accept parameters (e.g. 'truncate') should be +implemented dynamically. In this case, the subroutine is taken to be +a filter 'factory' that is called to create a unique filter subroutine +each time one is requested. A reference to the current +Template::Context object is passed as the first parameter, followed by +any additional parameters specified. The subroutine should return +another subroutine reference (usually a closure) which implements the +filter. + + sub dynamic_filter_factory { + my ($context, @args) = @_; + + return sub { + my $text = shift; + # do something to modify $text... + return $text; + } + } + +The following template fragment: + + [% FILTER dfilt1(123, 456) %] + Blah blah blah + [% END %] + +is approximately equivalent to: + + my $filter = &dynamic_filter_factory($context, 123, 456); + &$filter("\nBlah blah blah.\n"); + +See the FILTER directive for further examples. + + + + +=item TOLERANT + +The TOLERANT flag is used by the various Template Toolkit provider +modules (Template::Provider, Template::Plugins, Template::Filters) to +control their behaviour when errors are encountered. By default, any +errors are reported as such, with the request for the particular +resource (template, plugin, filter) being denied and an exception +raised. When the TOLERANT flag is set to any true values, errors will +be silently ignored and the provider will instead return +STATUS_DECLINED. This allows a subsequent provider to take +responsibility for providing the resource, rather than failing the +request outright. If all providers decline to service the request, +either through tolerated failure or a genuine disinclination to +comply, then a 'E<lt>resourceE<gt> not found' exception is raised. + + + + +=item DEBUG + +The DEBUG option can be used to enable debugging messages from the +Template::Filters module by setting it to include the DEBUG_FILTERS +value. + + use Template::Constants qw( :debug ); + + my $template = Template->new({ + DEBUG => DEBUG_FILTERS | DEBUG_PLUGINS, + }); + + + + +=back + +=head1 TEMPLATE TOOLKIT FILTERS + +The following standard filters are distributed with the Template Toolkit. + + + +=head2 format(format) + +The 'format' filter takes a format string as a parameter (as per +printf()) and formats each line of text accordingly. + + [% FILTER format('<!-- %-40s -->') %] + This is a block of text filtered + through the above format. + [% END %] + +output: + + <!-- This is a block of text filtered --> + <!-- through the above format. --> + +=head2 upper + +Folds the input to UPPER CASE. + + [% "hello world" FILTER upper %] + +output: + + HELLO WORLD + +=head2 lower + +Folds the input to lower case. + + [% "Hello World" FILTER lower %] + +output: + + hello world + +=head2 ucfirst + +Folds the first character of the input to UPPER CASE. + + [% "hello" FILTER ucfirst %] + +output: + + Hello + +=head2 lcfirst + +Folds the first character of the input to lower case. + + [% "HELLO" FILTER lcfirst %] + +output: + + hELLO + +=head2 trim + +Trims any leading or trailing whitespace from the input text. Particularly +useful in conjunction with INCLUDE, PROCESS, etc., having the same effect +as the TRIM configuration option. + + [% INCLUDE myfile | trim %] + +=head2 collapse + +Collapse any whitespace sequences in the input text into a single space. +Leading and trailing whitespace (which would be reduced to a single space) +is removed, as per trim. + + [% FILTER collapse %] + + The cat + + sat on + + the mat + + [% END %] + +output: + + The cat sat on the mat + +=head2 html + +Converts the characters 'E<lt>', 'E<gt>' and '&' to '<', '>' and +'&', respectively, protecting them from being interpreted as +representing HTML tags or entities. + + [% FILTER html %] + Binary "<=>" returns -1, 0, or 1 depending on... + [% END %] + +output: + + Binary "<=>" returns -1, 0, or 1 depending on... + +=head2 html_entity + +The html filter is fast and simple but it doesn't encode the full +range of HTML entities that your text may contain. The html_entity +filter uses either the Apache::Util module (which is written in C and +is therefore faster) or the HTML::Entities module (written in Perl but +equally as comprehensive) to perform the encoding. If one or other of +these modules are installed on your system then the text will be +encoded (via the escape_html() or encode_entities() subroutines +respectively) to convert all extended characters into their +appropriate HTML entities (e.g. converting 'é' to 'é'). If +neither module is available on your system then an 'html_entity' exception +will be thrown reporting an appropriate message. + +For further information on HTML entity encoding, see +http://www.w3.org/TR/REC-html40/sgml/entities.html. + +=head2 html_para + +This filter formats a block of text into HTML paragraphs. A sequence of +two or more newlines is used as the delimiter for paragraphs which are +then wrapped in HTML E<lt>pE<gt>...E<lt>/pE<gt> tags. + + [% FILTER html_para %] + The cat sat on the mat. + + Mary had a little lamb. + [% END %] + +output: + + <p> + The cat sat on the mat. + </p> + + <p> + Mary had a little lamb. + </p> + +=head2 html_break / html_para_break + +Similar to the html_para filter described above, but uses the HTML tag +sequence E<lt>brE<gt>E<lt>brE<gt> to join paragraphs. + + [% FILTER html_break %] + The cat sat on the mat. + + Mary had a little lamb. + [% END %] + +output: + + The cat sat on the mat. + <br> + <br> + Mary had a little lamb. + +=head2 html_line_break + +This filter replaces any newlines with E<lt>brE<gt> HTML tags, +thus preserving the line breaks of the original text in the +HTML output. + + [% FILTER html_line_break %] + The cat sat on the mat. + Mary had a little lamb. + [% END %] + +output: + + The cat sat on the mat.<br> + Mary had a little lamb.<br> + +=head2 uri + +This filter URI escapes the input text, converting any characters +outside of the permitted URI character set (as defined by RFC 2396) +into a C<%nn> hex escape. + + [% 'my file.html' | uri %] + +output: + + my%20file.html + +Note that URI escaping isn't always enough when generating hyperlinks in +an HTML document. The C<&> character, for example, is valid in a URI and +will not be escaped by the URI filter. In this case you should also filter +the text through the 'html' filter. + + <a href="[% filename | uri | html %]">click here</a> + +=head2 indent(pad) + +Indents the text block by a fixed pad string or width. The 'pad' argument +can be specified as a string, or as a numerical value to indicate a pad +width (spaces). Defaults to 4 spaces if unspecified. + + [% FILTER indent('ME> ') %] + blah blah blah + cabbages, rhubard, onions + [% END %] + +output: + + ME> blah blah blah + ME> cabbages, rhubard, onions + +=head2 truncate(length) + +Truncates the text block to the length specified, or a default length of +32. Truncated text will be terminated with '...' (i.e. the '...' falls +inside the required length, rather than appending to it). + + [% FILTER truncate(21) %] + I have much to say on this matter that has previously + been said on more than one occasion. + [% END %] + +output: + + I have much to say... + +=head2 repeat(iterations) + +Repeats the text block for as many iterations as are specified (default: 1). + + [% FILTER repeat(3) %] + We want more beer and we want more beer, + [% END %] + We are the more beer wanters! + +output: + + We want more beer and we want more beer, + We want more beer and we want more beer, + We want more beer and we want more beer, + We are the more beer wanters! + +=head2 remove(string) + +Searches the input text for any occurrences of the specified string and +removes them. A Perl regular expression may be specified as the search +string. + + [% "The cat sat on the mat" FILTER remove('\s+') %] + +output: + + Thecatsatonthemat + +=head2 replace(search, replace) + +Similar to the remove filter described above, but taking a second parameter +which is used as a replacement string for instances of the search string. + + [% "The cat sat on the mat" | replace('\s+', '_') %] + +output: + + The_cat_sat_on_the_mat + +=head2 redirect(file, options) + +The 'redirect' filter redirects the output of the block into a separate +file, specified relative to the OUTPUT_PATH configuration item. + + [% FOREACH user = myorg.userlist %] + [% FILTER redirect("users/${user.id}.html") %] + [% INCLUDE userinfo %] + [% END %] + [% END %] + +or more succinctly, using side-effect notation: + + [% INCLUDE userinfo + FILTER redirect("users/${user.id}.html") + FOREACH user = myorg.userlist + %] + +A 'file' exception will be thrown if the OUTPUT_PATH option is undefined. + +An optional 'binmode' argument can follow the filename to explicitly set +the output file to binary mode. + + [% PROCESS my/png/generator + FILTER redirect("images/logo.png", binmode=1) %] + +For backwards compatibility with earlier versions, a single true/false +value can be used to set binary mode. + + [% PROCESS my/png/generator + FILTER redirect("images/logo.png", 1) %] + +For the sake of future compatibility and clarity, if nothing else, we +would strongly recommend you explicitly use the named 'binmode' option +as shown in the first example. + +=head2 eval / evaltt + +The 'eval' filter evaluates the block as template text, processing +any directives embedded within it. This allows template variables to +contain template fragments, or for some method to be provided for +returning template fragments from an external source such as a +database, which can then be processed in the template as required. + + my $vars = { + fragment => "The cat sat on the [% place %]", + }; + $template->process($file, $vars); + +The following example: + + [% fragment | eval %] + +is therefore equivalent to + + The cat sat on the [% place %] + +The 'evaltt' filter is provided as an alias for 'eval'. + +=head2 perl / evalperl + +The 'perl' filter evaluates the block as Perl code. The EVAL_PERL +option must be set to a true value or a 'perl' exception will be +thrown. + + [% my_perl_code | perl %] + +In most cases, the [% PERL %] ... [% END %] block should suffice for +evaluating Perl code, given that template directives are processed +before being evaluate as Perl. Thus, the previous example could have +been written in the more verbose form: + + [% PERL %] + [% my_perl_code %] + [% END %] + +as well as + + [% FILTER perl %] + [% my_perl_code %] + [% END %] + +The 'evalperl' filter is provided as an alias for 'perl' for backwards +compatibility. + +=head2 stdout(options) + +The stdout filter prints the output generated by the enclosing block to +STDOUT. The 'binmode' option can be passed as either a named parameter +or a single argument to set STDOUT to binary mode (see the +binmode perl function). + + [% PROCESS something/cool + FILTER stdout(binmode=1) # recommended %] + + [% PROCESS something/cool + FILTER stdout(1) # alternate %] + +The stdout filter can be used to force binmode on STDOUT, or also inside +redirect, null or stderr blocks to make sure that particular output goes +to stdout. See the null filter below for an example. + +=head2 stderr + +The stderr filter prints the output generated by the enclosing block to +STDERR. + +=head2 null + +The null filter prints nothing. This is useful for plugins whose +methods return values that you don't want to appear in the output. +Rather than assigning every plugin method call to a dummy variable +to silence it, you can wrap the block in a null filter: + + [% FILTER null; + USE im = GD.Image(100,100); + black = im.colorAllocate(0, 0, 0); + red = im.colorAllocate(255,0, 0); + blue = im.colorAllocate(0, 0, 255); + im.arc(50,50,95,75,0,360,blue); + im.fill(50,50,red); + im.png | stdout(1); + END; + -%] + +Notice the use of the stdout filter to ensure that a particular expression +generates output to stdout (in this case in binary mode). + +=head2 latex(outputType) + +Passes the text block to LaTeX and produces either PDF, DVI or +PostScript output. The 'outputType' argument determines the output +format and it should be set to one of the strings: "pdf" (default), +"dvi", or "ps". + +The text block should be a complete LaTeX source file. + + [% FILTER latex("pdf") -%] + \documentclass{article} + + \begin{document} + + \title{A Sample TT2 \LaTeX\ Source File} + \author{Craig Barratt} + \maketitle + + \section{Introduction} + This is some text. + + \end{document} + [% END -%] + +The output will be a PDF file. You should be careful not to prepend or +append any extraneous characters or text outside the FILTER block, +since this text will wrap the (binary) output of the latex filter. +Notice the END directive uses '-%]' for the END_TAG to remove the +trailing new line. + +One example where you might prepend text is in a CGI script where +you might include the Content-Type before the latex output, eg: + + Content-Type: application/pdf + + [% FILTER latex("pdf") -%] + \documentclass{article} + \begin{document} + ... + \end{document} + [% END -%] + +In other cases you might use the redirect filter to put the output +into a file, rather than delivering it to stdout. This might be +suitable for batch scripts: + + [% output = FILTER latex("pdf") -%] + \documentclass{article} + \begin{document} + ... + \end{document} + [% END; output | redirect("document.pdf", 1) -%] + +(Notice the second argument to redirect to force binary mode.) + +Note that the latex filter runs one or two external programs, so it +isn't very fast. But for modest documents the performance is adequate, +even for interactive applications. + +A error of type 'latex' will be thrown if there is an error reported +by latex, pdflatex or dvips. + +=head1 AUTHOR + +Andy Wardley E<lt>abw@andywardley.comE<gt> + +L<http://www.andywardley.com/|http://www.andywardley.com/> + + + + +=head1 VERSION + +2.72, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L<Template|Template>, L<Template::Context|Template::Context>, L<Template::Manual::Filters|Template::Manual::Filters> diff --git a/lib/Template/Grammar.pm b/lib/Template/Grammar.pm new file mode 100644 index 0000000..2e1a808 --- /dev/null +++ b/lib/Template/Grammar.pm @@ -0,0 +1,6174 @@ +#============================================================= -*-Perl-*- +# +# Template::Grammar +# +# DESCRIPTION +# Grammar file for the Template Toolkit language containing token +# definitions and parser state/rules tables generated by Parse::Yapp. +# +# AUTHOR +# Andy Wardley <abw@kfs.org> +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#------------------------------------------------------------------------ +# +# NOTE: this module is constructed from the parser/Grammar.pm.skel +# file by running the parser/yc script. You only need to do this if +# you have modified the grammar in the parser/Parser.yp file and need +# to-recompile it. See the README in the 'parser' directory for more +# information (sub-directory of the Template distribution). +# +#------------------------------------------------------------------------ +# +# $Id: Grammar.pm,v 2.19 2003/04/29 12:47:22 abw Exp $ +# +#======================================================================== + +package Template::Grammar; + +require 5.004; + +use strict; +use vars qw( $VERSION ); + +$VERSION = sprintf("%d.%02d", q$Revision: 2.19 $ =~ /(\d+)\.(\d+)/); + +my (@RESERVED, %CMPOP, $LEXTABLE, $RULES, $STATES); +my ($factory, $rawstart); + + +#======================================================================== + +# Reserved words, comparison and binary operators +#======================================================================== + +@RESERVED = qw( + GET CALL SET DEFAULT INSERT INCLUDE PROCESS WRAPPER BLOCK END + USE PLUGIN FILTER MACRO PERL RAWPERL TO STEP AND OR NOT DIV MOD + IF UNLESS ELSE ELSIF FOR NEXT WHILE SWITCH CASE META IN + TRY THROW CATCH FINAL LAST RETURN STOP CLEAR VIEW DEBUG + ); + +# for historical reasons, != and == are converted to ne and eq to perform +# stringwise comparison (mainly because it doesn't generate "non-numerical +# comparison" warnings which != and == can) but the others (e.g. < > <= >=) +# are not converted to their stringwise equivalents. I added 'gt' et al, +# briefly for v2.04d and then took them out again in 2.04e. + +%CMPOP = qw( + != ne + == eq + < < + > > + >= >= + <= <= +); + + +#======================================================================== +# Lexer Token Table +#======================================================================== + +# lookup table used by lexer is initialised with special-cases +$LEXTABLE = { + 'FOREACH' => 'FOR', + 'BREAK' => 'LAST', + '&&' => 'AND', + '||' => 'OR', + '!' => 'NOT', + '|' => 'FILTER', + '.' => 'DOT', + '_' => 'CAT', + '..' => 'TO', +# ':' => 'MACRO', + '=' => 'ASSIGN', + '=>' => 'ASSIGN', +# '->' => 'ARROW', + ',' => 'COMMA', + '\\' => 'REF', + 'and' => 'AND', # explicitly specified so that qw( and or + 'or' => 'OR', # not ) can always be used in lower case, + 'not' => 'NOT', # regardless of ANYCASE flag + 'mod' => 'MOD', + 'div' => 'DIV', +}; + +# localise the temporary variables needed to complete lexer table +{ +# my @tokens = qw< ( ) [ ] { } ${ $ / ; : ? >; + my @tokens = qw< ( ) [ ] { } ${ $ + / ; : ? >; + my @cmpop = keys %CMPOP; +# my @binop = qw( + - * % ); # '/' above, in @tokens + my @binop = qw( - * % ); # '+' and '/' above, in @tokens + + # fill lexer table, slice by slice, with reserved words and operators + @$LEXTABLE{ @RESERVED, @cmpop, @binop, @tokens } + = ( @RESERVED, ('CMPOP') x @cmpop, ('BINOP') x @binop, @tokens ); +} + + +#======================================================================== +# CLASS METHODS +#======================================================================== + +sub new { + my $class = shift; + bless { + LEXTABLE => $LEXTABLE, + STATES => $STATES, + RULES => $RULES, + }, $class; +} + +# update method to set package-scoped $factory lexical +sub install_factory { + my ($self, $new_factory) = @_; + $factory = $new_factory; +} + + +#======================================================================== +# States +#======================================================================== + +$STATES = [ + {#State 0 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'template' => 52, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'switch' => 34, + 'try' => 35, + 'assign' => 19, + 'block' => 72, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 1 + ACTIONS => { + "\$" => 43, + 'LITERAL' => 75, + 'IDENT' => 2, + "\${" => 37 + }, + GOTOS => { + 'setlist' => 76, + 'item' => 39, + 'assign' => 19, + 'node' => 23, + 'ident' => 74 + } + }, + {#State 2 + DEFAULT => -130 + }, + {#State 3 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 79, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 4 + DEFAULT => -23 + }, + {#State 5 + ACTIONS => { + ";" => 80 + } + }, + {#State 6 + DEFAULT => -37 + }, + {#State 7 + DEFAULT => -14 + }, + {#State 8 + ACTIONS => { + "\"" => 89, + "\$" => 86, + 'LITERAL' => 88, + 'FILENAME' => 83, + 'IDENT' => 81, + 'NUMBER' => 84 + }, + GOTOS => { + 'filepart' => 87, + 'names' => 91, + 'nameargs' => 90, + 'filename' => 85, + 'name' => 82 + } + }, + {#State 9 + ACTIONS => { + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "]" => 94, + "\${" => 37 + }, + GOTOS => { + 'sterm' => 96, + 'item' => 39, + 'range' => 93, + 'node' => 23, + 'ident' => 77, + 'term' => 95, + 'list' => 92, + 'lterm' => 56 + } + }, + {#State 10 + ACTIONS => { + ";" => 97 + } + }, + {#State 11 + DEFAULT => -5 + }, + {#State 12 + ACTIONS => { + ";" => -20 + }, + DEFAULT => -27 + }, + {#State 13 + DEFAULT => -78, + GOTOS => { + '@5-1' => 98 + } + }, + {#State 14 + ACTIONS => { + 'IDENT' => 99 + }, + DEFAULT => -87, + GOTOS => { + 'blockargs' => 102, + 'metadata' => 101, + 'meta' => 100 + } + }, + {#State 15 + ACTIONS => { + 'IDENT' => 99 + }, + GOTOS => { + 'metadata' => 103, + 'meta' => 100 + } + }, + {#State 16 + ACTIONS => { + 'DOT' => 104, + 'ASSIGN' => 105 + }, + DEFAULT => -109 + }, + {#State 17 + ACTIONS => { + "\"" => 89, + "\$" => 86, + 'LITERAL' => 88, + 'FILENAME' => 83, + 'IDENT' => 81, + 'NUMBER' => 84 + }, + GOTOS => { + 'filepart' => 87, + 'names' => 91, + 'nameargs' => 106, + 'filename' => 85, + 'name' => 82 + } + }, + {#State 18 + ACTIONS => { + 'IDENT' => 107 + } + }, + {#State 19 + DEFAULT => -149 + }, + {#State 20 + DEFAULT => -12 + }, + {#State 21 + ACTIONS => { + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 108, + "\"" => 60, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'sterm' => 68, + 'item' => 39, + 'loopvar' => 110, + 'node' => 23, + 'ident' => 77, + 'term' => 109, + 'lterm' => 56 + } + }, + {#State 22 + DEFAULT => -40 + }, + {#State 23 + DEFAULT => -127 + }, + {#State 24 + DEFAULT => -6 + }, + {#State 25 + ACTIONS => { + "\"" => 117, + "\$" => 114, + 'LITERAL' => 116, + 'FILENAME' => 83, + 'IDENT' => 111, + 'NUMBER' => 84, + "\${" => 37 + }, + GOTOS => { + 'filepart' => 87, + 'names' => 91, + 'nameargs' => 118, + 'filename' => 85, + 'lvalue' => 112, + 'lnameargs' => 115, + 'item' => 113, + 'name' => 82 + } + }, + {#State 26 + DEFAULT => -113 + }, + {#State 27 + ACTIONS => { + "\$" => 43, + 'IDENT' => 2, + "\${" => 37 + }, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'ident' => 119 + } + }, + {#State 28 + ACTIONS => { + 'LITERAL' => 124, + 'FILENAME' => 83, + 'IDENT' => 120, + 'NUMBER' => 84 + }, + DEFAULT => -87, + GOTOS => { + 'blockargs' => 123, + 'filepart' => 87, + 'filename' => 122, + 'blockname' => 121, + 'metadata' => 101, + 'meta' => 100 + } + }, + {#State 29 + DEFAULT => -43 + }, + {#State 30 + ACTIONS => { + "\$" => 43, + 'LITERAL' => 129, + 'IDENT' => 2, + "\${" => 37 + }, + DEFAULT => -119, + GOTOS => { + 'params' => 128, + 'hash' => 125, + 'item' => 126, + 'param' => 127 + } + }, + {#State 31 + DEFAULT => -25 + }, + {#State 32 + ACTIONS => { + "\"" => 117, + "\$" => 114, + 'LITERAL' => 116, + 'FILENAME' => 83, + 'IDENT' => 111, + 'NUMBER' => 84, + "\${" => 37 + }, + GOTOS => { + 'filepart' => 87, + 'names' => 91, + 'nameargs' => 118, + 'filename' => 85, + 'lvalue' => 112, + 'lnameargs' => 130, + 'item' => 113, + 'name' => 82 + } + }, + {#State 33 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -2, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 131, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 34 + DEFAULT => -22 + }, + {#State 35 + DEFAULT => -24 + }, + {#State 36 + ACTIONS => { + "\"" => 89, + "\$" => 86, + 'LITERAL' => 88, + 'FILENAME' => 83, + 'IDENT' => 81, + 'NUMBER' => 84 + }, + GOTOS => { + 'filepart' => 87, + 'names' => 91, + 'nameargs' => 132, + 'filename' => 85, + 'name' => 82 + } + }, + {#State 37 + ACTIONS => { + "\"" => 60, + "\$" => 43, + 'LITERAL' => 78, + 'IDENT' => 2, + 'REF' => 27, + 'NUMBER' => 26, + "\${" => 37 + }, + GOTOS => { + 'sterm' => 133, + 'item' => 39, + 'node' => 23, + 'ident' => 77 + } + }, + {#State 38 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 134, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 39 + ACTIONS => { + "(" => 135 + }, + DEFAULT => -128 + }, + {#State 40 + ACTIONS => { + ";" => 136 + } + }, + {#State 41 + DEFAULT => -38 + }, + {#State 42 + DEFAULT => -11 + }, + {#State 43 + ACTIONS => { + 'IDENT' => 137 + } + }, + {#State 44 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 138, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 45 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 139, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 46 + DEFAULT => -42 + }, + {#State 47 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 140, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 48 + ACTIONS => { + 'IF' => 144, + 'FILTER' => 143, + 'FOR' => 142, + 'WHILE' => 146, + 'WRAPPER' => 145, + 'UNLESS' => 141 + } + }, + {#State 49 + DEFAULT => -39 + }, + {#State 50 + DEFAULT => -10 + }, + {#State 51 + ACTIONS => { + "\"" => 89, + "\$" => 86, + 'LITERAL' => 88, + 'FILENAME' => 83, + 'IDENT' => 81, + 'NUMBER' => 84 + }, + GOTOS => { + 'filepart' => 87, + 'names' => 91, + 'nameargs' => 147, + 'filename' => 85, + 'name' => 82 + } + }, + {#State 52 + ACTIONS => { + '' => 148 + } + }, + {#State 53 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 57, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 149, + 'term' => 58, + 'expr' => 151, + 'assign' => 150, + 'lterm' => 56 + } + }, + {#State 54 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 152, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 55 + ACTIONS => { + "\"" => 89, + "\$" => 86, + 'LITERAL' => 88, + 'FILENAME' => 83, + 'IDENT' => 81, + 'NUMBER' => 84 + }, + GOTOS => { + 'filepart' => 87, + 'names' => 91, + 'nameargs' => 153, + 'filename' => 85, + 'name' => 82 + } + }, + {#State 56 + DEFAULT => -103 + }, + {#State 57 + ACTIONS => { + 'ASSIGN' => 154 + }, + DEFAULT => -112 + }, + {#State 58 + DEFAULT => -146 + }, + {#State 59 + DEFAULT => -15 + }, + {#State 60 + DEFAULT => -176, + GOTOS => { + 'quoted' => 155 + } + }, + {#State 61 + ACTIONS => { + "\"" => 89, + "\$" => 86, + 'LITERAL' => 88, + 'FILENAME' => 83, + 'IDENT' => 81, + 'NUMBER' => 84 + }, + GOTOS => { + 'filepart' => 87, + 'names' => 91, + 'nameargs' => 156, + 'filename' => 85, + 'name' => 82 + } + }, + {#State 62 + ACTIONS => { + ";" => -16, + "+" => 157, + 'CAT' => 163, + 'CMPOP' => 164, + "?" => 158, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'AND' => 160, + 'BINOP' => 161, + 'OR' => 162 + }, + DEFAULT => -26 + }, + {#State 63 + DEFAULT => -13 + }, + {#State 64 + DEFAULT => -36 + }, + {#State 65 + ACTIONS => { + "\"" => 89, + "\$" => 86, + 'LITERAL' => 88, + 'FILENAME' => 83, + 'IDENT' => 81, + 'NUMBER' => 84 + }, + GOTOS => { + 'filepart' => 87, + 'names' => 91, + 'nameargs' => 167, + 'filename' => 85, + 'name' => 82 + } + }, + {#State 66 + DEFAULT => -9 + }, + {#State 67 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 168, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 68 + DEFAULT => -104 + }, + {#State 69 + ACTIONS => { + "\$" => 43, + 'LITERAL' => 75, + 'IDENT' => 2, + "\${" => 37 + }, + GOTOS => { + 'setlist' => 169, + 'item' => 39, + 'assign' => 19, + 'node' => 23, + 'ident' => 74 + } + }, + {#State 70 + ACTIONS => { + "\$" => 43, + 'COMMA' => 171, + 'LITERAL' => 75, + 'IDENT' => 2, + "\${" => 37 + }, + DEFAULT => -19, + GOTOS => { + 'item' => 39, + 'assign' => 170, + 'node' => 23, + 'ident' => 74 + } + }, + {#State 71 + DEFAULT => -8 + }, + {#State 72 + DEFAULT => -1 + }, + {#State 73 + DEFAULT => -21 + }, + {#State 74 + ACTIONS => { + 'ASSIGN' => 172, + 'DOT' => 104 + } + }, + {#State 75 + ACTIONS => { + 'ASSIGN' => 154 + } + }, + {#State 76 + ACTIONS => { + "\$" => 43, + 'COMMA' => 171, + 'LITERAL' => 75, + 'IDENT' => 2, + "\${" => 37 + }, + DEFAULT => -30, + GOTOS => { + 'item' => 39, + 'assign' => 170, + 'node' => 23, + 'ident' => 74 + } + }, + {#State 77 + ACTIONS => { + 'DOT' => 104 + }, + DEFAULT => -109 + }, + {#State 78 + DEFAULT => -112 + }, + {#State 79 + ACTIONS => { + 'CMPOP' => 164, + "?" => 158, + ";" => 173, + "+" => 157, + 'MOD' => 165, + 'DIV' => 159, + "/" => 166, + 'AND' => 160, + 'CAT' => 163, + 'BINOP' => 161, + 'OR' => 162 + } + }, + {#State 80 + DEFAULT => -7 + }, + {#State 81 + DEFAULT => -173 + }, + {#State 82 + DEFAULT => -166 + }, + {#State 83 + DEFAULT => -172 + }, + {#State 84 + DEFAULT => -174 + }, + {#State 85 + ACTIONS => { + 'DOT' => 174 + }, + DEFAULT => -168 + }, + {#State 86 + ACTIONS => { + "\$" => 43, + 'IDENT' => 2, + "\${" => 37 + }, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'ident' => 175 + } + }, + {#State 87 + DEFAULT => -171 + }, + {#State 88 + DEFAULT => -169 + }, + {#State 89 + DEFAULT => -176, + GOTOS => { + 'quoted' => 176 + } + }, + {#State 90 + DEFAULT => -35 + }, + {#State 91 + ACTIONS => { + "+" => 177, + "(" => 178 + }, + DEFAULT => -156, + GOTOS => { + 'args' => 179 + } + }, + {#State 92 + ACTIONS => { + "{" => 30, + 'COMMA' => 182, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "]" => 180, + "\${" => 37 + }, + GOTOS => { + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 181, + 'lterm' => 56 + } + }, + {#State 93 + ACTIONS => { + "]" => 183 + } + }, + {#State 94 + DEFAULT => -107 + }, + {#State 95 + DEFAULT => -116 + }, + {#State 96 + ACTIONS => { + 'TO' => 184 + }, + DEFAULT => -104 + }, + {#State 97 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 185, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 98 + ACTIONS => { + ";" => 186 + } + }, + {#State 99 + ACTIONS => { + 'ASSIGN' => 187 + } + }, + {#State 100 + DEFAULT => -99 + }, + {#State 101 + ACTIONS => { + 'COMMA' => 189, + 'IDENT' => 99 + }, + DEFAULT => -86, + GOTOS => { + 'meta' => 188 + } + }, + {#State 102 + ACTIONS => { + ";" => 190 + } + }, + {#State 103 + ACTIONS => { + 'COMMA' => 189, + 'IDENT' => 99 + }, + DEFAULT => -17, + GOTOS => { + 'meta' => 188 + } + }, + {#State 104 + ACTIONS => { + "\$" => 43, + 'IDENT' => 2, + 'NUMBER' => 192, + "\${" => 37 + }, + GOTOS => { + 'item' => 39, + 'node' => 191 + } + }, + {#State 105 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'WRAPPER' => 55, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + "\"" => 60, + 'PROCESS' => 61, + 'FILTER' => 25, + 'RETURN' => 64, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 193, + 'DEFAULT' => 69, + "{" => 30, + "\${" => 37 + }, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'term' => 58, + 'loop' => 4, + 'expr' => 195, + 'wrapper' => 46, + 'atomexpr' => 48, + 'atomdir' => 12, + 'mdir' => 194, + 'sterm' => 68, + 'filter' => 29, + 'ident' => 149, + 'perl' => 31, + 'setlist' => 70, + 'switch' => 34, + 'try' => 35, + 'assign' => 19, + 'directive' => 196, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 106 + DEFAULT => -33 + }, + {#State 107 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'INCLUDE' => 17, + "(" => 198, + 'SWITCH' => 54, + 'WRAPPER' => 55, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + "\"" => 60, + 'PROCESS' => 61, + 'FILTER' => 25, + 'RETURN' => 64, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 193, + 'DEFAULT' => 69, + "{" => 30, + "\${" => 37 + }, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'term' => 58, + 'loop' => 4, + 'expr' => 199, + 'wrapper' => 46, + 'atomexpr' => 48, + 'atomdir' => 12, + 'mdir' => 197, + 'sterm' => 68, + 'filter' => 29, + 'ident' => 149, + 'perl' => 31, + 'setlist' => 70, + 'switch' => 34, + 'try' => 35, + 'assign' => 19, + 'directive' => 196, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 108 + ACTIONS => { + 'IN' => 201, + 'ASSIGN' => 200 + }, + DEFAULT => -130 + }, + {#State 109 + DEFAULT => -156, + GOTOS => { + 'args' => 202 + } + }, + {#State 110 + ACTIONS => { + ";" => 203 + } + }, + {#State 111 + ACTIONS => { + 'ASSIGN' => -130 + }, + DEFAULT => -173 + }, + {#State 112 + ACTIONS => { + 'ASSIGN' => 204 + } + }, + {#State 113 + DEFAULT => -159 + }, + {#State 114 + ACTIONS => { + "\$" => 43, + 'IDENT' => 205, + "\${" => 37 + }, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'ident' => 175 + } + }, + {#State 115 + ACTIONS => { + ";" => 206 + } + }, + {#State 116 + ACTIONS => { + 'ASSIGN' => -161 + }, + DEFAULT => -169 + }, + {#State 117 + DEFAULT => -176, + GOTOS => { + 'quoted' => 207 + } + }, + {#State 118 + DEFAULT => -158 + }, + {#State 119 + ACTIONS => { + 'DOT' => 104 + }, + DEFAULT => -110 + }, + {#State 120 + ACTIONS => { + 'ASSIGN' => 187 + }, + DEFAULT => -173 + }, + {#State 121 + DEFAULT => -83 + }, + {#State 122 + ACTIONS => { + 'DOT' => 174 + }, + DEFAULT => -84 + }, + {#State 123 + ACTIONS => { + ";" => 208 + } + }, + {#State 124 + DEFAULT => -85 + }, + {#State 125 + ACTIONS => { + "}" => 209 + } + }, + {#State 126 + ACTIONS => { + 'ASSIGN' => 210 + } + }, + {#State 127 + DEFAULT => -122 + }, + {#State 128 + ACTIONS => { + "\$" => 43, + 'COMMA' => 212, + 'LITERAL' => 129, + 'IDENT' => 2, + "\${" => 37 + }, + DEFAULT => -118, + GOTOS => { + 'item' => 126, + 'param' => 211 + } + }, + {#State 129 + ACTIONS => { + 'ASSIGN' => 213 + } + }, + {#State 130 + DEFAULT => -73 + }, + {#State 131 + DEFAULT => -4 + }, + {#State 132 + ACTIONS => { + ";" => 214 + } + }, + {#State 133 + ACTIONS => { + "}" => 215 + } + }, + {#State 134 + ACTIONS => { + "+" => 157, + 'CAT' => 163, + 'CMPOP' => 164, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'BINOP' => 161 + }, + DEFAULT => -142 + }, + {#State 135 + DEFAULT => -156, + GOTOS => { + 'args' => 216 + } + }, + {#State 136 + DEFAULT => -76, + GOTOS => { + '@4-2' => 217 + } + }, + {#State 137 + DEFAULT => -132 + }, + {#State 138 + ACTIONS => { + 'CMPOP' => 164, + "?" => 158, + ";" => 218, + "+" => 157, + 'MOD' => 165, + 'DIV' => 159, + "/" => 166, + 'AND' => 160, + 'CAT' => 163, + 'BINOP' => 161, + 'OR' => 162 + } + }, + {#State 139 + ACTIONS => { + "+" => 157, + 'CAT' => 163, + 'CMPOP' => 164, + "?" => 158, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'AND' => 160, + 'BINOP' => 161, + 'OR' => 162 + }, + DEFAULT => -29 + }, + {#State 140 + ACTIONS => { + "+" => 157, + 'CAT' => 163, + 'CMPOP' => 164, + "?" => 158, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'AND' => 160, + 'BINOP' => 161, + 'OR' => 162 + }, + DEFAULT => -28 + }, + {#State 141 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 219, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 142 + ACTIONS => { + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 108, + "\"" => 60, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'sterm' => 68, + 'item' => 39, + 'loopvar' => 220, + 'node' => 23, + 'ident' => 77, + 'term' => 109, + 'lterm' => 56 + } + }, + {#State 143 + ACTIONS => { + "\"" => 117, + "\$" => 114, + 'LITERAL' => 116, + 'FILENAME' => 83, + 'IDENT' => 111, + 'NUMBER' => 84, + "\${" => 37 + }, + GOTOS => { + 'filepart' => 87, + 'names' => 91, + 'nameargs' => 118, + 'filename' => 85, + 'lvalue' => 112, + 'lnameargs' => 221, + 'item' => 113, + 'name' => 82 + } + }, + {#State 144 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 222, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 145 + ACTIONS => { + "\"" => 89, + "\$" => 86, + 'LITERAL' => 88, + 'FILENAME' => 83, + 'IDENT' => 81, + 'NUMBER' => 84 + }, + GOTOS => { + 'filepart' => 87, + 'names' => 91, + 'nameargs' => 223, + 'filename' => 85, + 'name' => 82 + } + }, + {#State 146 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 224, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 147 + DEFAULT => -41 + }, + {#State 148 + DEFAULT => 0 + }, + {#State 149 + ACTIONS => { + 'DOT' => 104, + 'ASSIGN' => 172 + }, + DEFAULT => -109 + }, + {#State 150 + ACTIONS => { + ")" => 225 + } + }, + {#State 151 + ACTIONS => { + 'CMPOP' => 164, + "?" => 158, + "+" => 157, + 'MOD' => 165, + 'DIV' => 159, + "/" => 166, + 'AND' => 160, + 'CAT' => 163, + 'BINOP' => 161, + ")" => 226, + 'OR' => 162 + } + }, + {#State 152 + ACTIONS => { + 'CMPOP' => 164, + "?" => 158, + ";" => 227, + "+" => 157, + 'MOD' => 165, + 'DIV' => 159, + "/" => 166, + 'AND' => 160, + 'CAT' => 163, + 'BINOP' => 161, + 'OR' => 162 + } + }, + {#State 153 + ACTIONS => { + ";" => 228 + } + }, + {#State 154 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 229, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 155 + ACTIONS => { + "\"" => 234, + 'TEXT' => 231, + ";" => 233, + "\$" => 43, + 'IDENT' => 2, + "\${" => 37 + }, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'ident' => 230, + 'quotable' => 232 + } + }, + {#State 156 + DEFAULT => -34 + }, + {#State 157 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 235, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 158 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 236, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 159 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 237, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 160 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 238, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 161 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 239, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 162 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 240, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 163 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 241, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 164 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 242, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 165 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 243, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 166 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 244, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 167 + DEFAULT => -32 + }, + {#State 168 + ACTIONS => { + 'CMPOP' => 164, + "?" => 158, + ";" => 245, + "+" => 157, + 'MOD' => 165, + 'DIV' => 159, + "/" => 166, + 'AND' => 160, + 'CAT' => 163, + 'BINOP' => 161, + 'OR' => 162 + } + }, + {#State 169 + ACTIONS => { + "\$" => 43, + 'COMMA' => 171, + 'LITERAL' => 75, + 'IDENT' => 2, + "\${" => 37 + }, + DEFAULT => -31, + GOTOS => { + 'item' => 39, + 'assign' => 170, + 'node' => 23, + 'ident' => 74 + } + }, + {#State 170 + DEFAULT => -147 + }, + {#State 171 + DEFAULT => -148 + }, + {#State 172 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 246, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 173 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 247, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 174 + ACTIONS => { + 'FILENAME' => 83, + 'IDENT' => 81, + 'NUMBER' => 84 + }, + GOTOS => { + 'filepart' => 248 + } + }, + {#State 175 + ACTIONS => { + 'DOT' => 104 + }, + DEFAULT => -156, + GOTOS => { + 'args' => 249 + } + }, + {#State 176 + ACTIONS => { + "\"" => 250, + 'TEXT' => 231, + ";" => 233, + "\$" => 43, + 'IDENT' => 2, + "\${" => 37 + }, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'ident' => 230, + 'quotable' => 232 + } + }, + {#State 177 + ACTIONS => { + "\"" => 89, + 'LITERAL' => 88, + 'FILENAME' => 83, + 'IDENT' => 81, + 'NUMBER' => 84 + }, + GOTOS => { + 'filepart' => 87, + 'filename' => 85, + 'name' => 251 + } + }, + {#State 178 + DEFAULT => -156, + GOTOS => { + 'args' => 252 + } + }, + {#State 179 + ACTIONS => { + "{" => 30, + 'COMMA' => 258, + 'LITERAL' => 256, + 'IDENT' => 2, + "\"" => 60, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + DEFAULT => -163, + GOTOS => { + 'sterm' => 68, + 'item' => 254, + 'param' => 255, + 'node' => 23, + 'ident' => 253, + 'term' => 257, + 'lterm' => 56 + } + }, + {#State 180 + DEFAULT => -105 + }, + {#State 181 + DEFAULT => -114 + }, + {#State 182 + DEFAULT => -115 + }, + {#State 183 + DEFAULT => -106 + }, + {#State 184 + ACTIONS => { + "\"" => 60, + "\$" => 43, + 'LITERAL' => 78, + 'IDENT' => 2, + 'REF' => 27, + 'NUMBER' => 26, + "\${" => 37 + }, + GOTOS => { + 'sterm' => 259, + 'item' => 39, + 'node' => 23, + 'ident' => 77 + } + }, + {#State 185 + ACTIONS => { + 'FINAL' => 260, + 'CATCH' => 262 + }, + DEFAULT => -72, + GOTOS => { + 'final' => 261 + } + }, + {#State 186 + ACTIONS => { + 'TEXT' => 263 + } + }, + {#State 187 + ACTIONS => { + "\"" => 266, + 'LITERAL' => 265, + 'NUMBER' => 264 + } + }, + {#State 188 + DEFAULT => -97 + }, + {#State 189 + DEFAULT => -98 + }, + {#State 190 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'template' => 267, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 72, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 191 + DEFAULT => -125 + }, + {#State 192 + DEFAULT => -126 + }, + {#State 193 + ACTIONS => { + ";" => 268 + } + }, + {#State 194 + DEFAULT => -89 + }, + {#State 195 + ACTIONS => { + ";" => -150, + "+" => 157, + 'LITERAL' => -150, + 'IDENT' => -150, + 'CAT' => 163, + "\$" => -150, + 'CMPOP' => 164, + "?" => 158, + 'DIV' => 159, + 'MOD' => 165, + 'COMMA' => -150, + "/" => 166, + 'AND' => 160, + 'BINOP' => 161, + 'OR' => 162, + "\${" => -150 + }, + DEFAULT => -26 + }, + {#State 196 + DEFAULT => -92 + }, + {#State 197 + DEFAULT => -91 + }, + {#State 198 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 57, + 'IDENT' => 269, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'sterm' => 68, + 'item' => 39, + 'margs' => 270, + 'node' => 23, + 'ident' => 149, + 'term' => 58, + 'expr' => 151, + 'assign' => 150, + 'lterm' => 56 + } + }, + {#State 199 + ACTIONS => { + "+" => 157, + 'CAT' => 163, + 'CMPOP' => 164, + "?" => 158, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'AND' => 160, + 'BINOP' => 161, + 'OR' => 162 + }, + DEFAULT => -26 + }, + {#State 200 + ACTIONS => { + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 271, + 'lterm' => 56 + } + }, + {#State 201 + ACTIONS => { + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 272, + 'lterm' => 56 + } + }, + {#State 202 + ACTIONS => { + "{" => 30, + 'COMMA' => 258, + 'LITERAL' => 256, + 'IDENT' => 2, + "\"" => 60, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + DEFAULT => -64, + GOTOS => { + 'sterm' => 68, + 'item' => 254, + 'param' => 255, + 'node' => 23, + 'ident' => 253, + 'term' => 257, + 'lterm' => 56 + } + }, + {#State 203 + DEFAULT => -56, + GOTOS => { + '@1-3' => 273 + } + }, + {#State 204 + ACTIONS => { + "\"" => 89, + "\$" => 86, + 'LITERAL' => 88, + 'FILENAME' => 83, + 'IDENT' => 81, + 'NUMBER' => 84 + }, + GOTOS => { + 'filepart' => 87, + 'names' => 91, + 'nameargs' => 274, + 'filename' => 85, + 'name' => 82 + } + }, + {#State 205 + ACTIONS => { + 'ASSIGN' => -132 + }, + DEFAULT => -130 + }, + {#State 206 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 275, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 207 + ACTIONS => { + "\"" => 276, + 'TEXT' => 231, + ";" => 233, + "\$" => 43, + 'IDENT' => 2, + "\${" => 37 + }, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'ident' => 230, + 'quotable' => 232 + } + }, + {#State 208 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 277, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 209 + DEFAULT => -108 + }, + {#State 210 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 278, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 211 + DEFAULT => -120 + }, + {#State 212 + DEFAULT => -121 + }, + {#State 213 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 279, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 214 + DEFAULT => -74, + GOTOS => { + '@3-3' => 280 + } + }, + {#State 215 + DEFAULT => -131 + }, + {#State 216 + ACTIONS => { + "{" => 30, + 'COMMA' => 258, + 'LITERAL' => 256, + 'IDENT' => 2, + "\"" => 60, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + ")" => 281, + "\${" => 37 + }, + GOTOS => { + 'sterm' => 68, + 'item' => 254, + 'param' => 255, + 'node' => 23, + 'ident' => 253, + 'term' => 257, + 'lterm' => 56 + } + }, + {#State 217 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 282, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 218 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 283, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 219 + ACTIONS => { + 'CMPOP' => 164, + "?" => 158, + "+" => 157, + 'MOD' => 165, + 'DIV' => 159, + "/" => 166, + 'AND' => 160, + 'CAT' => 163, + 'BINOP' => 161, + 'OR' => 162 + }, + DEFAULT => -47 + }, + {#State 220 + DEFAULT => -58 + }, + {#State 221 + DEFAULT => -81 + }, + {#State 222 + ACTIONS => { + 'CMPOP' => 164, + "?" => 158, + "+" => 157, + 'MOD' => 165, + 'DIV' => 159, + "/" => 166, + 'AND' => 160, + 'CAT' => 163, + 'BINOP' => 161, + 'OR' => 162 + }, + DEFAULT => -45 + }, + {#State 223 + DEFAULT => -66 + }, + {#State 224 + ACTIONS => { + 'CMPOP' => 164, + "?" => 158, + "+" => 157, + 'MOD' => 165, + 'DIV' => 159, + "/" => 166, + 'AND' => 160, + 'CAT' => 163, + 'BINOP' => 161, + 'OR' => 162 + }, + DEFAULT => -61 + }, + {#State 225 + DEFAULT => -144 + }, + {#State 226 + DEFAULT => -145 + }, + {#State 227 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 284, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 228 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 285, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 229 + ACTIONS => { + "+" => 157, + 'CAT' => 163, + 'CMPOP' => 164, + "?" => 158, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'AND' => 160, + 'BINOP' => 161, + 'OR' => 162 + }, + DEFAULT => -151 + }, + {#State 230 + ACTIONS => { + 'DOT' => 104 + }, + DEFAULT => -177 + }, + {#State 231 + DEFAULT => -178 + }, + {#State 232 + DEFAULT => -175 + }, + {#State 233 + DEFAULT => -179 + }, + {#State 234 + DEFAULT => -111 + }, + {#State 235 + ACTIONS => { + 'DIV' => 159, + 'MOD' => 165, + "/" => 166 + }, + DEFAULT => -135 + }, + {#State 236 + ACTIONS => { + ":" => 286, + 'CMPOP' => 164, + "?" => 158, + "+" => 157, + 'MOD' => 165, + 'DIV' => 159, + "/" => 166, + 'AND' => 160, + 'CAT' => 163, + 'BINOP' => 161, + 'OR' => 162 + } + }, + {#State 237 + ACTIONS => { + 'MOD' => 165 + }, + DEFAULT => -136 + }, + {#State 238 + ACTIONS => { + "+" => 157, + 'CAT' => 163, + 'CMPOP' => 164, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'BINOP' => 161 + }, + DEFAULT => -140 + }, + {#State 239 + ACTIONS => { + "+" => 157, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166 + }, + DEFAULT => -133 + }, + {#State 240 + ACTIONS => { + "+" => 157, + 'CAT' => 163, + 'CMPOP' => 164, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'BINOP' => 161 + }, + DEFAULT => -141 + }, + {#State 241 + ACTIONS => { + "+" => 157, + 'CMPOP' => 164, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'BINOP' => 161 + }, + DEFAULT => -139 + }, + {#State 242 + ACTIONS => { + "+" => 157, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'BINOP' => 161 + }, + DEFAULT => -138 + }, + {#State 243 + DEFAULT => -137 + }, + {#State 244 + ACTIONS => { + 'DIV' => 159, + 'MOD' => 165 + }, + DEFAULT => -134 + }, + {#State 245 + DEFAULT => -59, + GOTOS => { + '@2-3' => 287 + } + }, + {#State 246 + ACTIONS => { + "+" => 157, + 'CAT' => 163, + 'CMPOP' => 164, + "?" => 158, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'AND' => 160, + 'BINOP' => 161, + 'OR' => 162 + }, + DEFAULT => -150 + }, + {#State 247 + ACTIONS => { + 'ELSIF' => 290, + 'ELSE' => 288 + }, + DEFAULT => -50, + GOTOS => { + 'else' => 289 + } + }, + {#State 248 + DEFAULT => -170 + }, + {#State 249 + ACTIONS => { + "{" => 30, + 'COMMA' => 258, + 'LITERAL' => 256, + 'IDENT' => 2, + "\"" => 60, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + DEFAULT => -162, + GOTOS => { + 'sterm' => 68, + 'item' => 254, + 'param' => 255, + 'node' => 23, + 'ident' => 253, + 'term' => 257, + 'lterm' => 56 + } + }, + {#State 250 + DEFAULT => -167 + }, + {#State 251 + DEFAULT => -165 + }, + {#State 252 + ACTIONS => { + "{" => 30, + 'COMMA' => 258, + 'LITERAL' => 256, + 'IDENT' => 2, + "\"" => 60, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + ")" => 291, + "\${" => 37 + }, + GOTOS => { + 'sterm' => 68, + 'item' => 254, + 'param' => 255, + 'node' => 23, + 'ident' => 253, + 'term' => 257, + 'lterm' => 56 + } + }, + {#State 253 + ACTIONS => { + 'DOT' => 104, + 'ASSIGN' => 292 + }, + DEFAULT => -109 + }, + {#State 254 + ACTIONS => { + "(" => 135, + 'ASSIGN' => 210 + }, + DEFAULT => -128 + }, + {#State 255 + DEFAULT => -153 + }, + {#State 256 + ACTIONS => { + 'ASSIGN' => 213 + }, + DEFAULT => -112 + }, + {#State 257 + DEFAULT => -152 + }, + {#State 258 + DEFAULT => -155 + }, + {#State 259 + DEFAULT => -117 + }, + {#State 260 + ACTIONS => { + ";" => 293 + } + }, + {#State 261 + ACTIONS => { + 'END' => 294 + } + }, + {#State 262 + ACTIONS => { + ";" => 296, + 'DEFAULT' => 297, + 'FILENAME' => 83, + 'IDENT' => 81, + 'NUMBER' => 84 + }, + GOTOS => { + 'filepart' => 87, + 'filename' => 295 + } + }, + {#State 263 + ACTIONS => { + 'END' => 298 + } + }, + {#State 264 + DEFAULT => -102 + }, + {#State 265 + DEFAULT => -100 + }, + {#State 266 + ACTIONS => { + 'TEXT' => 299 + } + }, + {#State 267 + ACTIONS => { + 'END' => 300 + } + }, + {#State 268 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 301, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 269 + ACTIONS => { + 'COMMA' => -96, + 'IDENT' => -96, + ")" => -96 + }, + DEFAULT => -130 + }, + {#State 270 + ACTIONS => { + 'COMMA' => 304, + 'IDENT' => 302, + ")" => 303 + } + }, + {#State 271 + DEFAULT => -156, + GOTOS => { + 'args' => 305 + } + }, + {#State 272 + DEFAULT => -156, + GOTOS => { + 'args' => 306 + } + }, + {#State 273 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 307, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 274 + DEFAULT => -157 + }, + {#State 275 + ACTIONS => { + 'END' => 308 + } + }, + {#State 276 + ACTIONS => { + 'ASSIGN' => -160 + }, + DEFAULT => -167 + }, + {#State 277 + ACTIONS => { + 'END' => 309 + } + }, + {#State 278 + ACTIONS => { + "+" => 157, + 'CAT' => 163, + 'CMPOP' => 164, + "?" => 158, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'AND' => 160, + 'BINOP' => 161, + 'OR' => 162 + }, + DEFAULT => -124 + }, + {#State 279 + ACTIONS => { + "+" => 157, + 'CAT' => 163, + 'CMPOP' => 164, + "?" => 158, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'AND' => 160, + 'BINOP' => 161, + 'OR' => 162 + }, + DEFAULT => -123 + }, + {#State 280 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 310, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 281 + DEFAULT => -129 + }, + {#State 282 + ACTIONS => { + 'END' => 311 + } + }, + {#State 283 + ACTIONS => { + 'ELSIF' => 290, + 'ELSE' => 288 + }, + DEFAULT => -50, + GOTOS => { + 'else' => 312 + } + }, + {#State 284 + ACTIONS => { + 'CASE' => 313 + }, + DEFAULT => -55, + GOTOS => { + 'case' => 314 + } + }, + {#State 285 + ACTIONS => { + 'END' => 315 + } + }, + {#State 286 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 316, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 287 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 317, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 288 + ACTIONS => { + ";" => 318 + } + }, + {#State 289 + ACTIONS => { + 'END' => 319 + } + }, + {#State 290 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 320, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 291 + DEFAULT => -164 + }, + {#State 292 + ACTIONS => { + 'NOT' => 38, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "(" => 53, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'expr' => 321, + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 58, + 'lterm' => 56 + } + }, + {#State 293 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 322, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 294 + DEFAULT => -67 + }, + {#State 295 + ACTIONS => { + 'DOT' => 174, + ";" => 323 + } + }, + {#State 296 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 324, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 297 + ACTIONS => { + ";" => 325 + } + }, + {#State 298 + DEFAULT => -79 + }, + {#State 299 + ACTIONS => { + "\"" => 326 + } + }, + {#State 300 + DEFAULT => -82 + }, + {#State 301 + ACTIONS => { + 'END' => 327 + } + }, + {#State 302 + DEFAULT => -94 + }, + {#State 303 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'WRAPPER' => 55, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + "\"" => 60, + 'PROCESS' => 61, + 'FILTER' => 25, + 'RETURN' => 64, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 193, + 'DEFAULT' => 69, + "{" => 30, + "\${" => 37 + }, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'term' => 58, + 'loop' => 4, + 'expr' => 199, + 'wrapper' => 46, + 'atomexpr' => 48, + 'atomdir' => 12, + 'mdir' => 328, + 'sterm' => 68, + 'filter' => 29, + 'ident' => 149, + 'perl' => 31, + 'setlist' => 70, + 'switch' => 34, + 'try' => 35, + 'assign' => 19, + 'directive' => 196, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 304 + DEFAULT => -95 + }, + {#State 305 + ACTIONS => { + "{" => 30, + 'COMMA' => 258, + 'LITERAL' => 256, + 'IDENT' => 2, + "\"" => 60, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + DEFAULT => -62, + GOTOS => { + 'sterm' => 68, + 'item' => 254, + 'param' => 255, + 'node' => 23, + 'ident' => 253, + 'term' => 257, + 'lterm' => 56 + } + }, + {#State 306 + ACTIONS => { + "{" => 30, + 'COMMA' => 258, + 'LITERAL' => 256, + 'IDENT' => 2, + "\"" => 60, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + DEFAULT => -63, + GOTOS => { + 'sterm' => 68, + 'item' => 254, + 'param' => 255, + 'node' => 23, + 'ident' => 253, + 'term' => 257, + 'lterm' => 56 + } + }, + {#State 307 + ACTIONS => { + 'END' => 329 + } + }, + {#State 308 + DEFAULT => -80 + }, + {#State 309 + DEFAULT => -88 + }, + {#State 310 + ACTIONS => { + 'END' => 330 + } + }, + {#State 311 + DEFAULT => -77 + }, + {#State 312 + ACTIONS => { + 'END' => 331 + } + }, + {#State 313 + ACTIONS => { + ";" => 332, + 'DEFAULT' => 334, + "{" => 30, + 'LITERAL' => 78, + 'IDENT' => 2, + "\"" => 60, + "\$" => 43, + "[" => 9, + 'NUMBER' => 26, + 'REF' => 27, + "\${" => 37 + }, + GOTOS => { + 'sterm' => 68, + 'item' => 39, + 'node' => 23, + 'ident' => 77, + 'term' => 333, + 'lterm' => 56 + } + }, + {#State 314 + ACTIONS => { + 'END' => 335 + } + }, + {#State 315 + DEFAULT => -65 + }, + {#State 316 + ACTIONS => { + "+" => 157, + 'CAT' => 163, + 'CMPOP' => 164, + "?" => 158, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'AND' => 160, + 'BINOP' => 161, + 'OR' => 162 + }, + DEFAULT => -143 + }, + {#State 317 + ACTIONS => { + 'END' => 336 + } + }, + {#State 318 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 337, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 319 + DEFAULT => -46 + }, + {#State 320 + ACTIONS => { + 'CMPOP' => 164, + "?" => 158, + ";" => 338, + "+" => 157, + 'MOD' => 165, + 'DIV' => 159, + "/" => 166, + 'AND' => 160, + 'CAT' => 163, + 'BINOP' => 161, + 'OR' => 162 + } + }, + {#State 321 + ACTIONS => { + "+" => 157, + 'CAT' => 163, + 'CMPOP' => 164, + "?" => 158, + 'DIV' => 159, + 'MOD' => 165, + "/" => 166, + 'AND' => 160, + 'BINOP' => 161, + 'OR' => 162 + }, + DEFAULT => -154 + }, + {#State 322 + DEFAULT => -71 + }, + {#State 323 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 339, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 324 + ACTIONS => { + 'FINAL' => 260, + 'CATCH' => 262 + }, + DEFAULT => -72, + GOTOS => { + 'final' => 340 + } + }, + {#State 325 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 341, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 326 + DEFAULT => -101 + }, + {#State 327 + DEFAULT => -93 + }, + {#State 328 + DEFAULT => -90 + }, + {#State 329 + DEFAULT => -57 + }, + {#State 330 + DEFAULT => -75 + }, + {#State 331 + DEFAULT => -44 + }, + {#State 332 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 342, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 333 + ACTIONS => { + ";" => 343 + } + }, + {#State 334 + ACTIONS => { + ";" => 344 + } + }, + {#State 335 + DEFAULT => -51 + }, + {#State 336 + DEFAULT => -60 + }, + {#State 337 + DEFAULT => -49 + }, + {#State 338 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 345, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 339 + ACTIONS => { + 'FINAL' => 260, + 'CATCH' => 262 + }, + DEFAULT => -72, + GOTOS => { + 'final' => 346 + } + }, + {#State 340 + DEFAULT => -70 + }, + {#State 341 + ACTIONS => { + 'FINAL' => 260, + 'CATCH' => 262 + }, + DEFAULT => -72, + GOTOS => { + 'final' => 347 + } + }, + {#State 342 + DEFAULT => -54 + }, + {#State 343 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 348, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 344 + ACTIONS => { + 'SET' => 1, + 'PERL' => 40, + 'NOT' => 38, + 'IDENT' => 2, + 'CLEAR' => 41, + 'UNLESS' => 3, + 'IF' => 44, + "\$" => 43, + 'STOP' => 6, + 'CALL' => 45, + 'THROW' => 8, + 'GET' => 47, + "[" => 9, + 'TRY' => 10, + 'LAST' => 49, + 'DEBUG' => 51, + 'RAWPERL' => 13, + 'META' => 15, + 'INCLUDE' => 17, + "(" => 53, + 'SWITCH' => 54, + 'MACRO' => 18, + 'WRAPPER' => 55, + ";" => -18, + 'FOR' => 21, + 'NEXT' => 22, + 'LITERAL' => 57, + 'TEXT' => 24, + "\"" => 60, + 'PROCESS' => 61, + 'RETURN' => 64, + 'FILTER' => 25, + 'INSERT' => 65, + 'NUMBER' => 26, + 'REF' => 27, + 'WHILE' => 67, + 'BLOCK' => 28, + 'DEFAULT' => 69, + "{" => 30, + 'USE' => 32, + 'VIEW' => 36, + "\${" => 37 + }, + DEFAULT => -3, + GOTOS => { + 'item' => 39, + 'node' => 23, + 'rawperl' => 59, + 'term' => 58, + 'loop' => 4, + 'use' => 63, + 'expr' => 62, + 'capture' => 42, + 'statement' => 5, + 'view' => 7, + 'wrapper' => 46, + 'atomexpr' => 48, + 'chunk' => 11, + 'defblock' => 66, + 'atomdir' => 12, + 'anonblock' => 50, + 'sterm' => 68, + 'defblockname' => 14, + 'filter' => 29, + 'ident' => 16, + 'perl' => 31, + 'setlist' => 70, + 'chunks' => 33, + 'try' => 35, + 'switch' => 34, + 'assign' => 19, + 'block' => 349, + 'directive' => 71, + 'macro' => 20, + 'condition' => 73, + 'lterm' => 56 + } + }, + {#State 345 + ACTIONS => { + 'ELSIF' => 290, + 'ELSE' => 288 + }, + DEFAULT => -50, + GOTOS => { + 'else' => 350 + } + }, + {#State 346 + DEFAULT => -68 + }, + {#State 347 + DEFAULT => -69 + }, + {#State 348 + ACTIONS => { + 'CASE' => 313 + }, + DEFAULT => -55, + GOTOS => { + 'case' => 351 + } + }, + {#State 349 + DEFAULT => -53 + }, + {#State 350 + DEFAULT => -48 + }, + {#State 351 + DEFAULT => -52 + } +]; + + +#======================================================================== +# Rules +#======================================================================== + +$RULES = [ + [#Rule 0 + '$start', 2, undef + ], + [#Rule 1 + 'template', 1, +sub +#line 64 "Parser.yp" +{ $factory->template($_[1]) } + ], + [#Rule 2 + 'block', 1, +sub +#line 67 "Parser.yp" +{ $factory->block($_[1]) } + ], + [#Rule 3 + 'block', 0, +sub +#line 68 "Parser.yp" +{ $factory->block() } + ], + [#Rule 4 + 'chunks', 2, +sub +#line 71 "Parser.yp" +{ push(@{$_[1]}, $_[2]) + if defined $_[2]; $_[1] } + ], + [#Rule 5 + 'chunks', 1, +sub +#line 73 "Parser.yp" +{ defined $_[1] ? [ $_[1] ] : [ ] } + ], + [#Rule 6 + 'chunk', 1, +sub +#line 76 "Parser.yp" +{ $factory->textblock($_[1]) } + ], + [#Rule 7 + 'chunk', 2, undef + ], + [#Rule 8 + 'statement', 1, undef + ], + [#Rule 9 + 'statement', 1, undef + ], + [#Rule 10 + 'statement', 1, undef + ], + [#Rule 11 + 'statement', 1, undef + ], + [#Rule 12 + 'statement', 1, undef + ], + [#Rule 13 + 'statement', 1, undef + ], + [#Rule 14 + 'statement', 1, undef + ], + [#Rule 15 + 'statement', 1, undef + ], + [#Rule 16 + 'statement', 1, +sub +#line 89 "Parser.yp" +{ $factory->get($_[1]) } + ], + [#Rule 17 + 'statement', 2, +sub +#line 90 "Parser.yp" +{ $_[0]->add_metadata($_[2]); } + ], + [#Rule 18 + 'statement', 0, undef + ], + [#Rule 19 + 'directive', 1, +sub +#line 94 "Parser.yp" +{ $factory->set($_[1]) } + ], + [#Rule 20 + 'directive', 1, undef + ], + [#Rule 21 + 'directive', 1, undef + ], + [#Rule 22 + 'directive', 1, undef + ], + [#Rule 23 + 'directive', 1, undef + ], + [#Rule 24 + 'directive', 1, undef + ], + [#Rule 25 + 'directive', 1, undef + ], + [#Rule 26 + 'atomexpr', 1, +sub +#line 108 "Parser.yp" +{ $factory->get($_[1]) } + ], + [#Rule 27 + 'atomexpr', 1, undef + ], + [#Rule 28 + 'atomdir', 2, +sub +#line 112 "Parser.yp" +{ $factory->get($_[2]) } + ], + [#Rule 29 + 'atomdir', 2, +sub +#line 113 "Parser.yp" +{ $factory->call($_[2]) } + ], + [#Rule 30 + 'atomdir', 2, +sub +#line 114 "Parser.yp" +{ $factory->set($_[2]) } + ], + [#Rule 31 + 'atomdir', 2, +sub +#line 115 "Parser.yp" +{ $factory->default($_[2]) } + ], + [#Rule 32 + 'atomdir', 2, +sub +#line 116 "Parser.yp" +{ $factory->insert($_[2]) } + ], + [#Rule 33 + 'atomdir', 2, +sub +#line 117 "Parser.yp" +{ $factory->include($_[2]) } + ], + [#Rule 34 + 'atomdir', 2, +sub +#line 118 "Parser.yp" +{ $factory->process($_[2]) } + ], + [#Rule 35 + 'atomdir', 2, +sub +#line 119 "Parser.yp" +{ $factory->throw($_[2]) } + ], + [#Rule 36 + 'atomdir', 1, +sub +#line 120 "Parser.yp" +{ $factory->return() } + ], + [#Rule 37 + 'atomdir', 1, +sub +#line 121 "Parser.yp" +{ $factory->stop() } + ], + [#Rule 38 + 'atomdir', 1, +sub +#line 122 "Parser.yp" +{ "\$output = '';"; } + ], + [#Rule 39 + 'atomdir', 1, +sub +#line 123 "Parser.yp" +{ $_[0]->{ INFOR } || $_[0]->{ INWHILE } + ? 'last LOOP;' + : 'last;' } + ], + [#Rule 40 + 'atomdir', 1, +sub +#line 126 "Parser.yp" +{ $_[0]->{ INFOR } + ? $factory->next() + : ($_[0]->{ INWHILE } + ? 'next LOOP;' + : 'next;') } + ], + [#Rule 41 + 'atomdir', 2, +sub +#line 131 "Parser.yp" +{ if ($_[2]->[0]->[0] =~ /^'(on|off)'$/) { + $_[0]->{ DEBUG_DIRS } = ($1 eq 'on'); + $factory->debug($_[2]); + } + else { + $_[0]->{ DEBUG_DIRS } ? $factory->debug($_[2]) : ''; + } + } + ], + [#Rule 42 + 'atomdir', 1, undef + ], + [#Rule 43 + 'atomdir', 1, undef + ], + [#Rule 44 + 'condition', 6, +sub +#line 144 "Parser.yp" +{ $factory->if(@_[2, 4, 5]) } + ], + [#Rule 45 + 'condition', 3, +sub +#line 145 "Parser.yp" +{ $factory->if(@_[3, 1]) } + ], + [#Rule 46 + 'condition', 6, +sub +#line 147 "Parser.yp" +{ $factory->if("!($_[2])", @_[4, 5]) } + ], + [#Rule 47 + 'condition', 3, +sub +#line 148 "Parser.yp" +{ $factory->if("!($_[3])", $_[1]) } + ], + [#Rule 48 + 'else', 5, +sub +#line 152 "Parser.yp" +{ unshift(@{$_[5]}, [ @_[2, 4] ]); + $_[5]; } + ], + [#Rule 49 + 'else', 3, +sub +#line 154 "Parser.yp" +{ [ $_[3] ] } + ], + [#Rule 50 + 'else', 0, +sub +#line 155 "Parser.yp" +{ [ undef ] } + ], + [#Rule 51 + 'switch', 6, +sub +#line 159 "Parser.yp" +{ $factory->switch(@_[2, 5]) } + ], + [#Rule 52 + 'case', 5, +sub +#line 163 "Parser.yp" +{ unshift(@{$_[5]}, [ @_[2, 4] ]); + $_[5]; } + ], + [#Rule 53 + 'case', 4, +sub +#line 165 "Parser.yp" +{ [ $_[4] ] } + ], + [#Rule 54 + 'case', 3, +sub +#line 166 "Parser.yp" +{ [ $_[3] ] } + ], + [#Rule 55 + 'case', 0, +sub +#line 167 "Parser.yp" +{ [ undef ] } + ], + [#Rule 56 + '@1-3', 0, +sub +#line 170 "Parser.yp" +{ $_[0]->{ INFOR }++ } + ], + [#Rule 57 + 'loop', 6, +sub +#line 171 "Parser.yp" +{ $_[0]->{ INFOR }--; + $factory->foreach(@{$_[2]}, $_[5]) } + ], + [#Rule 58 + 'loop', 3, +sub +#line 175 "Parser.yp" +{ $factory->foreach(@{$_[3]}, $_[1]) } + ], + [#Rule 59 + '@2-3', 0, +sub +#line 176 "Parser.yp" +{ $_[0]->{ INWHILE }++ } + ], + [#Rule 60 + 'loop', 6, +sub +#line 177 "Parser.yp" +{ $_[0]->{ INWHILE }--; + $factory->while(@_[2, 5]) } + ], + [#Rule 61 + 'loop', 3, +sub +#line 179 "Parser.yp" +{ $factory->while(@_[3, 1]) } + ], + [#Rule 62 + 'loopvar', 4, +sub +#line 182 "Parser.yp" +{ [ @_[1, 3, 4] ] } + ], + [#Rule 63 + 'loopvar', 4, +sub +#line 183 "Parser.yp" +{ [ @_[1, 3, 4] ] } + ], + [#Rule 64 + 'loopvar', 2, +sub +#line 184 "Parser.yp" +{ [ 0, @_[1, 2] ] } + ], + [#Rule 65 + 'wrapper', 5, +sub +#line 188 "Parser.yp" +{ $factory->wrapper(@_[2, 4]) } + ], + [#Rule 66 + 'wrapper', 3, +sub +#line 190 "Parser.yp" +{ $factory->wrapper(@_[3, 1]) } + ], + [#Rule 67 + 'try', 5, +sub +#line 194 "Parser.yp" +{ $factory->try(@_[3, 4]) } + ], + [#Rule 68 + 'final', 5, +sub +#line 198 "Parser.yp" +{ unshift(@{$_[5]}, [ @_[2,4] ]); + $_[5]; } + ], + [#Rule 69 + 'final', 5, +sub +#line 201 "Parser.yp" +{ unshift(@{$_[5]}, [ undef, $_[4] ]); + $_[5]; } + ], + [#Rule 70 + 'final', 4, +sub +#line 204 "Parser.yp" +{ unshift(@{$_[4]}, [ undef, $_[3] ]); + $_[4]; } + ], + [#Rule 71 + 'final', 3, +sub +#line 206 "Parser.yp" +{ [ $_[3] ] } + ], + [#Rule 72 + 'final', 0, +sub +#line 207 "Parser.yp" +{ [ 0 ] } + ], + [#Rule 73 + 'use', 2, +sub +#line 210 "Parser.yp" +{ $factory->use($_[2]) } + ], + [#Rule 74 + '@3-3', 0, +sub +#line 213 "Parser.yp" +{ $_[0]->push_defblock(); } + ], + [#Rule 75 + 'view', 6, +sub +#line 214 "Parser.yp" +{ $factory->view(@_[2,5], + $_[0]->pop_defblock) } + ], + [#Rule 76 + '@4-2', 0, +sub +#line 218 "Parser.yp" +{ ${$_[0]->{ INPERL }}++; } + ], + [#Rule 77 + 'perl', 5, +sub +#line 219 "Parser.yp" +{ ${$_[0]->{ INPERL }}--; + $_[0]->{ EVAL_PERL } + ? $factory->perl($_[4]) + : $factory->no_perl(); } + ], + [#Rule 78 + '@5-1', 0, +sub +#line 225 "Parser.yp" +{ ${$_[0]->{ INPERL }}++; + $rawstart = ${$_[0]->{'LINE'}}; } + ], + [#Rule 79 + 'rawperl', 5, +sub +#line 227 "Parser.yp" +{ ${$_[0]->{ INPERL }}--; + $_[0]->{ EVAL_PERL } + ? $factory->rawperl($_[4], $rawstart) + : $factory->no_perl(); } + ], + [#Rule 80 + 'filter', 5, +sub +#line 234 "Parser.yp" +{ $factory->filter(@_[2,4]) } + ], + [#Rule 81 + 'filter', 3, +sub +#line 236 "Parser.yp" +{ $factory->filter(@_[3,1]) } + ], + [#Rule 82 + 'defblock', 5, +sub +#line 241 "Parser.yp" +{ my $name = join('/', @{ $_[0]->{ DEFBLOCKS } }); + pop(@{ $_[0]->{ DEFBLOCKS } }); + $_[0]->define_block($name, $_[4]); + undef + } + ], + [#Rule 83 + 'defblockname', 2, +sub +#line 248 "Parser.yp" +{ push(@{ $_[0]->{ DEFBLOCKS } }, $_[2]); + $_[2]; + } + ], + [#Rule 84 + 'blockname', 1, undef + ], + [#Rule 85 + 'blockname', 1, +sub +#line 254 "Parser.yp" +{ $_[1] =~ s/^'(.*)'$/$1/; $_[1] } + ], + [#Rule 86 + 'blockargs', 1, undef + ], + [#Rule 87 + 'blockargs', 0, undef + ], + [#Rule 88 + 'anonblock', 5, +sub +#line 262 "Parser.yp" +{ local $" = ', '; + print STDERR "experimental block args: [@{ $_[2] }]\n" + if $_[2]; + $factory->anon_block($_[4]) } + ], + [#Rule 89 + 'capture', 3, +sub +#line 268 "Parser.yp" +{ $factory->capture(@_[1, 3]) } + ], + [#Rule 90 + 'macro', 6, +sub +#line 272 "Parser.yp" +{ $factory->macro(@_[2, 6, 4]) } + ], + [#Rule 91 + 'macro', 3, +sub +#line 273 "Parser.yp" +{ $factory->macro(@_[2, 3]) } + ], + [#Rule 92 + 'mdir', 1, undef + ], + [#Rule 93 + 'mdir', 4, +sub +#line 277 "Parser.yp" +{ $_[3] } + ], + [#Rule 94 + 'margs', 2, +sub +#line 280 "Parser.yp" +{ push(@{$_[1]}, $_[2]); $_[1] } + ], + [#Rule 95 + 'margs', 2, +sub +#line 281 "Parser.yp" +{ $_[1] } + ], + [#Rule 96 + 'margs', 1, +sub +#line 282 "Parser.yp" +{ [ $_[1] ] } + ], + [#Rule 97 + 'metadata', 2, +sub +#line 285 "Parser.yp" +{ push(@{$_[1]}, @{$_[2]}); $_[1] } + ], + [#Rule 98 + 'metadata', 2, undef + ], + [#Rule 99 + 'metadata', 1, undef + ], + [#Rule 100 + 'meta', 3, +sub +#line 290 "Parser.yp" +{ for ($_[3]) { s/^'//; s/'$//; + s/\\'/'/g }; + [ @_[1,3] ] } + ], + [#Rule 101 + 'meta', 5, +sub +#line 293 "Parser.yp" +{ [ @_[1,4] ] } + ], + [#Rule 102 + 'meta', 3, +sub +#line 294 "Parser.yp" +{ [ @_[1,3] ] } + ], + [#Rule 103 + 'term', 1, undef + ], + [#Rule 104 + 'term', 1, undef + ], + [#Rule 105 + 'lterm', 3, +sub +#line 306 "Parser.yp" +{ "[ $_[2] ]" } + ], + [#Rule 106 + 'lterm', 3, +sub +#line 307 "Parser.yp" +{ "[ $_[2] ]" } + ], + [#Rule 107 + 'lterm', 2, +sub +#line 308 "Parser.yp" +{ "[ ]" } + ], + [#Rule 108 + 'lterm', 3, +sub +#line 309 "Parser.yp" +{ "{ $_[2] }" } + ], + [#Rule 109 + 'sterm', 1, +sub +#line 312 "Parser.yp" +{ $factory->ident($_[1]) } + ], + [#Rule 110 + 'sterm', 2, +sub +#line 313 "Parser.yp" +{ $factory->identref($_[2]) } + ], + [#Rule 111 + 'sterm', 3, +sub +#line 314 "Parser.yp" +{ $factory->quoted($_[2]) } + ], + [#Rule 112 + 'sterm', 1, undef + ], + [#Rule 113 + 'sterm', 1, undef + ], + [#Rule 114 + 'list', 2, +sub +#line 319 "Parser.yp" +{ "$_[1], $_[2]" } + ], + [#Rule 115 + 'list', 2, undef + ], + [#Rule 116 + 'list', 1, undef + ], + [#Rule 117 + 'range', 3, +sub +#line 324 "Parser.yp" +{ $_[1] . '..' . $_[3] } + ], + [#Rule 118 + 'hash', 1, undef + ], + [#Rule 119 + 'hash', 0, +sub +#line 329 "Parser.yp" +{ "" } + ], + [#Rule 120 + 'params', 2, +sub +#line 332 "Parser.yp" +{ "$_[1], $_[2]" } + ], + [#Rule 121 + 'params', 2, undef + ], + [#Rule 122 + 'params', 1, undef + ], + [#Rule 123 + 'param', 3, +sub +#line 337 "Parser.yp" +{ "$_[1] => $_[3]" } + ], + [#Rule 124 + 'param', 3, +sub +#line 338 "Parser.yp" +{ "$_[1] => $_[3]" } + ], + [#Rule 125 + 'ident', 3, +sub +#line 341 "Parser.yp" +{ push(@{$_[1]}, @{$_[3]}); $_[1] } + ], + [#Rule 126 + 'ident', 3, +sub +#line 342 "Parser.yp" +{ push(@{$_[1]}, + map {($_, 0)} split(/\./, $_[3])); + $_[1]; } + ], + [#Rule 127 + 'ident', 1, undef + ], + [#Rule 128 + 'node', 1, +sub +#line 348 "Parser.yp" +{ [ $_[1], 0 ] } + ], + [#Rule 129 + 'node', 4, +sub +#line 349 "Parser.yp" +{ [ $_[1], $factory->args($_[3]) ] } + ], + [#Rule 130 + 'item', 1, +sub +#line 352 "Parser.yp" +{ "'$_[1]'" } + ], + [#Rule 131 + 'item', 3, +sub +#line 353 "Parser.yp" +{ $_[2] } + ], + [#Rule 132 + 'item', 2, +sub +#line 354 "Parser.yp" +{ $_[0]->{ V1DOLLAR } + ? "'$_[2]'" + : $factory->ident(["'$_[2]'", 0]) } + ], + [#Rule 133 + 'expr', 3, +sub +#line 359 "Parser.yp" +{ "$_[1] $_[2] $_[3]" } + ], + [#Rule 134 + 'expr', 3, +sub +#line 360 "Parser.yp" +{ "$_[1] $_[2] $_[3]" } + ], + [#Rule 135 + 'expr', 3, +sub +#line 361 "Parser.yp" +{ "$_[1] $_[2] $_[3]" } + ], + [#Rule 136 + 'expr', 3, +sub +#line 362 "Parser.yp" +{ "int($_[1] / $_[3])" } + ], + [#Rule 137 + 'expr', 3, +sub +#line 363 "Parser.yp" +{ "$_[1] % $_[3]" } + ], + [#Rule 138 + 'expr', 3, +sub +#line 364 "Parser.yp" +{ "$_[1] $CMPOP{ $_[2] } $_[3]" } + ], + [#Rule 139 + 'expr', 3, +sub +#line 365 "Parser.yp" +{ "$_[1] . $_[3]" } + ], + [#Rule 140 + 'expr', 3, +sub +#line 366 "Parser.yp" +{ "$_[1] && $_[3]" } + ], + [#Rule 141 + 'expr', 3, +sub +#line 367 "Parser.yp" +{ "$_[1] || $_[3]" } + ], + [#Rule 142 + 'expr', 2, +sub +#line 368 "Parser.yp" +{ "! $_[2]" } + ], + [#Rule 143 + 'expr', 5, +sub +#line 369 "Parser.yp" +{ "$_[1] ? $_[3] : $_[5]" } + ], + [#Rule 144 + 'expr', 3, +sub +#line 370 "Parser.yp" +{ $factory->assign(@{$_[2]}) } + ], + [#Rule 145 + 'expr', 3, +sub +#line 371 "Parser.yp" +{ "($_[2])" } + ], + [#Rule 146 + 'expr', 1, undef + ], + [#Rule 147 + 'setlist', 2, +sub +#line 375 "Parser.yp" +{ push(@{$_[1]}, @{$_[2]}); $_[1] } + ], + [#Rule 148 + 'setlist', 2, undef + ], + [#Rule 149 + 'setlist', 1, undef + ], + [#Rule 150 + 'assign', 3, +sub +#line 381 "Parser.yp" +{ [ $_[1], $_[3] ] } + ], + [#Rule 151 + 'assign', 3, +sub +#line 382 "Parser.yp" +{ [ @_[1,3] ] } + ], + [#Rule 152 + 'args', 2, +sub +#line 389 "Parser.yp" +{ push(@{$_[1]}, $_[2]); $_[1] } + ], + [#Rule 153 + 'args', 2, +sub +#line 390 "Parser.yp" +{ push(@{$_[1]->[0]}, $_[2]); $_[1] } + ], + [#Rule 154 + 'args', 4, +sub +#line 391 "Parser.yp" +{ push(@{$_[1]->[0]}, "'', " . + $factory->assign(@_[2,4])); $_[1] } + ], + [#Rule 155 + 'args', 2, +sub +#line 393 "Parser.yp" +{ $_[1] } + ], + [#Rule 156 + 'args', 0, +sub +#line 394 "Parser.yp" +{ [ [ ] ] } + ], + [#Rule 157 + 'lnameargs', 3, +sub +#line 404 "Parser.yp" +{ push(@{$_[3]}, $_[1]); $_[3] } + ], + [#Rule 158 + 'lnameargs', 1, undef + ], + [#Rule 159 + 'lvalue', 1, undef + ], + [#Rule 160 + 'lvalue', 3, +sub +#line 409 "Parser.yp" +{ $factory->quoted($_[2]) } + ], + [#Rule 161 + 'lvalue', 1, undef + ], + [#Rule 162 + 'nameargs', 3, +sub +#line 413 "Parser.yp" +{ [ [$factory->ident($_[2])], $_[3] ] } + ], + [#Rule 163 + 'nameargs', 2, +sub +#line 414 "Parser.yp" +{ [ @_[1,2] ] } + ], + [#Rule 164 + 'nameargs', 4, +sub +#line 415 "Parser.yp" +{ [ @_[1,3] ] } + ], + [#Rule 165 + 'names', 3, +sub +#line 418 "Parser.yp" +{ push(@{$_[1]}, $_[3]); $_[1] } + ], + [#Rule 166 + 'names', 1, +sub +#line 419 "Parser.yp" +{ [ $_[1] ] } + ], + [#Rule 167 + 'name', 3, +sub +#line 422 "Parser.yp" +{ $factory->quoted($_[2]) } + ], + [#Rule 168 + 'name', 1, +sub +#line 423 "Parser.yp" +{ "'$_[1]'" } + ], + [#Rule 169 + 'name', 1, undef + ], + [#Rule 170 + 'filename', 3, +sub +#line 435 "Parser.yp" +{ "$_[1].$_[3]" } + ], + [#Rule 171 + 'filename', 1, undef + ], + [#Rule 172 + 'filepart', 1, undef + ], + [#Rule 173 + 'filepart', 1, undef + ], + [#Rule 174 + 'filepart', 1, undef + ], + [#Rule 175 + 'quoted', 2, +sub +#line 449 "Parser.yp" +{ push(@{$_[1]}, $_[2]) + if defined $_[2]; $_[1] } + ], + [#Rule 176 + 'quoted', 0, +sub +#line 451 "Parser.yp" +{ [ ] } + ], + [#Rule 177 + 'quotable', 1, +sub +#line 454 "Parser.yp" +{ $factory->ident($_[1]) } + ], + [#Rule 178 + 'quotable', 1, +sub +#line 455 "Parser.yp" +{ $factory->text($_[1]) } + ], + [#Rule 179 + 'quotable', 1, +sub +#line 456 "Parser.yp" +{ undef } + ] +]; + + + +1; + + + + + + + + + + + + diff --git a/lib/Template/Iterator.pm b/lib/Template/Iterator.pm new file mode 100644 index 0000000..0063b6e --- /dev/null +++ b/lib/Template/Iterator.pm @@ -0,0 +1,446 @@ +#============================================================= -*-Perl-*- +# +# Template::Iterator +# +# DESCRIPTION +# +# Module defining an iterator class which is used by the FOREACH +# directive for iterating through data sets. This may be +# sub-classed to define more specific iterator types. +# +# An iterator is an object which provides a consistent way to +# navigate through data which may have a complex underlying form. +# This implementation uses the get_first() and get_next() methods to +# iterate through a dataset. The get_first() method is called once +# to perform any data initialisation and return the first value, +# then get_next() is called repeatedly to return successive values. +# Both these methods return a pair of values which are the data item +# itself and a status code. The default implementation handles +# iteration through an array (list) of elements which is passed by +# reference to the constructor. An empty list is used if none is +# passed. The module may be sub-classed to provide custom +# implementations which iterate through any kind of data in any +# manner as long as it can conforms to the get_first()/get_next() +# interface. The object also implements the get_all() method for +# returning all remaining elements as a list reference. +# +# For further information on iterators see "Design Patterns", by the +# "Gang of Four" (Erich Gamma, Richard Helm, Ralph Johnson, John +# Vlissides), Addision-Wesley, ISBN 0-201-63361-2. +# +# AUTHOR +# Andy Wardley <abw@kfs.org> +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#---------------------------------------------------------------------------- +# +# $Id: Iterator.pm,v 2.59 2003/04/24 09:14:38 abw Exp $ +# +#============================================================================ + +package Template::Iterator; + +require 5.004; + +use strict; +use vars qw( $VERSION $DEBUG $AUTOLOAD ); # AUTO? +use base qw( Template::Base ); +use Template::Constants; +use Template::Exception; + +$VERSION = sprintf("%d.%02d", q$Revision: 2.59 $ =~ /(\d+)\.(\d+)/); +$DEBUG = 0 unless defined $DEBUG; + + +#======================================================================== +# ----- CLASS METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# new(\@target, \%options) +# +# Constructor method which creates and returns a reference to a new +# Template::Iterator object. A reference to the target data (array +# or hash) may be passed for the object to iterate through. +#------------------------------------------------------------------------ + +sub new { + my $class = shift; + my $data = shift || [ ]; + my $params = shift || { }; + + if (ref $data eq 'HASH') { + # map a hash into a list of { key => ???, value => ??? } hashes, + # one for each key, sorted by keys + $data = [ map { { key => $_, value => $data->{ $_ } } } + sort keys %$data ]; + } + elsif (UNIVERSAL::can($data, 'as_list')) { + $data = $data->as_list(); + } + elsif (ref $data ne 'ARRAY') { + # coerce any non-list data into an array reference + $data = [ $data ] ; + } + + bless { + _DATA => $data, + _ERROR => '', + }, $class; +} + + +#======================================================================== +# ----- PUBLIC OBJECT METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# get_first() +# +# Initialises the object for iterating through the target data set. The +# first record is returned, if defined, along with the STATUS_OK value. +# If there is no target data, or the data is an empty set, then undef +# is returned with the STATUS_DONE value. +#------------------------------------------------------------------------ + +sub get_first { + my $self = shift; + my $data = $self->{ _DATA }; + + $self->{ _DATASET } = $self->{ _DATA }; + my $size = scalar @$data; + my $index = 0; + + return (undef, Template::Constants::STATUS_DONE) unless $size; + + # initialise various counters, flags, etc. + @$self{ qw( SIZE MAX INDEX COUNT FIRST LAST ) } + = ( $size, $size - 1, $index, 1, 1, $size > 1 ? 0 : 1, undef ); + @$self{ qw( PREV NEXT ) } = ( undef, $self->{ _DATASET }->[ $index + 1 ]); + + return $self->{ _DATASET }->[ $index ]; +} + + + +#------------------------------------------------------------------------ +# get_next() +# +# Called repeatedly to access successive elements in the data set. +# Should only be called after calling get_first() or a warning will +# be raised and (undef, STATUS_DONE) returned. +#------------------------------------------------------------------------ + +sub get_next { + my $self = shift; + my ($max, $index) = @$self{ qw( MAX INDEX ) }; + my $data = $self->{ _DATASET }; + + # warn about incorrect usage + unless (defined $index) { + my ($pack, $file, $line) = caller(); + warn("iterator get_next() called before get_first() at $file line $line\n"); + return (undef, Template::Constants::STATUS_DONE); ## RETURN ## + } + + # if there's still some data to go... + if ($index < $max) { + # update counters and flags + $index++; + @$self{ qw( INDEX COUNT FIRST LAST ) } + = ( $index, $index + 1, 0, $index == $max ? 1 : 0 ); + @$self{ qw( PREV NEXT ) } = @$data[ $index - 1, $index + 1 ]; + return $data->[ $index ]; ## RETURN ## + } + else { + return (undef, Template::Constants::STATUS_DONE); ## RETURN ## + } +} + + +#------------------------------------------------------------------------ +# get_all() +# +# Method which returns all remaining items in the iterator as a Perl list +# reference. May be called at any time in the life-cycle of the iterator. +# The get_first() method will be called automatically if necessary, and +# then subsequent get_next() calls are made, storing each returned +# result until the list is exhausted. +#------------------------------------------------------------------------ + +sub get_all { + my $self = shift; + my ($max, $index) = @$self{ qw( MAX INDEX ) }; + my @data; + + # if there's still some data to go... + if ($index < $max) { + $index++; + @data = @{ $self->{ _DATASET } } [ $index..$max ]; + + # update counters and flags + @$self{ qw( INDEX COUNT FIRST LAST ) } + = ( $max, $max + 1, 0, 1 ); + + return \@data; ## RETURN ## + } + else { + return (undef, Template::Constants::STATUS_DONE); ## RETURN ## + } +} + + +#------------------------------------------------------------------------ +# AUTOLOAD +# +# Provides access to internal fields (e.g. size, first, last, max, etc) +#------------------------------------------------------------------------ + +sub AUTOLOAD { + my $self = shift; + my $item = $AUTOLOAD; + $item =~ s/.*:://; + return if $item eq 'DESTROY'; + + # alias NUMBER to COUNT for backwards compatability + $item = 'COUNT' if $item =~ /NUMBER/i; + + return $self->{ uc $item }; +} + + +#======================================================================== +# ----- PRIVATE DEBUG METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# _dump() +# +# Debug method which returns a string detailing the internal state of +# the iterator object. +#------------------------------------------------------------------------ + +sub _dump { + my $self = shift; + join('', + " Data: ", $self->{ _DATA }, "\n", + " Index: ", $self->{ INDEX }, "\n", + "Number: ", $self->{ NUMBER }, "\n", + " Max: ", $self->{ MAX }, "\n", + " Size: ", $self->{ SIZE }, "\n", + " First: ", $self->{ FIRST }, "\n", + " Last: ", $self->{ LAST }, "\n", + "\n" + ); +} + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Iterator - Data iterator used by the FOREACH directive + +=head1 SYNOPSIS + + my $iter = Template::Iterator->new(\@data, \%options); + +=head1 DESCRIPTION + +The Template::Iterator module defines a generic data iterator for use +by the FOREACH directive. + +It may be used as the base class for custom iterators. + +=head1 PUBLIC METHODS + +=head2 new($data) + +Constructor method. A reference to a list of values is passed as the +first parameter. Subsequent calls to get_first() and get_next() calls +will return each element from the list. + + my $iter = Template::Iterator->new([ 'foo', 'bar', 'baz' ]); + +The constructor will also accept a reference to a hash array and will +expand it into a list in which each entry is a hash array containing +a 'key' and 'value' item, sorted according to the hash keys. + + my $iter = Template::Iterator->new({ + foo => 'Foo Item', + bar => 'Bar Item', + }); + +This is equivalent to: + + my $iter = Template::Iterator->new([ + { key => 'bar', value => 'Bar Item' }, + { key => 'foo', value => 'Foo Item' }, + ]); + +When passed a single item which is not an array reference, the constructor +will automatically create a list containing that single item. + + my $iter = Template::Iterator->new('foo'); + +This is equivalent to: + + my $iter = Template::Iterator->new([ 'foo' ]); + +Note that a single item which is an object based on a blessed ARRAY +references will NOT be treated as an array and will be folded into +a list containing that one object reference. + + my $list = bless [ 'foo', 'bar' ], 'MyListClass'; + my $iter = Template::Iterator->new($list); + +equivalent to: + + my $iter = Template::Iterator->new([ $list ]); + +If the object provides an as_list() method then the Template::Iterator +constructor will call that method to return the list of data. For example: + + package MyListObject; + + sub new { + my $class = shift; + bless [ @_ ], $class; + } + + package main; + + my $list = MyListObject->new('foo', 'bar'); + my $iter = Template::Iterator->new($list); + +This is then functionally equivalent to: + + my $iter = Template::Iterator->new([ $list ]); + +The iterator will return only one item, a reference to the MyListObject +object, $list. + +By adding an as_list() method to the MyListObject class, we can force +the Template::Iterator constructor to treat the object as a list and +use the data contained within. + + package MyListObject; + + ... + + sub as_list { + my $self = shift; + return $self; + } + + package main; + + my $list = MyListObject->new('foo', 'bar'); + my $iter = Template::Iterator->new($list); + +The iterator will now return the two item, 'foo' and 'bar', which the +MyObjectList encapsulates. + +=head2 get_first() + +Returns a ($value, $error) pair for the first item in the iterator set. +The $error returned may be zero or undefined to indicate a valid datum +was successfully returned. Returns an error of STATUS_DONE if the list +is empty. + +=head2 get_next() + +Returns a ($value, $error) pair for the next item in the iterator set. +Returns an error of STATUS_DONE if all items in the list have been +visited. + +=head2 get_all() + +Returns a (\@values, $error) pair for all remaining items in the iterator +set. Returns an error of STATUS_DONE if all items in the list have been +visited. + +=head2 size() + +Returns the size of the data set or undef if unknown. + +=head2 max() + +Returns the maximum index number (i.e. the index of the last element) +which is equivalent to size() - 1. + +=head2 index() + +Returns the current index number which is in the range 0 to max(). + +=head2 count() + +Returns the current iteration count in the range 1 to size(). This is +equivalent to index() + 1. Note that number() is supported as an alias +for count() for backwards compatability. + +=head2 first() + +Returns a boolean value to indicate if the iterator is currently on +the first iteration of the set. + +=head2 last() + +Returns a boolean value to indicate if the iterator is currently on +the last iteration of the set. + +=head2 prev() + +Returns the previous item in the data set, or undef if the iterator is +on the first item. + +=head2 next() + +Returns the next item in the data set or undef if the iterator is on the +last item. + +=head1 AUTHOR + +Andy Wardley E<lt>abw@andywardley.comE<gt> + +L<http://www.andywardley.com/|http://www.andywardley.com/> + + + + +=head1 VERSION + +2.59, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L<Template|Template> diff --git a/lib/Template/Namespace/Constants.pm b/lib/Template/Namespace/Constants.pm new file mode 100644 index 0000000..76e5366 --- /dev/null +++ b/lib/Template/Namespace/Constants.pm @@ -0,0 +1,195 @@ +#================================================================= -*-Perl-*- +# +# Template::Namespace::Constants +# +# DESCRIPTION +# Plugin compiler module for performing constant folding at compile time +# on variables in a particular namespace. +# +# AUTHOR +# Andy Wardley <abw@andywardley.com> +# +# COPYRIGHT +# Copyright (C) 1996-2002 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +# REVISION +# $Id: Constants.pm,v 1.17 2003/04/24 09:14:42 abw Exp $ +# +#============================================================================ + +package Template::Namespace::Constants; + +use strict; +use Template::Base; +use Template::Config; +use Template::Directive; +use Template::Exception; + +use base qw( Template::Base ); +use vars qw( $VERSION $DEBUG ); + +$VERSION = sprintf("%d.%02d", q$Revision: 1.17 $ =~ /(\d+)\.(\d+)/); +$DEBUG = 0 unless defined $DEBUG; + + +sub _init { + my ($self, $config) = @_; + $self->{ STASH } = Template::Config->stash($config) + || return $self->error(Template::Config->error()); + return $self; +} + + + +#------------------------------------------------------------------------ +# ident(\@ident) foo.bar(baz) +#------------------------------------------------------------------------ + +sub ident { + my ($self, $ident) = @_; + my @save = @$ident; + + # discard first node indicating constants namespace + splice(@$ident, 0, 2); + + my $nelems = @$ident / 2; + my ($e, $result); + local $" = ', '; + + print STDERR "constant ident [ @$ident ] " if $DEBUG; + + foreach $e (0..$nelems-1) { + # node name must be a constant + unless ($ident->[$e * 2] =~ s/^'(.+)'$/$1/s) { + $self->DEBUG(" * deferred (non-constant item: ", $ident->[$e * 2], ")\n") + if $DEBUG; + return Template::Directive->ident(\@save); + } + + # if args is non-zero then it must be eval'ed + if ($ident->[$e * 2 + 1]) { + my $args = $ident->[$e * 2 + 1]; + my $comp = eval "$args"; + if ($@) { + $self->DEBUG(" * deferred (non-constant args: $args)\n") if $DEBUG; + return Template::Directive->ident(\@save); + } + $self->DEBUG("($args) ") if $comp && $DEBUG; + $ident->[$e * 2 + 1] = $comp; + } + } + + + $result = $self->{ STASH }->get($ident); + + if (! length $result || ref $result) { + my $reason = length $result ? 'reference' : 'no result'; + $self->DEBUG(" * deferred ($reason)\n") if $DEBUG; + return Template::Directive->ident(\@save); + } + + $result =~ s/'/\\'/g; + + $self->DEBUG(" * resolved => '$result'\n") if $DEBUG; + + return "'$result'"; +} + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Namespace::Constants - Compile time constant folding + +=head1 SYNOPSIS + + # easy way to define constants + use Template; + + my $tt = Template->new({ + CONSTANTS => { + pi => 3.14, + e => 2.718, + }, + }); + + # nitty-gritty, hands-dirty way + use Template::Namespace::Constants; + + my $tt = Template->new({ + NAMESPACE => { + constants => Template::Namespace::Constants->new({ + pi => 3.14, + e => 2.718, + }, + }, + }); + +=head1 DESCRIPTION + +The Template::Namespace::Constants module implements a namespace handler +which is plugged into the Template::Directive compiler module. This then +performs compile time constant folding of variables in a particular namespace. + +=head1 PUBLIC METHODS + +=head2 new(\%constants) + +The new() constructor method creates and returns a reference to a new +Template::Namespace::Constants object. This creates an internal stash +to store the constant variable definitions passed as arguments. + + my $handler = Template::Namespace::Constants->new({ + pi => 3.14, + e => 2.718, + }); + +=head2 ident(\@ident) + +Method called to resolve a variable identifier into a compiled form. In this +case, the method fetches the corresponding constant value from its internal +stash and returns it. + +=head1 AUTHOR + +Andy Wardley E<lt>abw@andywardley.comE<gt> + +L<http://www.andywardley.com/|http://www.andywardley.com/> + + + + +=head1 VERSION + +1.17, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L<Template::Directive|Template::Directive> diff --git a/lib/Template/Parser.pm b/lib/Template/Parser.pm new file mode 100644 index 0000000..34f777d --- /dev/null +++ b/lib/Template/Parser.pm @@ -0,0 +1,1434 @@ +#============================================================= -*-Perl-*- +# +# Template::Parser +# +# DESCRIPTION +# This module implements a LALR(1) parser and assocated support +# methods to parse template documents into the appropriate "compiled" +# format. Much of the parser DFA code (see _parse() method) is based +# on Francois Desarmenien's Parse::Yapp module. Kudos to him. +# +# AUTHOR +# Andy Wardley <abw@kfs.org> +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +# The following copyright notice appears in the Parse::Yapp +# documentation. +# +# The Parse::Yapp module and its related modules and shell +# scripts are copyright (c) 1998 Francois Desarmenien, +# France. All rights reserved. +# +# You may use and distribute them under the terms of either +# the GNU General Public License or the Artistic License, as +# specified in the Perl README file. +# +#---------------------------------------------------------------------------- +# +# $Id: Parser.pm,v 2.75 2003/07/01 12:44:56 darren Exp $ +# +#============================================================================ + +package Template::Parser; + +require 5.004; + +use strict; +use vars qw( $VERSION $DEBUG $ERROR ); +use base qw( Template::Base ); +use vars qw( $TAG_STYLE $DEFAULT_STYLE $QUOTED_ESCAPES ); + +use Template::Constants qw( :status :chomp ); +use Template::Directive; +use Template::Grammar; + +# parser state constants +use constant CONTINUE => 0; +use constant ACCEPT => 1; +use constant ERROR => 2; +use constant ABORT => 3; + +$VERSION = sprintf("%d.%02d", q$Revision: 2.75 $ =~ /(\d+)\.(\d+)/); +$DEBUG = 0 unless defined $DEBUG; +$ERROR = ''; + + +#======================================================================== +# -- COMMON TAG STYLES -- +#======================================================================== + +$TAG_STYLE = { + 'default' => [ '\[%', '%\]' ], + 'template1' => [ '[\[%]%', '%[\]%]' ], + 'metatext' => [ '%%', '%%' ], + 'html' => [ '<!--', '-->' ], + 'mason' => [ '<%', '>' ], + 'asp' => [ '<%', '%>' ], + 'php' => [ '<\?', '\?>' ], + 'star' => [ '\[\*', '\*\]' ], +}; +$TAG_STYLE->{ template } = $TAG_STYLE->{ tt2 } = $TAG_STYLE->{ default }; + + +$DEFAULT_STYLE = { + START_TAG => $TAG_STYLE->{ default }->[0], + END_TAG => $TAG_STYLE->{ default }->[1], +# TAG_STYLE => 'default', + ANYCASE => 0, + INTERPOLATE => 0, + PRE_CHOMP => 0, + POST_CHOMP => 0, + V1DOLLAR => 0, + EVAL_PERL => 0, +}; + +$QUOTED_ESCAPES = { + n => "\n", + r => "\r", + t => "\t", +}; + + +#======================================================================== +# ----- PUBLIC METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# new(\%config) +# +# Constructor method. +#------------------------------------------------------------------------ + +sub new { + my $class = shift; + my $config = $_[0] && UNIVERSAL::isa($_[0], 'HASH') ? shift(@_) : { @_ }; + my ($tagstyle, $debug, $start, $end, $defaults, $grammar, $hash, $key, $udef); + + my $self = bless { + START_TAG => undef, + END_TAG => undef, + TAG_STYLE => 'default', + ANYCASE => 0, + INTERPOLATE => 0, + PRE_CHOMP => 0, + POST_CHOMP => 0, + V1DOLLAR => 0, + EVAL_PERL => 0, + GRAMMAR => undef, + _ERROR => '', + FACTORY => 'Template::Directive', + }, $class; + + # update self with any relevant keys in config + foreach $key (keys %$self) { + $self->{ $key } = $config->{ $key } if defined $config->{ $key }; + } + $self->{ FILEINFO } = [ ]; + + # DEBUG config item can be a bitmask + if (defined ($debug = $config->{ DEBUG })) { + $self->{ DEBUG } = $debug & ( Template::Constants::DEBUG_PARSER + | Template::Constants::DEBUG_FLAGS ); + $self->{ DEBUG_DIRS } = $debug & Template::Constants::DEBUG_DIRS; + } + # package variable can be set to 1 to support previous behaviour + elsif ($DEBUG == 1) { + $self->{ DEBUG } = Template::Constants::DEBUG_PARSER; + $self->{ DEBUG_DIRS } = 0; + } + # otherwise let $DEBUG be a bitmask + else { + $self->{ DEBUG } = $DEBUG & ( Template::Constants::DEBUG_PARSER + | Template::Constants::DEBUG_FLAGS ); + $self->{ DEBUG_DIRS } = $DEBUG & Template::Constants::DEBUG_DIRS; + } + + $grammar = $self->{ GRAMMAR } ||= do { + require Template::Grammar; + Template::Grammar->new(); + }; + + # build a FACTORY object to include any NAMESPACE definitions, + # but only if FACTORY isn't already an object + if ($config->{ NAMESPACE } && ! ref $self->{ FACTORY }) { + my $fclass = $self->{ FACTORY }; + $self->{ FACTORY } = $fclass->new( NAMESPACE => $config->{ NAMESPACE } ) + || return $class->error($fclass->error()); + } + + +# # determine START_TAG and END_TAG for specified (or default) TAG_STYLE +# $tagstyle = $self->{ TAG_STYLE } || 'default'; +# return $class->error("Invalid tag style: $tagstyle") +# unless defined ($start = $TAG_STYLE->{ $tagstyle }); +# ($start, $end) = @$start; +# +# $self->{ START_TAG } ||= $start; +# $self->{ END_TAG } ||= $end; + + # load grammar rules, states and lex table + @$self{ qw( LEXTABLE STATES RULES ) } + = @$grammar{ qw( LEXTABLE STATES RULES ) }; + + $self->new_style($config) + || return $class->error($self->error()); + + return $self; +} + + +#------------------------------------------------------------------------ +# new_style(\%config) +# +# Install a new (stacked) parser style. This feature is currently +# experimental but should mimic the previous behaviour with regard to +# TAG_STYLE, START_TAG, END_TAG, etc. +#------------------------------------------------------------------------ + +sub new_style { + my ($self, $config) = @_; + my $styles = $self->{ STYLE } ||= [ ]; + my ($tagstyle, $tags, $start, $end, $key); + + # clone new style from previous or default style + my $style = { %{ $styles->[-1] || $DEFAULT_STYLE } }; + + # expand START_TAG and END_TAG from specified TAG_STYLE + if ($tagstyle = $config->{ TAG_STYLE }) { + return $self->error("Invalid tag style: $tagstyle") + unless defined ($tags = $TAG_STYLE->{ $tagstyle }); + ($start, $end) = @$tags; + $config->{ START_TAG } ||= $start; + $config->{ END_TAG } ||= $end; + } + + foreach $key (keys %$DEFAULT_STYLE) { + $style->{ $key } = $config->{ $key } if defined $config->{ $key }; + } + push(@$styles, $style); + return $style; +} + + +#------------------------------------------------------------------------ +# old_style() +# +# Pop the current parser style and revert to the previous one. See +# new_style(). ** experimental ** +#------------------------------------------------------------------------ + +sub old_style { + my $self = shift; + my $styles = $self->{ STYLE }; + return $self->error('only 1 parser style remaining') + unless (@$styles > 1); + pop @$styles; + return $styles->[-1]; +} + + +#------------------------------------------------------------------------ +# parse($text, $data) +# +# Parses the text string, $text and returns a hash array representing +# the compiled template block(s) as Perl code, in the format expected +# by Template::Document. +#------------------------------------------------------------------------ + +sub parse { + my ($self, $text, $info) = @_; + my ($tokens, $block); + + $info->{ DEBUG } = $self->{ DEBUG_DIRS } + unless defined $info->{ DEBUG }; + +# print "info: { ", join(', ', map { "$_ => $info->{ $_ }" } keys %$info), " }\n"; + + # store for blocks defined in the template (see define_block()) + my $defblock = $self->{ DEFBLOCK } = { }; + my $metadata = $self->{ METADATA } = [ ]; + + $self->{ _ERROR } = ''; + + # split file into TEXT/DIRECTIVE chunks + $tokens = $self->split_text($text) + || return undef; ## RETURN ## + + push(@{ $self->{ FILEINFO } }, $info); + + # parse chunks + $block = $self->_parse($tokens, $info); + + pop(@{ $self->{ FILEINFO } }); + + return undef unless $block; ## RETURN ## + + $self->debug("compiled main template document block:\n$block") + if $self->{ DEBUG } & Template::Constants::DEBUG_PARSER; + + return { + BLOCK => $block, + DEFBLOCKS => $defblock, + METADATA => { @$metadata }, + }; +} + + + +#------------------------------------------------------------------------ +# split_text($text) +# +# Split input template text into directives and raw text chunks. +#------------------------------------------------------------------------ + +sub split_text { + my ($self, $text) = @_; + my ($pre, $dir, $prelines, $dirlines, $postlines, $chomp, $tags, @tags); + my $style = $self->{ STYLE }->[-1]; + my ($start, $end, $prechomp, $postchomp, $interp ) = + @$style{ qw( START_TAG END_TAG PRE_CHOMP POST_CHOMP INTERPOLATE ) }; + + my @tokens = (); + my $line = 1; + + return \@tokens ## RETURN ## + unless defined $text && length $text; + + # extract all directives from the text + while ($text =~ s/ + ^(.*?) # $1 - start of line up to directive + (?: + $start # start of tag + (.*?) # $2 - tag contents + $end # end of tag + ) + //sx) { + + ($pre, $dir) = ($1, $2); + $pre = '' unless defined $pre; + $dir = '' unless defined $dir; + + $postlines = 0; # denotes lines chomped + $prelines = ($pre =~ tr/\n//); # NULL - count only + $dirlines = ($dir =~ tr/\n//); # ditto + + # the directive CHOMP options may modify the preceding text + for ($dir) { + # remove leading whitespace and check for a '-' chomp flag + s/^([-+\#])?\s*//s; + if ($1 && $1 eq '#') { + # comment out entire directive except for any chomp flag + $dir = ($dir =~ /([-+])$/) ? $1 : ''; + } + else { + $chomp = ($1 && $1 eq '+') ? 0 : ($1 || $prechomp); +# my $space = $prechomp == &Template::Constants::CHOMP_COLLAPSE + my $space = $prechomp == CHOMP_COLLAPSE + ? ' ' : ''; + + # chomp off whitespace and newline preceding directive + $chomp and $pre =~ s/(\n|^)([ \t]*)\Z/($1||$2) ? $space : ''/me + and $1 eq "\n" + and $prelines++; + } + + # remove trailing whitespace and check for a '-' chomp flag + s/\s*([-+])?\s*$//s; + $chomp = ($1 && $1 eq '+') ? 0 : ($1 || $postchomp); + my $space = $postchomp == &Template::Constants::CHOMP_COLLAPSE + ? ' ' : ''; + + $postlines++ + if $chomp and $text =~ s/ + ^ + ([ \t]*)\n # whitespace to newline + (?:(.|\n)|$) # any char (not EOF) + / + (($1||$2) ? $space : '') . (defined $2 ? $2 : '') + /ex; + } + + # any text preceding the directive can now be added + if (length $pre) { + push(@tokens, $interp + ? [ $pre, $line, 'ITEXT' ] + : ('TEXT', $pre) ); + $line += $prelines; + } + + # and now the directive, along with line number information + if (length $dir) { + # the TAGS directive is a compile-time switch + if ($dir =~ /^TAGS\s+(.*)/i) { + my @tags = split(/\s+/, $1); + if (scalar @tags > 1) { + ($start, $end) = map { quotemeta($_) } @tags; + } + elsif ($tags = $TAG_STYLE->{ $tags[0] }) { + ($start, $end) = @$tags; + } + else { + warn "invalid TAGS style: $tags[0]\n"; + } + } + else { + # DIRECTIVE is pushed as [ $dirtext, $line_no(s), \@tokens ] + push(@tokens, [ $dir, + ($dirlines + ? sprintf("%d-%d", $line, $line + $dirlines) + : $line), + $self->tokenise_directive($dir) ]); + } + } + + # update line counter to include directive lines and any extra + # newline chomped off the start of the following text + $line += $dirlines + $postlines; + } + + # anything remaining in the string is plain text + push(@tokens, $interp + ? [ $text, $line, 'ITEXT' ] + : ( 'TEXT', $text) ) + if length $text; + + return \@tokens; ## RETURN ## +} + + + +#------------------------------------------------------------------------ +# interpolate_text($text, $line) +# +# Examines $text looking for any variable references embedded like +# $this or like ${ this }. +#------------------------------------------------------------------------ + +sub interpolate_text { + my ($self, $text, $line) = @_; + my @tokens = (); + my ($pre, $var, $dir); + + + while ($text =~ + / + ( (?: \\. | [^\$] ){1,3000} ) # escaped or non-'$' character [$1] + | + ( \$ (?: # embedded variable [$2] + (?: \{ ([^\}]*) \} ) # ${ ... } [$3] + | + ([\w\.]+) # $word [$4] + ) + ) + /gx) { + + ($pre, $var, $dir) = ($1, $3 || $4, $2); + + # preceding text + if (defined($pre) && length($pre)) { + $line += $pre =~ tr/\n//; + $pre =~ s/\\\$/\$/g; + push(@tokens, 'TEXT', $pre); + } + # $variable reference + if ($var) { + $line += $dir =~ tr/\n/ /; + push(@tokens, [ $dir, $line, $self->tokenise_directive($var) ]); + } + # other '$' reference - treated as text + elsif ($dir) { + $line += $dir =~ tr/\n//; + push(@tokens, 'TEXT', $dir); + } + } + + return \@tokens; +} + + + +#------------------------------------------------------------------------ +# tokenise_directive($text) +# +# Called by the private _parse() method when it encounters a DIRECTIVE +# token in the list provided by the split_text() or interpolate_text() +# methods. The directive text is passed by parameter. +# +# The method splits the directive into individual tokens as recognised +# by the parser grammar (see Template::Grammar for details). It +# constructs a list of tokens each represented by 2 elements, as per +# split_text() et al. The first element contains the token type, the +# second the token itself. +# +# The method tokenises the string using a complex (but fast) regex. +# For a deeper understanding of the regex magic at work here, see +# Jeffrey Friedl's excellent book "Mastering Regular Expressions", +# from O'Reilly, ISBN 1-56592-257-3 +# +# Returns a reference to the list of chunks (each one being 2 elements) +# identified in the directive text. On error, the internal _ERROR string +# is set and undef is returned. +#------------------------------------------------------------------------ + +sub tokenise_directive { + my ($self, $text, $line) = @_; + my ($token, $uctoken, $type, $lookup); + my $lextable = $self->{ LEXTABLE }; + my $style = $self->{ STYLE }->[-1]; + my ($anycase, $start, $end) = @$style{ qw( ANYCASE START_TAG END_TAG ) }; + my @tokens = ( ); + + while ($text =~ + / + # strip out any comments + (\#[^\n]*) + | + # a quoted phrase matches in $3 + (["']) # $2 - opening quote, ' or " + ( # $3 - quoted text buffer + (?: # repeat group (no backreference) + \\\\ # an escaped backslash \\ + | # ...or... + \\\2 # an escaped quote \" or \' (match $1) + | # ...or... + . # any other character + | \n + )*? # non-greedy repeat + ) # end of $3 + \2 # match opening quote + | + # an unquoted number matches in $4 + (-?\d+(?:\.\d+)?) # numbers + | + # filename matches in $5 + ( \/?\w+(?:(?:\/|::?)\w*)+ | \/\w+) + | + # an identifier matches in $6 + (\w+) # variable identifier + | + # an unquoted word or symbol matches in $7 + ( [(){}\[\]:;,\/\\] # misc parenthesis and symbols +# | \-> # arrow operator (for future?) + | [+\-*] # math operations + | \$\{? # dollar with option left brace + | => # like '=' + | [=!<>]?= | [!<>] # eqality tests + | &&? | \|\|? # boolean ops + | \.\.? # n..n sequence + | \S+ # something unquoted + ) # end of $7 + /gmxo) { + + # ignore comments to EOL + next if $1; + + # quoted string + if (defined ($token = $3)) { + # double-quoted string may include $variable references + if ($2 eq '"') { + if ($token =~ /[\$\\]/) { + $type = 'QUOTED'; + # unescape " and \ but leave \$ escaped so that + # interpolate_text() doesn't incorrectly treat it + # as a variable reference +# $token =~ s/\\([\\"])/$1/g; + for ($token) { + s/\\([^\$nrt])/$1/g; + s/\\([nrt])/$QUOTED_ESCAPES->{ $1 }/ge; + } + push(@tokens, ('"') x 2, + @{ $self->interpolate_text($token) }, + ('"') x 2); + next; + } + else { + $type = 'LITERAL'; + $token =~ s['][\\']g; + $token = "'$token'"; + } + } + else { + $type = 'LITERAL'; + $token = "'$token'"; + } + } + # number + elsif (defined ($token = $4)) { + $type = 'NUMBER'; + } + elsif (defined($token = $5)) { + $type = 'FILENAME'; + } + elsif (defined($token = $6)) { + # reserved words may be in lower case unless case sensitive + $uctoken = $anycase ? uc $token : $token; + if (defined ($type = $lextable->{ $uctoken })) { + $token = $uctoken; + } + else { + $type = 'IDENT'; + } + } + elsif (defined ($token = $7)) { + # reserved words may be in lower case unless case sensitive + $uctoken = $anycase ? uc $token : $token; + unless (defined ($type = $lextable->{ $uctoken })) { + $type = 'UNQUOTED'; + } + } + + push(@tokens, $type, $token); + +# print(STDERR " +[ $type, $token ]\n") +# if $DEBUG; + } + +# print STDERR "tokenise directive() returning:\n [ @tokens ]\n" +# if $DEBUG; + + return \@tokens; ## RETURN ## +} + + +#------------------------------------------------------------------------ +# define_block($name, $block) +# +# Called by the parser 'defblock' rule when a BLOCK definition is +# encountered in the template. The name of the block is passed in the +# first parameter and a reference to the compiled block is passed in +# the second. This method stores the block in the $self->{ DEFBLOCK } +# hash which has been initialised by parse() and will later be used +# by the same method to call the store() method on the calling cache +# to define the block "externally". +#------------------------------------------------------------------------ + +sub define_block { + my ($self, $name, $block) = @_; + my $defblock = $self->{ DEFBLOCK } + || return undef; + + $self->debug("compiled block '$name':\n$block") + if $self->{ DEBUG } & Template::Constants::DEBUG_PARSER; + + $defblock->{ $name } = $block; + + return undef; +} + +sub push_defblock { + my $self = shift; + my $stack = $self->{ DEFBLOCK_STACK } ||= []; + push(@$stack, $self->{ DEFBLOCK } ); + $self->{ DEFBLOCK } = { }; +} + +sub pop_defblock { + my $self = shift; + my $defs = $self->{ DEFBLOCK }; + my $stack = $self->{ DEFBLOCK_STACK } || return $defs; + return $defs unless @$stack; + $self->{ DEFBLOCK } = pop @$stack; + return $defs; +} + + +#------------------------------------------------------------------------ +# add_metadata(\@setlist) +#------------------------------------------------------------------------ + +sub add_metadata { + my ($self, $setlist) = @_; + my $metadata = $self->{ METADATA } + || return undef; + + push(@$metadata, @$setlist); + + return undef; +} + + +#======================================================================== +# ----- PRIVATE METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# _parse(\@tokens, \@info) +# +# Parses the list of input tokens passed by reference and returns a +# Template::Directive::Block object which contains the compiled +# representation of the template. +# +# This is the main parser DFA loop. See embedded comments for +# further details. +# +# On error, undef is returned and the internal _ERROR field is set to +# indicate the error. This can be retrieved by calling the error() +# method. +#------------------------------------------------------------------------ + +sub _parse { + my ($self, $tokens, $info) = @_; + my ($token, $value, $text, $line, $inperl); + my ($state, $stateno, $status, $action, $lookup, $coderet, @codevars); + my ($lhs, $len, $code); # rule contents + my $stack = [ [ 0, undef ] ]; # DFA stack + +# DEBUG +# local $" = ', '; + + # retrieve internal rule and state tables + my ($states, $rules) = @$self{ qw( STATES RULES ) }; + + # call the grammar set_factory method to install emitter factory + $self->{ GRAMMAR }->install_factory($self->{ FACTORY }); + + $line = $inperl = 0; + $self->{ LINE } = \$line; + $self->{ INPERL } = \$inperl; + + $status = CONTINUE; + my $in_string = 0; + + while(1) { + # get state number and state + $stateno = $stack->[-1]->[0]; + $state = $states->[$stateno]; + + # see if any lookaheads exist for the current state + if (exists $state->{'ACTIONS'}) { + + # get next token and expand any directives (i.e. token is an + # array ref) onto the front of the token list + while (! defined $token && @$tokens) { + $token = shift(@$tokens); + if (ref $token) { + ($text, $line, $token) = @$token; + if (ref $token) { + if ($info->{ DEBUG } && ! $in_string) { + # - - - - - - - - - - - - - - - - - - - - - - - - - + # This is gnarly. Look away now if you're easily + # frightened. We're pushing parse tokens onto the + # pending list to simulate a DEBUG directive like so: + # [% DEBUG msg line='20' text='INCLUDE foo' %] + # - - - - - - - - - - - - - - - - - - - - - - - - - + my $dtext = $text; + $dtext =~ s[(['\\])][\\$1]g; + unshift(@$tokens, + DEBUG => 'DEBUG', + IDENT => 'msg', + IDENT => 'line', + ASSIGN => '=', + LITERAL => "'$line'", + IDENT => 'text', + ASSIGN => '=', + LITERAL => "'$dtext'", + IDENT => 'file', + ASSIGN => '=', + LITERAL => "'$info->{ name }'", + (';') x 2, + @$token, + (';') x 2); + } + else { + unshift(@$tokens, @$token, (';') x 2); + } + $token = undef; # force redo + } + elsif ($token eq 'ITEXT') { + if ($inperl) { + # don't perform interpolation in PERL blocks + $token = 'TEXT'; + $value = $text; + } + else { + unshift(@$tokens, + @{ $self->interpolate_text($text, $line) }); + $token = undef; # force redo + } + } + } + else { + # toggle string flag to indicate if we're crossing + # a string boundary + $in_string = ! $in_string if $token eq '"'; + $value = shift(@$tokens); + } + }; + # clear undefined token to avoid 'undefined variable blah blah' + # warnings and let the parser logic pick it up in a minute + $token = '' unless defined $token; + + # get the next state for the current lookahead token + $action = defined ($lookup = $state->{'ACTIONS'}->{ $token }) + ? $lookup + : defined ($lookup = $state->{'DEFAULT'}) + ? $lookup + : undef; + } + else { + # no lookahead actions + $action = $state->{'DEFAULT'}; + } + + # ERROR: no ACTION + last unless defined $action; + + # - - - - - - - - - - - - - - - - - - - - - - - - - - - - + # shift (+ive ACTION) + # - - - - - - - - - - - - - - - - - - - - - - - - - - - - + if ($action > 0) { + push(@$stack, [ $action, $value ]); + $token = $value = undef; + redo; + }; + + # - - - - - - - - - - - - - - - - - - - - - - - - - - - - + # reduce (-ive ACTION) + # - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ($lhs, $len, $code) = @{ $rules->[ -$action ] }; + + # no action imples ACCEPTance + $action + or $status = ACCEPT; + + # use dummy sub if code ref doesn't exist + $code = sub { $_[1] } + unless $code; + + @codevars = $len + ? map { $_->[1] } @$stack[ -$len .. -1 ] + : (); + + eval { + $coderet = &$code( $self, @codevars ); + }; + if ($@) { + my $err = $@; + chomp $err; + return $self->_parse_error($err); + } + + # reduce stack by $len + splice(@$stack, -$len, $len); + + # ACCEPT + return $coderet ## RETURN ## + if $status == ACCEPT; + + # ABORT + return undef ## RETURN ## + if $status == ABORT; + + # ERROR + last + if $status == ERROR; + } + continue { + push(@$stack, [ $states->[ $stack->[-1][0] ]->{'GOTOS'}->{ $lhs }, + $coderet ]), + } + + # ERROR ## RETURN ## + return $self->_parse_error('unexpected end of input') + unless defined $value; + + # munge text of last directive to make it readable +# $text =~ s/\n/\\n/g; + + return $self->_parse_error("unexpected end of directive", $text) + if $value eq ';'; # end of directive SEPARATOR + + return $self->_parse_error("unexpected token ($value)", $text); +} + + + +#------------------------------------------------------------------------ +# _parse_error($msg, $dirtext) +# +# Method used to handle errors encountered during the parse process +# in the _parse() method. +#------------------------------------------------------------------------ + +sub _parse_error { + my ($self, $msg, $text) = @_; + my $line = $self->{ LINE }; + $line = ref($line) ? $$line : $line; + $line = 'unknown' unless $line; + + $msg .= "\n [% $text %]" + if defined $text; + + return $self->error("line $line: $msg"); +} + + +#------------------------------------------------------------------------ +# _dump() +# +# Debug method returns a string representing the internal state of the +# object. +#------------------------------------------------------------------------ + +sub _dump { + my $self = shift; + my $output = "[Template::Parser] {\n"; + my $format = " %-16s => %s\n"; + my $key; + + foreach $key (qw( START_TAG END_TAG TAG_STYLE ANYCASE INTERPOLATE + PRE_CHOMP POST_CHOMP V1DOLLAR )) { + my $val = $self->{ $key }; + $val = '<undef>' unless defined $val; + $output .= sprintf($format, $key, $val); + } + + $output .= '}'; + return $output; +} + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Parser - LALR(1) parser for compiling template documents + +=head1 SYNOPSIS + + use Template::Parser; + + $parser = Template::Parser->new(\%config); + $template = $parser->parse($text) + || die $parser->error(), "\n"; + +=head1 DESCRIPTION + +The Template::Parser module implements a LALR(1) parser and associated methods +for parsing template documents into Perl code. + +=head1 PUBLIC METHODS + +=head2 new(\%params) + +The new() constructor creates and returns a reference to a new +Template::Parser object. A reference to a hash may be supplied as a +parameter to provide configuration values. These may include: + +=over + + + + +=item START_TAG, END_TAG + +The START_TAG and END_TAG options are used to specify character +sequences or regular expressions that mark the start and end of a +template directive. The default values for START_TAG and END_TAG are +'[%' and '%]' respectively, giving us the familiar directive style: + + [% example %] + +Any Perl regex characters can be used and therefore should be escaped +(or use the Perl C<quotemeta> function) if they are intended to +represent literal characters. + + my $parser = Template::Parser->new({ + START_TAG => quotemeta('<+'), + END_TAG => quotemeta('+>'), + }); + +example: + + <+ INCLUDE foobar +> + +The TAGS directive can also be used to set the START_TAG and END_TAG values +on a per-template file basis. + + [% TAGS <+ +> %] + + + + + + +=item TAG_STYLE + +The TAG_STYLE option can be used to set both START_TAG and END_TAG +according to pre-defined tag styles. + + my $parser = Template::Parser->new({ + TAG_STYLE => 'star', + }); + +Available styles are: + + template [% ... %] (default) + template1 [% ... %] or %% ... %% (TT version 1) + metatext %% ... %% (Text::MetaText) + star [* ... *] (TT alternate) + php <? ... ?> (PHP) + asp <% ... %> (ASP) + mason <% ... > (HTML::Mason) + html <!-- ... --> (HTML comments) + +Any values specified for START_TAG and/or END_TAG will over-ride +those defined by a TAG_STYLE. + +The TAGS directive may also be used to set a TAG_STYLE + + [% TAGS html %] + <!-- INCLUDE header --> + + + + + + +=item PRE_CHOMP, POST_CHOMP + +Anything outside a directive tag is considered plain text and is +generally passed through unaltered (but see the INTERPOLATE option). +This includes all whitespace and newlines characters surrounding +directive tags. Directives that don't generate any output will leave +gaps in the output document. + +Example: + + Foo + [% a = 10 %] + Bar + +Output: + + Foo + + Bar + +The PRE_CHOMP and POST_CHOMP options can help to clean up some of this +extraneous whitespace. Both are disabled by default. + + my $parser = Template::Parser->new({ + PRE_CHOMP => 1, + POST_CHOMP => 1, + }); + +With PRE_CHOMP set to 1, the newline and whitespace preceding a directive +at the start of a line will be deleted. This has the effect of +concatenating a line that starts with a directive onto the end of the +previous line. + + Foo <----------. + | + ,---(PRE_CHOMP)----' + | + `-- [% a = 10 %] --. + | + ,---(POST_CHOMP)---' + | + `-> Bar + +With POST_CHOMP set to 1, any whitespace after a directive up to and +including the newline will be deleted. This has the effect of joining +a line that ends with a directive onto the start of the next line. + +If PRE_CHOMP or POST_CHOMP is set to 2, then instead of removing all +the whitespace, the whitespace will be collapsed to a single space. +This is useful for HTML, where (usually) a contiguous block of +whitespace is rendered the same as a single space. + +You may use the CHOMP_NONE, CHOMP_ALL, and CHOMP_COLLAPSE constants +from the Template::Constants module to deactivate chomping, remove +all whitespace, or collapse whitespace to a single space. + +PRE_CHOMP and POST_CHOMP can be activated for individual directives by +placing a '-' immediately at the start and/or end of the directive. + + [% FOREACH user = userlist %] + [%- user -%] + [% END %] + +The '-' characters activate both PRE_CHOMP and POST_CHOMP for the one +directive '[%- name -%]'. Thus, the template will be processed as if +written: + + [% FOREACH user = userlist %][% user %][% END %] + +Note that this is the same as if PRE_CHOMP and POST_CHOMP were set +to CHOMP_ALL; the only way to get the CHOMP_COLLAPSE behavior is +to set PRE_CHOMP or POST_CHOMP accordingly. If PRE_CHOMP or POST_CHOMP +is already set to CHOMP_COLLAPSE, using '-' will give you CHOMP_COLLAPSE +behavior, not CHOMP_ALL behavior. + +Similarly, '+' characters can be used to disable PRE_CHOMP or +POST_CHOMP (i.e. leave the whitespace/newline intact) options on a +per-directive basis. + + [% FOREACH user = userlist %] + User: [% user +%] + [% END %] + +With POST_CHOMP enabled, the above example would be parsed as if written: + + [% FOREACH user = userlist %]User: [% user %] + [% END %] + + + + + +=item INTERPOLATE + +The INTERPOLATE flag, when set to any true value will cause variable +references in plain text (i.e. not surrounded by START_TAG and END_TAG) +to be recognised and interpolated accordingly. + + my $parser = Template::Parser->new({ + INTERPOLATE => 1, + }); + +Variables should be prefixed by a '$' to identify them. Curly braces +can be used in the familiar Perl/shell style to explicitly scope the +variable name where required. + + # INTERPOLATE => 0 + <a href="http://[% server %]/[% help %]"> + <img src="[% images %]/help.gif"></a> + [% myorg.name %] + + # INTERPOLATE => 1 + <a href="http://$server/$help"> + <img src="$images/help.gif"></a> + $myorg.name + + # explicit scoping with { } + <img src="$images/${icon.next}.gif"> + +Note that a limitation in Perl's regex engine restricts the maximum length +of an interpolated template to around 32 kilobytes or possibly less. Files +that exceed this limit in size will typically cause Perl to dump core with +a segmentation fault. If you routinely process templates of this size +then you should disable INTERPOLATE or split the templates in several +smaller files or blocks which can then be joined backed together via +PROCESS or INCLUDE. + + + + + + + +=item ANYCASE + +By default, directive keywords should be expressed in UPPER CASE. The +ANYCASE option can be set to allow directive keywords to be specified +in any case. + + # ANYCASE => 0 (default) + [% INCLUDE foobar %] # OK + [% include foobar %] # ERROR + [% include = 10 %] # OK, 'include' is a variable + + # ANYCASE => 1 + [% INCLUDE foobar %] # OK + [% include foobar %] # OK + [% include = 10 %] # ERROR, 'include' is reserved word + +One side-effect of enabling ANYCASE is that you cannot use a variable +of the same name as a reserved word, regardless of case. The reserved +words are currently: + + GET CALL SET DEFAULT INSERT INCLUDE PROCESS WRAPPER + IF UNLESS ELSE ELSIF FOR FOREACH WHILE SWITCH CASE + USE PLUGIN FILTER MACRO PERL RAWPERL BLOCK META + TRY THROW CATCH FINAL NEXT LAST BREAK RETURN STOP + CLEAR TO STEP AND OR NOT MOD DIV END + + +The only lower case reserved words that cannot be used for variables, +regardless of the ANYCASE option, are the operators: + + and or not mod div + + + + + + + + +=item V1DOLLAR + +In version 1 of the Template Toolkit, an optional leading '$' could be placed +on any template variable and would be silently ignored. + + # VERSION 1 + [% $foo %] === [% foo %] + [% $hash.$key %] === [% hash.key %] + +To interpolate a variable value the '${' ... '}' construct was used. +Typically, one would do this to index into a hash array when the key +value was stored in a variable. + +example: + + my $vars = { + users => { + aba => { name => 'Alan Aardvark', ... }, + abw => { name => 'Andy Wardley', ... }, + ... + }, + uid => 'aba', + ... + }; + + $template->process('user/home.html', $vars) + || die $template->error(), "\n"; + +'user/home.html': + + [% user = users.${uid} %] # users.aba + Name: [% user.name %] # Alan Aardvark + +This was inconsistent with double quoted strings and also the +INTERPOLATE mode, where a leading '$' in text was enough to indicate a +variable for interpolation, and the additional curly braces were used +to delimit variable names where necessary. Note that this use is +consistent with UNIX and Perl conventions, among others. + + # double quoted string interpolation + [% name = "$title ${user.name}" %] + + # INTERPOLATE = 1 + <img src="$images/help.gif"></a> + <img src="$images/${icon.next}.gif"> + +For version 2, these inconsistencies have been removed and the syntax +clarified. A leading '$' on a variable is now used exclusively to +indicate that the variable name should be interpolated +(e.g. subsituted for its value) before being used. The earlier example +from version 1: + + # VERSION 1 + [% user = users.${uid} %] + Name: [% user.name %] + +can now be simplified in version 2 as: + + # VERSION 2 + [% user = users.$uid %] + Name: [% user.name %] + +The leading dollar is no longer ignored and has the same effect of +interpolation as '${' ... '}' in version 1. The curly braces may +still be used to explicitly scope the interpolated variable name +where necessary. + +e.g. + + [% user = users.${me.id} %] + Name: [% user.name %] + +The rule applies for all variables, both within directives and in +plain text if processed with the INTERPOLATE option. This means that +you should no longer (if you ever did) add a leading '$' to a variable +inside a directive, unless you explicitly want it to be interpolated. + +One obvious side-effect is that any version 1 templates with variables +using a leading '$' will no longer be processed as expected. Given +the following variable definitions, + + [% foo = 'bar' + bar = 'baz' + %] + +version 1 would interpret the following as: + + # VERSION 1 + [% $foo %] => [% GET foo %] => bar + +whereas version 2 interprets it as: + + # VERSION 2 + [% $foo %] => [% GET $foo %] => [% GET bar %] => baz + +In version 1, the '$' is ignored and the value for the variable 'foo' is +retrieved and printed. In version 2, the variable '$foo' is first interpolated +to give the variable name 'bar' whose value is then retrieved and printed. + +The use of the optional '$' has never been strongly recommended, but +to assist in backwards compatibility with any version 1 templates that +may rely on this "feature", the V1DOLLAR option can be set to 1 +(default: 0) to revert the behaviour and have leading '$' characters +ignored. + + my $parser = Template::Parser->new({ + V1DOLLAR => 1, + }); + + + + + + +=item GRAMMAR + +The GRAMMAR configuration item can be used to specify an alternate +grammar for the parser. This allows a modified or entirely new +template language to be constructed and used by the Template Toolkit. + +Source templates are compiled to Perl code by the Template::Parser +using the Template::Grammar (by default) to define the language +structure and semantics. Compiled templates are thus inherently +"compatible" with each other and there is nothing to prevent any +number of different template languages being compiled and used within +the same Template Toolkit processing environment (other than the usual +time and memory constraints). + +The Template::Grammar file is constructed from a YACC like grammar +(using Parse::YAPP) and a skeleton module template. These files are +provided, along with a small script to rebuild the grammar, in the +'parser' sub-directory of the distribution. You don't have to know or +worry about these unless you want to hack on the template language or +define your own variant. There is a README file in the same directory +which provides some small guidance but it is assumed that you know +what you're doing if you venture herein. If you grok LALR parsers, +then you should find it comfortably familiar. + +By default, an instance of the default Template::Grammar will be +created and used automatically if a GRAMMAR item isn't specified. + + use MyOrg::Template::Grammar; + + my $parser = Template::Parser->new({ + GRAMMAR = MyOrg::Template::Grammar->new(); + }); + + + +=item DEBUG + +The DEBUG option can be used to enable various debugging features +of the Template::Parser module. + + use Template::Constants qw( :debug ); + + my $template = Template->new({ + DEBUG => DEBUG_PARSER | DEBUG_DIRS, + }); + +The DEBUG value can include any of the following. Multiple values +should be combined using the logical OR operator, '|'. + +=over 4 + +=item DEBUG_PARSER + +This flag causes the L<Template::Parser|Template::Parser> to generate +debugging messages that show the Perl code generated by parsing and +compiling each template. + +=item DEBUG_DIRS + +This option causes the Template Toolkit to generate comments +indicating the source file, line and original text of each directive +in the template. These comments are embedded in the template output +using the format defined in the DEBUG_FORMAT configuration item, or a +simple default format if unspecified. + +For example, the following template fragment: + + + Hello World + +would generate this output: + + ## input text line 1 : ## + Hello + ## input text line 2 : World ## + World + + +=back + + + + +=back + +=head2 parse($text) + +The parse() method parses the text passed in the first parameter and +returns a reference to a Template::Document object which contains the +compiled representation of the template text. On error, undef is +returned. + +Example: + + $doc = $parser->parse($text) + || die $parser->error(); + +=head1 AUTHOR + +Andy Wardley E<lt>abw@andywardley.comE<gt> + +L<http://www.andywardley.com/|http://www.andywardley.com/> + + + + + + +=head1 VERSION + +2.75, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + + + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + + + +The original Template::Parser module was derived from a standalone +parser generated by version 0.16 of the Parse::Yapp module. The +following copyright notice appears in the Parse::Yapp documentation. + + The Parse::Yapp module and its related modules and shell + scripts are copyright (c) 1998 Francois Desarmenien, + France. All rights reserved. + + You may use and distribute them under the terms of either + the GNU General Public License or the Artistic License, as + specified in the Perl README file. + +=head1 SEE ALSO + +L<Template|Template>, L<Template::Grammar|Template::Grammar>, L<Template::Directive|Template::Directive> + diff --git a/lib/Template/Plugin.pm b/lib/Template/Plugin.pm new file mode 100644 index 0000000..664ac96 --- /dev/null +++ b/lib/Template/Plugin.pm @@ -0,0 +1,399 @@ +#============================================================= -*-Perl-*- +# +# Template::Plugin +# +# DESCRIPTION +# +# Module defining a base class for a plugin object which can be loaded +# and instantiated via the USE directive. +# +# AUTHOR +# Andy Wardley <abw@kfs.org> +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#---------------------------------------------------------------------------- +# +# $Id: Plugin.pm,v 2.60 2003/04/24 09:14:38 abw Exp $ +# +#============================================================================ + +package Template::Plugin; + +require 5.004; + +use strict; +use Template::Base; + +use vars qw( $VERSION $DEBUG $ERROR $AUTOLOAD ); +use base qw( Template::Base ); + +$VERSION = sprintf("%d.%02d", q$Revision: 2.60 $ =~ /(\d+)\.(\d+)/); +$DEBUG = 0; + + +#======================================================================== +# ----- CLASS METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# load() +# +# Class method called when the plugin module is first loaded. It +# returns the name of a class (by default, its own class) or a prototype +# object which will be used to instantiate new objects. The new() +# method is then called against the class name (class method) or +# prototype object (object method) to create a new instances of the +# object. +#------------------------------------------------------------------------ + +sub load { + return $_[0]; +} + + +#------------------------------------------------------------------------ +# new($context, $delegate, @params) +# +# Object constructor which is called by the Template::Context to +# instantiate a new Plugin object. This base class constructor is +# used as a general mechanism to load and delegate to other Perl +# modules. The context is passed as the first parameter, followed by +# a reference to a delegate object or the name of the module which +# should be loaded and instantiated. Any additional parameters passed +# to the USE directive are forwarded to the new() constructor. +# +# A plugin object is returned which has an AUTOLOAD method to delegate +# requests to the underlying object. +#------------------------------------------------------------------------ + +sub new { + my $class = shift; + bless { + }, $class; +} + +sub old_new { + my ($class, $context, $delclass, @params) = @_; + my ($delegate, $delmod); + + return $class->error("no context passed to $class constructor\n") + unless defined $context; + + if (ref $delclass) { + # $delclass contains a reference to a delegate object + $delegate = $delclass; + } + else { + # delclass is the name of a module to load and instantiate + ($delmod = $delclass) =~ s|::|/|g; + + eval { + require "$delmod.pm"; + $delegate = $delclass->new(@params) + || die "failed to instantiate $delclass object\n"; + }; + return $class->error($@) if $@; + } + + bless { + _CONTEXT => $context, + _DELEGATE => $delegate, + _PARAMS => \@params, + }, $class; +} + + +#------------------------------------------------------------------------ +# fail($error) +# +# Version 1 error reporting function, now replaced by error() inherited +# from Template::Base. Raises a "deprecated function" warning and then +# calls error(). +#------------------------------------------------------------------------ + +sub fail { + my $class = shift; + my ($pkg, $file, $line) = caller(); + warn "Template::Plugin::fail() is deprecated at $file line $line. Please use error()\n"; + $class->error(@_); +} + + +#======================================================================== +# ----- OBJECT METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# AUTOLOAD +# +# General catch-all method which delegates all calls to the _DELEGATE +# object. +#------------------------------------------------------------------------ + +sub OLD_AUTOLOAD { + my $self = shift; + my $method = $AUTOLOAD; + + $method =~ s/.*:://; + return if $method eq 'DESTROY'; + + if (ref $self eq 'HASH') { + my $delegate = $self->{ _DELEGATE } || return; + return $delegate->$method(@_); + } + my ($pkg, $file, $line) = caller(); +# warn "no such '$method' method called on $self at $file line $line\n"; + return undef; +} + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Plugin - Base class for Template Toolkit plugins + +=head1 SYNOPSIS + + package MyOrg::Template::Plugin::MyPlugin; + use base qw( Template::Plugin ); + use Template::Plugin; + use MyModule; + + sub new { + my $class = shift; + my $context = shift; + bless { + ... + }, $class; + } + +=head1 DESCRIPTION + +A "plugin" for the Template Toolkit is simply a Perl module which +exists in a known package location (e.g. Template::Plugin::*) and +conforms to a regular standard, allowing it to be loaded and used +automatically. + +The Template::Plugin module defines a base class from which other +plugin modules can be derived. A plugin does not have to be derived +from Template::Plugin but should at least conform to its object-oriented +interface. + +It is recommended that you create plugins in your own package namespace +to avoid conflict with toolkit plugins. e.g. + + package MyOrg::Template::Plugin::FooBar; + +Use the PLUGIN_BASE option to specify the namespace that you use. e.g. + + use Template; + my $template = Template->new({ + PLUGIN_BASE => 'MyOrg::Template::Plugin', + }); + +=head1 PLUGIN API + +The following methods form the basic interface between the Template +Toolkit and plugin modules. + +=over 4 + +=item load($context) + +This method is called by the Template Toolkit when the plugin module +is first loaded. It is called as a package method and thus implicitly +receives the package name as the first parameter. A reference to the +Template::Context object loading the plugin is also passed. The +default behaviour for the load() method is to simply return the class +name. The calling context then uses this class name to call the new() +package method. + + package MyPlugin; + + sub load { # called as MyPlugin->load($context) + my ($class, $context) = @_; + return $class; # returns 'MyPlugin' + } + +=item new($context, @params) + +This method is called to instantiate a new plugin object for the USE +directive. It is called as a package method against the class name +returned by load(). A reference to the Template::Context object creating +the plugin is passed, along with any additional parameters specified in +the USE directive. + + sub new { # called as MyPlugin->new($context) + my ($class, $context, @params) = @_; + bless { + _CONTEXT => $context, + }, $class; # returns blessed MyPlugin object + } + +=item error($error) + +This method, inherited from the Template::Base module, is used for +reporting and returning errors. It can be called as a package method +to set/return the $ERROR package variable, or as an object method to +set/return the object _ERROR member. When called with an argument, it +sets the relevant variable and returns undef. When called without an +argument, it returns the value of the variable. + + sub new { + my ($class, $context, $dsn) = @_; + + return $class->error('No data source specified') + unless $dsn; + + bless { + _DSN => $dsn, + }, $class; + } + + ... + + my $something = MyModule->new() + || die MyModule->error(), "\n"; + + $something->do_something() + || die $something->error(), "\n"; + +=back + +=head1 DEEPER MAGIC + +The Template::Context object that handles the loading and use of +plugins calls the new() and error() methods against the package name +returned by the load() method. In pseudo-code terms, it might look +something like this: + + $class = MyPlugin->load($context); # returns 'MyPlugin' + + $object = $class->new($context, @params) # MyPlugin->new(...) + || die $class->error(); # MyPlugin->error() + +The load() method may alterately return a blessed reference to an +object instance. In this case, new() and error() are then called as +I<object> methods against that prototype instance. + + package YourPlugin; + + sub load { + my ($class, $context) = @_; + bless { + _CONTEXT => $context, + }, $class; + } + + sub new { + my ($self, $context, @params) = @_; + return $self; + } + +In this example, we have implemented a 'Singleton' plugin. One object +gets created when load() is called and this simply returns itself for +each call to new(). + +Another implementation might require individual objects to be created +for every call to new(), but with each object sharing a reference to +some other object to maintain cached data, database handles, etc. +This pseudo-code example demonstrates the principle. + + package MyServer; + + sub load { + my ($class, $context) = @_; + bless { + _CONTEXT => $context, + _CACHE => { }, + }, $class; + } + + sub new { + my ($self, $context, @params) = @_; + MyClient->new($self, @params); + } + + sub add_to_cache { ... } + + sub get_from_cache { ... } + + + package MyClient; + + sub new { + my ($class, $server, $blah) = @_; + bless { + _SERVER => $server, + _BLAH => $blah, + }, $class; + } + + sub get { + my $self = shift; + $self->{ _SERVER }->get_from_cache(@_); + } + + sub put { + my $self = shift; + $self->{ _SERVER }->add_to_cache(@_); + } + +When the plugin is loaded, a MyServer instance is created. The new() +method is called against this object which instantiates and returns a +MyClient object, primed to communicate with the creating MyServer. + +=head1 Template::Plugin Delegation + +As of version 2.01, the Template::Plugin module no longer provides an +AUTOLOAD method to delegate to other objects or classes. This was a +badly designed feature that caused more trouble than good. You can +easily add your own AUTOLOAD method to perform delegation if you +require this kind of functionality. + +=head1 AUTHOR + +Andy Wardley E<lt>abw@andywardley.comE<gt> + +L<http://www.andywardley.com/|http://www.andywardley.com/> + + + + +=head1 VERSION + +2.60, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L<Template|Template>, L<Template::Plugins|Template::Plugins>, L<Template::Context|Template::Context> diff --git a/lib/Template/Plugin/Date.pm b/lib/Template/Plugin/Date.pm new file mode 100644 index 0000000..1cd0a60 --- /dev/null +++ b/lib/Template/Plugin/Date.pm @@ -0,0 +1,361 @@ +#============================================================= -*-Perl-*- +# +# Template::Plugin::Date +# +# DESCRIPTION +# +# Plugin to generate formatted date strings. +# +# AUTHORS +# Thierry-Michel Barral <kktos@electron-libre.com> +# Andy Wardley <abw@cre.canon.co.uk> +# +# COPYRIGHT +# Copyright (C) 2000 Thierry-Michel Barral, Andy Wardley. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#---------------------------------------------------------------------------- +# +# $Id: Date.pm,v 2.66 2003/04/24 09:14:43 abw Exp $ +# +#============================================================================ + +package Template::Plugin::Date; + +use strict; +use vars qw( $VERSION $FORMAT @LOCALE_SUFFIX ); +use base qw( Template::Plugin ); +use Template::Plugin; + +use POSIX (); + +$VERSION = sprintf("%d.%02d", q$Revision: 2.66 $ =~ /(\d+)\.(\d+)/); +$FORMAT = '%H:%M:%S %d-%b-%Y'; # default strftime() format +@LOCALE_SUFFIX = qw( .ISO8859-1 .ISO_8859-15 .US-ASCII .UTF-8 ); + +#------------------------------------------------------------------------ +# new(\%options) +#------------------------------------------------------------------------ + +sub new { + my ($class, $context, $params) = @_; + bless { + $params ? %$params : () + }, $class; +} + + +#------------------------------------------------------------------------ +# now() +# +# Call time() to return the current system time in seconds since the epoch. +#------------------------------------------------------------------------ + +sub now { + return time(); +} + + +#------------------------------------------------------------------------ +# format() +# format($time) +# format($time, $format) +# format($time, $format, $locale) +# format($time, $format, $locale, $gmt_flag) +# format(\%named_params); +# +# Returns a formatted time/date string for the specified time, $time, +# (or the current system time if unspecified) using the $format, $locale, +# and $gmt values specified as arguments or internal values set defined +# at construction time). Specifying a Perl-true value for $gmt will +# override the local time zone and force the output to be for GMT. +# Any or all of the arguments may be specified as named parameters which +# get passed as a hash array reference as the final argument. +# ------------------------------------------------------------------------ + +sub format { + my $self = shift; + my $params = ref($_[$#_]) eq 'HASH' ? pop(@_) : { }; + my $time = shift(@_) || $params->{ time } || $self->{ time } + || $self->now(); + my $format = @_ ? shift(@_) + : ($params->{ format } || $self->{ format } || $FORMAT); + my $locale = @_ ? shift(@_) + : ($params->{ locale } || $self->{ locale }); + my $gmt = @_ ? shift(@_) + : ($params->{ gmt } || $self->{ gmt }); + my (@date, $datestr); + + if ($time =~ /^\d+$/) { + # $time is now in seconds since epoch + if ($gmt) { + @date = (gmtime($time))[0..6]; + } + else { + @date = (localtime($time))[0..6]; + } + } + else { + # if $time is numeric, then we assume it's seconds since the epoch + # otherwise, we try to parse it as a 'H:M:S D:M:Y' string + @date = (split(/(?:\/| |:|-)/, $time))[2,1,0,3..5]; + return (undef, Template::Exception->new('date', + "bad time/date string: expects 'h:m:s d:m:y' got: '$time'")) + unless @date >= 6 && defined $date[5]; + $date[4] -= 1; # correct month number 1-12 to range 0-11 + $date[5] -= 1900; # convert absolute year to years since 1900 + $time = &POSIX::mktime(@date); + } + + if ($locale) { + # format the date in a specific locale, saving and subsequently + # restoring the current locale. + my $old_locale = &POSIX::setlocale(&POSIX::LC_ALL); + + # some systems expect locales to have a particular suffix + for my $suffix ('', @LOCALE_SUFFIX) { + my $try_locale = $locale.$suffix; + my $setlocale = &POSIX::setlocale(&POSIX::LC_ALL, $try_locale); + if (defined $setlocale && $try_locale eq $setlocale) { + $locale = $try_locale; + last; + } + } + $datestr = &POSIX::strftime($format, @date); + &POSIX::setlocale(&POSIX::LC_ALL, $old_locale); + } + else { + $datestr = &POSIX::strftime($format, @date); + } + + return $datestr; +} + +sub calc { + my $self = shift; + eval { require "Date/Calc.pm" }; + $self->throw("failed to load Date::Calc: $@") if $@; + return Template::Plugin::Date::Calc->new('no context'); +} + +sub manip { + my $self = shift; + eval { require "Date/Manip.pm" }; + $self->throw("failed to load Date::Manip: $@") if $@; + return Template::Plugin::Date::Manip->new('no context'); +} + + +sub throw { + my $self = shift; + die (Template::Exception->new('date', join(', ', @_))); +} + + +package Template::Plugin::Date::Calc; +use base qw( Template::Plugin ); +use vars qw( $AUTOLOAD ); +*throw = \&Template::Plugin::Date::throw; + +sub AUTOLOAD { + my $self = shift; + my $method = $AUTOLOAD; + + $method =~ s/.*:://; + return if $method eq 'DESTROY'; + + my $sub = \&{"Date::Calc::$method"}; + $self->throw("no such Date::Calc method: $method") + unless $sub; + + &$sub(@_); +} + +package Template::Plugin::Date::Manip; +use base qw( Template::Plugin ); +use vars qw( $AUTOLOAD ); +*throw = \&Template::Plugin::Date::throw; + +sub AUTOLOAD { + my $self = shift; + my $method = $AUTOLOAD; + + $method =~ s/.*:://; + return if $method eq 'DESTROY'; + + my $sub = \&{"Date::Manip::$method"}; + $self->throw("no such Date::Manip method: $method") + unless $sub; + + &$sub(@_); +} + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Plugin::Date - Plugin to generate formatted date strings + +=head1 SYNOPSIS + + [% USE date %] + + # use current time and default format + [% date.format %] + + # specify time as seconds since epoch or 'h:m:s d-m-y' string + [% date.format(960973980) %] + [% date.format('4:20:36 21/12/2000') %] + + # specify format + [% date.format(mytime, '%H:%M:%S') %] + + # specify locale + [% date.format(date.now, '%a %d %b %y', 'en_GB') %] + + # named parameters + [% date.format(mytime, format = '%H:%M:%S') %] + [% date.format(locale = 'en_GB') %] + [% date.format(time = date.now, + format = '%H:%M:%S', + locale = 'en_GB) %] + + # specify default format to plugin + [% USE date(format = '%H:%M:%S', locale = 'de_DE') %] + + [% date.format %] + ... + +=head1 DESCRIPTION + +The Date plugin provides an easy way to generate formatted time and date +strings by delegating to the POSIX strftime() routine. + +The plugin can be loaded via the familiar USE directive. + + [% USE date %] + +This creates a plugin object with the default name of 'date'. An alternate +name can be specified as such: + + [% USE myname = date %] + +The plugin provides the format() method which accepts a time value, a +format string and a locale name. All of these parameters are optional +with the current system time, default format ('%H:%M:%S %d-%b-%Y') and +current locale being used respectively, if undefined. Default values +for the time, format and/or locale may be specified as named parameters +in the USE directive. + + [% USE date(format = '%a %d-%b-%Y', locale = 'fr_FR') %] + +When called without any parameters, the format() method returns a string +representing the current system time, formatted by strftime() according +to the default format and for the default locale (which may not be the +current one, if locale is set in the USE directive). + + [% date.format %] + +The plugin allows a time/date to be specified as seconds since the epoch, +as is returned by time(). + + File last modified: [% date.format(filemod_time) %] + +The time/date can also be specified as a string of the form 'h:m:s d/m/y'. +Any of the characters : / - or space may be used to delimit fields. + + [% USE day = date(format => '%A', locale => 'en_GB') %] + [% day.format('4:20:00 9-13-2000') %] + +Output: + + Tuesday + +A format string can also be passed to the format() method, and a locale +specification may follow that. + + [% date.format(filemod, '%d-%b-%Y') %] + [% date.format(filemod, '%d-%b-%Y', 'en_GB') %] + +A fourth parameter allows you to force output in GMT, in the case of +seconds-since-the-epoch input: + + [% date.format(filemod, '%d-%b-%Y', 'en_GB', 1) %] + +Note that in this case, if the local time is not GMT, then also specifying +'%Z' (time zone) in the format parameter will lead to an extremely +misleading result. + +Any or all of these parameters may be named. Positional parameters +should always be in the order ($time, $format, $locale). + + [% date.format(format => '%H:%M:%S') %] + [% date.format(time => filemod, format => '%H:%M:%S') %] + [% date.format(mytime, format => '%H:%M:%S') %] + [% date.format(mytime, format => '%H:%M:%S', locale => 'fr_FR') %] + [% date.format(mytime, format => '%H:%M:%S', gmt => 1) %] + ...etc... + +The now() method returns the current system time in seconds since the +epoch. + + [% date.format(date.now, '%A') %] + +The calc() method can be used to create an interface to the Date::Calc +module (if installed on your system). + + [% calc = date.calc %] + [% calc.Monday_of_Week(22, 2001).join('/') %] + +The manip() method can be used to create an interface to the Date::Manip +module (if installed on your system). + + [% manip = date.manip %] + [% manip.UnixDate("Noon Yesterday","%Y %b %d %H:%M") %] + +=head1 AUTHORS + +Thierry-Michel Barral E<lt>kktos@electron-libre.comE<gt> wrote the original +plugin. + +Andy Wardley E<lt>abw@cre.canon.co.ukE<gt> provided some minor +fixups/enhancements, a test script and documentation. + +Mark D. Mills E<lt>mark@hostile.orgE<gt> cloned Date::Manip from the +cute Date::Calc sub-plugin. + +=head1 VERSION + +2.66, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + + + +=head1 COPYRIGHT + +Copyright (C) 2000 Thierry-Michel Barral, Andy Wardley. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L<Template::Plugin|Template::Plugin>, L<POSIX|POSIX> + diff --git a/lib/Template/Plugins.pm b/lib/Template/Plugins.pm new file mode 100644 index 0000000..839c85e --- /dev/null +++ b/lib/Template/Plugins.pm @@ -0,0 +1,1031 @@ +#============================================================= -*-Perl-*- +# +# Template::Plugins +# +# DESCRIPTION +# Plugin provider which handles the loading of plugin modules and +# instantiation of plugin objects. +# +# AUTHORS +# Andy Wardley <abw@kfs.org> +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#---------------------------------------------------------------------------- +# +# $Id: Plugins.pm,v 2.65 2003/04/24 09:14:38 abw Exp $ +# +#============================================================================ + +package Template::Plugins; + +require 5.004; + +use strict; +use base qw( Template::Base ); +use vars qw( $VERSION $DEBUG $STD_PLUGINS ); +use Template::Constants; + +$VERSION = sprintf("%d.%02d", q$Revision: 2.65 $ =~ /(\d+)\.(\d+)/); + +$STD_PLUGINS = { + 'autoformat' => 'Template::Plugin::Autoformat', + 'cgi' => 'Template::Plugin::CGI', + 'datafile' => 'Template::Plugin::Datafile', + 'date' => 'Template::Plugin::Date', + 'debug' => 'Template::Plugin::Debug', + 'directory' => 'Template::Plugin::Directory', + 'dbi' => 'Template::Plugin::DBI', + 'dumper' => 'Template::Plugin::Dumper', + 'file' => 'Template::Plugin::File', + 'format' => 'Template::Plugin::Format', + 'html' => 'Template::Plugin::HTML', + 'image' => 'Template::Plugin::Image', + 'iterator' => 'Template::Plugin::Iterator', + 'pod' => 'Template::Plugin::Pod', + 'table' => 'Template::Plugin::Table', + 'url' => 'Template::Plugin::URL', + 'view' => 'Template::Plugin::View', + 'wrap' => 'Template::Plugin::Wrap', + 'xmlstyle' => 'Template::Plugin::XML::Style', +}; + + +#======================================================================== +# -- PUBLIC METHODS -- +#======================================================================== + +#------------------------------------------------------------------------ +# fetch($name, \@args, $context) +# +# General purpose method for requesting instantiation of a plugin +# object. The name of the plugin is passed as the first parameter. +# The internal FACTORY lookup table is consulted to retrieve the +# appropriate factory object or class name. If undefined, the _load() +# method is called to attempt to load the module and return a factory +# class/object which is then cached for subsequent use. A reference +# to the calling context should be passed as the third parameter. +# This is passed to the _load() class method. The new() method is +# then called against the factory class name or prototype object to +# instantiate a new plugin object, passing any arguments specified by +# list reference as the second parameter. e.g. where $factory is the +# class name 'MyClass', the new() method is called as a class method, +# $factory->new(...), equivalent to MyClass->new(...) . Where +# $factory is a prototype object, the new() method is called as an +# object method, $myobject->new(...). This latter approach allows +# plugins to act as Singletons, cache shared data, etc. +# +# Returns a reference to a plugin, (undef, STATUS_DECLINE) to decline +# the request or ($error, STATUS_ERROR) on error. +#------------------------------------------------------------------------ + +sub fetch { + my ($self, $name, $args, $context) = @_; + my ($factory, $plugin, $error); + + $self->debug("fetch($name, ", + defined $args ? ('[ ', join(', ', @$args), ' ]') : '<no args>', ', ', + defined $context ? $context : '<no context>', + ')') if $self->{ DEBUG }; + + # NOTE: + # the $context ref gets passed as the first parameter to all regular + # plugins, but not to those loaded via LOAD_PERL; to hack around + # this until we have a better implementation, we pass the $args + # reference to _load() and let it unshift the first args in the + # LOAD_PERL case + + $args ||= [ ]; + unshift @$args, $context; + + $factory = $self->{ FACTORY }->{ $name } ||= do { + ($factory, $error) = $self->_load($name, $context); + return ($factory, $error) if $error; ## RETURN + $factory; + }; + + # call the new() method on the factory object or class name + eval { + if (ref $factory eq 'CODE') { + defined( $plugin = &$factory(@$args) ) + || die "$name plugin failed\n"; + } + else { + defined( $plugin = $factory->new(@$args) ) + || die "$name plugin failed: ", $factory->error(), "\n"; + } + }; + if ($error = $@) { +# chomp $error; + return $self->{ TOLERANT } + ? (undef, Template::Constants::STATUS_DECLINED) + : ($error, Template::Constants::STATUS_ERROR); + } + + return $plugin; +} + + + +#======================================================================== +# -- PRIVATE METHODS -- +#======================================================================== + +#------------------------------------------------------------------------ +# _init(\%config) +# +# Private initialisation method. +#------------------------------------------------------------------------ + +sub _init { + my ($self, $params) = @_; + my ($pbase, $plugins, $factory) = + @$params{ qw( PLUGIN_BASE PLUGINS PLUGIN_FACTORY ) }; + + $plugins ||= { }; + if (ref $pbase ne 'ARRAY') { + $pbase = $pbase ? [ $pbase ] : [ ]; + } + push(@$pbase, 'Template::Plugin'); + + $self->{ PLUGIN_BASE } = $pbase; + $self->{ PLUGINS } = { %$STD_PLUGINS, %$plugins }; + $self->{ TOLERANT } = $params->{ TOLERANT } || 0; + $self->{ LOAD_PERL } = $params->{ LOAD_PERL } || 0; + $self->{ FACTORY } = $factory || { }; + $self->{ DEBUG } = ( $params->{ DEBUG } || 0 ) + & Template::Constants::DEBUG_PLUGINS; + + return $self; +} + + + +#------------------------------------------------------------------------ +# _load($name, $context) +# +# Private method which attempts to load a plugin module and determine the +# correct factory name or object by calling the load() class method in +# the loaded module. +#------------------------------------------------------------------------ + +sub _load { + my ($self, $name, $context) = @_; + my ($factory, $module, $base, $pkg, $file, $ok, $error); + + if ($module = $self->{ PLUGINS }->{ $name }) { + # plugin module name is explicitly stated in PLUGIN_NAME + $pkg = $module; + ($file = $module) =~ s|::|/|g; + $file =~ s|::|/|g; + $self->debug("loading $module.pm (PLUGIN_NAME)") + if $self->{ DEBUG }; + $ok = eval { require "$file.pm" }; + $error = $@; + } + else { + # try each of the PLUGIN_BASE values to build module name + ($module = $name) =~ s/\./::/g; + + foreach $base (@{ $self->{ PLUGIN_BASE } }) { + $pkg = $base . '::' . $module; + ($file = $pkg) =~ s|::|/|g; + + $self->debug("loading $file.pm (PLUGIN_BASE)") + if $self->{ DEBUG }; + + $ok = eval { require "$file.pm" }; + last unless $@; + + $error .= "$@\n" + unless ($@ =~ /^Can\'t locate $file\.pm/); + } + } + + if ($ok) { + $self->debug("calling $pkg->load()") if $self->{ DEBUG }; + + $factory = eval { $pkg->load($context) }; + $error = ''; + if ($@ || ! $factory) { + $error = $@ || 'load() returned a false value'; + } + } + elsif ($self->{ LOAD_PERL }) { + # fallback - is it a regular Perl module? + ($file = $module) =~ s|::|/|g; + eval { require "$file.pm" }; + if ($@) { + $error = $@; + } + else { + # this is a regular Perl module so the new() constructor + # isn't expecting a $context reference as the first argument; + # so we construct a closure which removes it before calling + # $module->new(@_); + $factory = sub { + shift; + $module->new(@_); + }; + $error = ''; + } + } + + if ($factory) { + $self->debug("$name => $factory") if $self->{ DEBUG }; + return $factory; + } + elsif ($error) { + return $self->{ TOLERANT } + ? (undef, Template::Constants::STATUS_DECLINED) + : ($error, Template::Constants::STATUS_ERROR); + } + else { + return (undef, Template::Constants::STATUS_DECLINED); + } +} + + +#------------------------------------------------------------------------ +# _dump() +# +# Debug method which constructs and returns text representing the current +# state of the object. +#------------------------------------------------------------------------ + +sub _dump { + my $self = shift; + my $output = "[Template::Plugins] {\n"; + my $format = " %-16s => %s\n"; + my $key; + + foreach $key (qw( TOLERANT LOAD_PERL )) { + $output .= sprintf($format, $key, $self->{ $key }); + } + + local $" = ', '; + my $fkeys = join(", ", keys %{$self->{ FACTORY }}); + my $plugins = $self->{ PLUGINS }; + $plugins = join('', map { + sprintf(" $format", $_, $plugins->{ $_ }); + } keys %$plugins); + $plugins = "{\n$plugins }"; + + $output .= sprintf($format, 'PLUGIN_BASE', "[ @{ $self->{ PLUGIN_BASE } } ]"); + $output .= sprintf($format, 'PLUGINS', $plugins); + $output .= sprintf($format, 'FACTORY', $fkeys); + $output .= '}'; + return $output; +} + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Plugins - Plugin provider module + +=head1 SYNOPSIS + + use Template::Plugins; + + $plugin_provider = Template::Plugins->new(\%options); + + ($plugin, $error) = $plugin_provider->fetch($name, @args); + +=head1 DESCRIPTION + +The Template::Plugins module defines a provider class which can be used +to load and instantiate Template Toolkit plugin modules. + +=head1 METHODS + +=head2 new(\%params) + +Constructor method which instantiates and returns a reference to a +Template::Plugins object. A reference to a hash array of configuration +items may be passed as a parameter. These are described below. + +Note that the Template.pm front-end module creates a Template::Plugins +provider, passing all configuration items. Thus, the examples shown +below in the form: + + $plugprov = Template::Plugins->new({ + PLUGIN_BASE => 'MyTemplate::Plugin', + LOAD_PERL => 1, + ... + }); + +can also be used via the Template module as: + + $ttengine = Template->new({ + PLUGIN_BASE => 'MyTemplate::Plugin', + LOAD_PERL => 1, + ... + }); + +as well as the more explicit form of: + + $plugprov = Template::Plugins->new({ + PLUGIN_BASE => 'MyTemplate::Plugin', + LOAD_PERL => 1, + ... + }); + + $ttengine = Template->new({ + LOAD_PLUGINS => [ $plugprov ], + }); + +=head2 fetch($name, @args) + +Called to request that a plugin of a given name be provided. The relevant +module is first loaded (if necessary) and the load() class method called +to return the factory class name (usually the same package name) or a +factory object (a prototype). The new() method is then called as a +class or object method against the factory, passing all remaining +parameters. + +Returns a reference to a new plugin object or ($error, STATUS_ERROR) +on error. May also return (undef, STATUS_DECLINED) to decline to +serve the request. If TOLERANT is set then all errors will be +returned as declines. + +=head1 CONFIGURATION OPTIONS + +The following list details the configuration options that can be provided +to the Template::Plugins new() constructor. + +=over 4 + + + + +=item PLUGINS + +The PLUGINS options can be used to provide a reference to a hash array +that maps plugin names to Perl module names. A number of standard +plugins are defined (e.g. 'table', 'cgi', 'dbi', etc.) which map to +their corresponding Template::Plugin::* counterparts. These can be +redefined by values in the PLUGINS hash. + + my $plugins = Template::Plugins->new({ + PLUGINS => { + cgi => 'MyOrg::Template::Plugin::CGI', + foo => 'MyOrg::Template::Plugin::Foo', + bar => 'MyOrg::Template::Plugin::Bar', + }, + }); + +The USE directive is used to create plugin objects and does so by +calling the plugin() method on the current Template::Context object. +If the plugin name is defined in the PLUGINS hash then the +corresponding Perl module is loaded via require(). The context then +calls the load() class method which should return the class name +(default and general case) or a prototype object against which the +new() method can be called to instantiate individual plugin objects. + +If the plugin name is not defined in the PLUGINS hash then the PLUGIN_BASE +and/or LOAD_PERL options come into effect. + + + + + +=item PLUGIN_BASE + +If a plugin is not defined in the PLUGINS hash then the PLUGIN_BASE is used +to attempt to construct a correct Perl module name which can be successfully +loaded. + +The PLUGIN_BASE can be specified as a single value or as a reference +to an array of multiple values. The default PLUGIN_BASE value, +'Template::Plugin', is always added the the end of the PLUGIN_BASE +list (a single value is first converted to a list). Each value should +contain a Perl package name to which the requested plugin name is +appended. + +example 1: + + my $plugins = Template::Plugins->new({ + PLUGIN_BASE => 'MyOrg::Template::Plugin', + }); + + [% USE Foo %] # => MyOrg::Template::Plugin::Foo + or Template::Plugin::Foo + +example 2: + + my $plugins = Template::Plugins->new({ + PLUGIN_BASE => [ 'MyOrg::Template::Plugin', + 'YourOrg::Template::Plugin' ], + }); + + [% USE Foo %] # => MyOrg::Template::Plugin::Foo + or YourOrg::Template::Plugin::Foo + or Template::Plugin::Foo + + + + + + +=item LOAD_PERL + +If a plugin cannot be loaded using the PLUGINS or PLUGIN_BASE +approaches then the provider can make a final attempt to load the +module without prepending any prefix to the module path. This allows +regular Perl modules (i.e. those that don't reside in the +Template::Plugin or some other such namespace) to be loaded and used +as plugins. + +By default, the LOAD_PERL option is set to 0 and no attempt will be made +to load any Perl modules that aren't named explicitly in the PLUGINS +hash or reside in a package as named by one of the PLUGIN_BASE +components. + +Plugins loaded using the PLUGINS or PLUGIN_BASE receive a reference to +the current context object as the first argument to the new() +constructor. Modules loaded using LOAD_PERL are assumed to not +conform to the plugin interface. They must provide a new() class +method for instantiating objects but it will not receive a reference +to the context as the first argument. Plugin modules should provide a +load() class method (or inherit the default one from the +Template::Plugin base class) which is called the first time the plugin +is loaded. Regular Perl modules need not. In all other respects, +regular Perl objects and Template Toolkit plugins are identical. + +If a particular Perl module does not conform to the common, but not +unilateral, new() constructor convention then a simple plugin wrapper +can be written to interface to it. + + + + +=item TOLERANT + +The TOLERANT flag is used by the various Template Toolkit provider +modules (Template::Provider, Template::Plugins, Template::Filters) to +control their behaviour when errors are encountered. By default, any +errors are reported as such, with the request for the particular +resource (template, plugin, filter) being denied and an exception +raised. When the TOLERANT flag is set to any true values, errors will +be silently ignored and the provider will instead return +STATUS_DECLINED. This allows a subsequent provider to take +responsibility for providing the resource, rather than failing the +request outright. If all providers decline to service the request, +either through tolerated failure or a genuine disinclination to +comply, then a 'E<lt>resourceE<gt> not found' exception is raised. + + + + +=item DEBUG + +The DEBUG option can be used to enable debugging messages from the +Template::Plugins module by setting it to include the DEBUG_PLUGINS +value. + + use Template::Constants qw( :debug ); + + my $template = Template->new({ + DEBUG => DEBUG_FILTERS | DEBUG_PLUGINS, + }); + + + + +=back + + + +=head1 TEMPLATE TOOLKIT PLUGINS + +The following plugin modules are distributed with the Template +Toolkit. Some of the plugins interface to external modules (detailed +below) which should be downloaded from any CPAN site and installed +before using the plugin. + +=head2 Autoformat + +The Autoformat plugin is an interface to Damian Conway's Text::Autoformat +Perl module which provides advanced text wrapping and formatting. See +L<Template::Plugin::Autoformat> and L<Text::Autoformat> for further +details. + + [% USE autoformat(left=10, right=20) %] + [% autoformat(mytext) %] # call autoformat sub + [% mytext FILTER autoformat %] # or use autoformat filter + +The Text::Autoformat module is available from CPAN: + + http://www.cpan.org/modules/by-module/Text/ + +=head2 CGI + +The CGI plugin is a wrapper around Lincoln Stein's +E<lt>lstein@genome.wi.mit.eduE<gt> CGI.pm module. The plugin is +distributed with the Template Toolkit (see L<Template::Plugin::CGI>) +and the CGI module itself is distributed with recent versions Perl, +or is available from CPAN. + + [% USE CGI %] + [% CGI.param('param_name') %] + [% CGI.start_form %] + [% CGI.popup_menu( Name => 'color', + Values => [ 'Green', 'Brown' ] ) %] + [% CGI.end_form %] + +=head2 Datafile + +Provides an interface to data stored in a plain text file in a simple +delimited format. The first line in the file specifies field names +which should be delimiter by any non-word character sequence. +Subsequent lines define data using the same delimiter as int he first +line. Blank lines and comments (lines starting '#') are ignored. See +L<Template::Plugin::Datafile> for further details. + +/tmp/mydata: + + # define names for each field + id : email : name : tel + # here's the data + fred : fred@here.com : Fred Smith : 555-1234 + bill : bill@here.com : Bill White : 555-5678 + +example: + + [% USE userlist = datafile('/tmp/mydata') %] + + [% FOREACH user = userlist %] + [% user.name %] ([% user.id %]) + [% END %] + +=head2 Date + +The Date plugin provides an easy way to generate formatted time and date +strings by delegating to the POSIX strftime() routine. See +L<Template::Plugin::Date> and L<POSIX> for further details. + + [% USE date %] + [% date.format %] # current time/date + + File last modified: [% date.format(template.modtime) %] + +=head2 Directory + +The Directory plugin provides a simple interface to a directory and +the files within it. See L<Template::Plugin::Directory> for further +details. + + [% USE dir = Directory('/tmp') %] + [% FOREACH file = dir.files %] + # all the plain files in the directory + [% END %] + [% FOREACH file = dir.dirs %] + # all the sub-directories + [% END %] + +=head2 DBI + +The DBI plugin, developed by Simon Matthews +E<lt>sam@knowledgepool.comE<gt>, brings the full power of Tim Bunce's +E<lt>Tim.Bunce@ig.co.ukE<gt> database interface module (DBI) to your +templates. See L<Template::Plugin::DBI> and L<DBI> for further details. + + [% USE DBI('dbi:driver:database', 'user', 'pass') %] + + [% FOREACH user = DBI.query( 'SELECT * FROM users' ) %] + [% user.id %] [% user.name %] + [% END %] + +The DBI and relevant DBD modules are available from CPAN: + + http://www.cpan.org/modules/by-module/DBI/ + +=head2 Dumper + +The Dumper plugin provides an interface to the Data::Dumper module. See +L<Template::Plugin::Dumper> and L<Data::Dumper> for futher details. + + [% USE dumper(indent=0, pad="<br>") %] + [% dumper.dump(myvar, yourvar) %] + +=head2 File + +The File plugin provides a general abstraction for files and can be +used to fetch information about specific files within a filesystem. +See L<Template::Plugin::File> for further details. + + [% USE File('/tmp/foo.html') %] + [% File.name %] # foo.html + [% File.dir %] # /tmp + [% File.mtime %] # modification time + +=head2 Filter + +This module implements a base class plugin which can be subclassed +to easily create your own modules that define and install new filters. + + package MyOrg::Template::Plugin::MyFilter; + + use Template::Plugin::Filter; + use base qw( Template::Plugin::Filter ); + + sub filter { + my ($self, $text) = @_; + + # ...mungify $text... + + return $text; + } + + # now load it... + [% USE MyFilter %] + + # ...and use the returned object as a filter + [% FILTER $MyFilter %] + ... + [% END %] + +See L<Template::Plugin::Filter> for further details. + +=head2 Format + +The Format plugin provides a simple way to format text according to a +printf()-like format. See L<Template::Plugin::Format> for further +details. + + [% USE bold = format('<b>%s</b>') %] + [% bold('Hello') %] + +=head2 GD::Image, GD::Polygon, GD::Constants + +These plugins provide access to the GD graphics library via Lincoln +D. Stein's GD.pm interface. These plugins allow PNG, JPEG and other +graphical formats to be generated. + + [% FILTER null; + USE im = GD.Image(100,100); + # allocate some colors + black = im.colorAllocate(0, 0, 0); + red = im.colorAllocate(255,0, 0); + blue = im.colorAllocate(0, 0, 255); + # Draw a blue oval + im.arc(50,50,95,75,0,360,blue); + # And fill it with red + im.fill(50,50,red); + # Output image in PNG format + im.png | stdout(1); + END; + -%] + +See L<Template::Plugin::GD::Image> for further details. + +=head2 GD::Text, GD::Text::Align, GD::Text::Wrap + +These plugins provide access to Martien Verbruggen's GD::Text, +GD::Text::Align and GD::Text::Wrap modules. These plugins allow the +layout, alignment and wrapping of text when drawing text in GD images. + + [% FILTER null; + USE gd = GD.Image(200,400); + USE gdc = GD.Constants; + black = gd.colorAllocate(0, 0, 0); + green = gd.colorAllocate(0, 255, 0); + txt = "This is some long text. " | repeat(10); + USE wrapbox = GD.Text.Wrap(gd, + line_space => 4, + color => green, + text => txt, + ); + wrapbox.set_font(gdc.gdMediumBoldFont); + wrapbox.set(align => 'center', width => 160); + wrapbox.draw(20, 20); + gd.png | stdout(1); + END; + -%] + +See L<Template::Plugin::GD::Text>, L<Template::Plugin::GD::Text::Align> +and L<Template::Plugin::GD::Text::Wrap> for further details. + +=head2 GD::Graph::lines, GD::Graph::bars, GD::Graph::points, GD::Graph::linespoin +ts, GD::Graph::area, GD::Graph::mixed, GD::Graph::pie + +These plugins provide access to Martien Verbruggen's GD::Graph module +that allows graphs, plots and charts to be created. These plugins allow +graphs, plots and charts to be generated in PNG, JPEG and other +graphical formats. + + [% FILTER null; + data = [ + ["1st","2nd","3rd","4th","5th","6th"], + [ 4, 2, 3, 4, 3, 3.5] + ]; + USE my_graph = GD.Graph.pie(250, 200); + my_graph.set( + title => 'A Pie Chart', + label => 'Label', + axislabelclr => 'black', + pie_height => 36, + transparent => 0, + ); + my_graph.plot(data).png | stdout(1); + END; + -%] + +See +L<Template::Plugin::GD::Graph::lines>, +L<Template::Plugin::GD::Graph::bars>, +L<Template::Plugin::GD::Graph::points>, +L<Template::Plugin::GD::Graph::linespoints>, +L<Template::Plugin::GD::Graph::area>, +L<Template::Plugin::GD::Graph::mixed>, +L<Template::Plugin::GD::Graph::pie>, and +L<GD::Graph>, +for more details. + +=head2 GD::Graph::bars3d, GD::Graph::lines3d, GD::Graph::pie3d + +These plugins provide access to Jeremy Wadsack's GD::Graph3d +module. This allows 3D bar charts and 3D lines plots to +be generated. + + [% FILTER null; + data = [ + ["1st","2nd","3rd","4th","5th","6th","7th", "8th", "9th"], + [ 1, 2, 5, 6, 3, 1.5, 1, 3, 4], + ]; + USE my_graph = GD.Graph.bars3d(); + my_graph.set( + x_label => 'X Label', + y_label => 'Y label', + title => 'A 3d Bar Chart', + y_max_value => 8, + y_tick_number => 8, + y_label_skip => 2, + # shadows + bar_spacing => 8, + shadow_depth => 4, + shadowclr => 'dred', + transparent => 0, + my_graph.plot(data).png | stdout(1); + END; + -%] + +See +L<Template::Plugin::GD::Graph::lines3d>, +L<Template::Plugin::GD::Graph::bars3d>, and +L<Template::Plugin::GD::Graph::pie3d> +for more details. + +=head2 HTML + +The HTML plugin is very new and very basic, implementing a few useful +methods for generating HTML. It is likely to be extended in the future +or integrated with a larger project to generate HTML elements in a generic +way (as discussed recently on the mod_perl mailing list). + + [% USE HTML %] + [% HTML.escape("if (a < b && c > d) ..." %] + [% HTML.attributes(border => 1, cellpadding => 2) %] + [% HTML.element(table => { border => 1, cellpadding => 2 }) %] + +See L<Template::Plugin::HTML> for further details. + +=head2 Iterator + +The Iterator plugin provides a way to create a Template::Iterator +object to iterate over a data set. An iterator is created +automatically by the FOREACH directive and is aliased to the 'loop' +variable. This plugin allows an iterator to be explicitly created +with a given name, or the default plugin name, 'iterator'. See +L<Template::Plugin::Iterator> for further details. + + [% USE iterator(list, args) %] + + [% FOREACH item = iterator %] + [% '<ul>' IF iterator.first %] + <li>[% item %] + [% '</ul>' IF iterator.last %] + [% END %] + +=head2 Pod + +This plugin provides an interface to the L<Pod::POM|Pod::POM> module +which parses POD documents into an internal object model which can +then be traversed and presented through the Template Toolkit. + + [% USE Pod(podfile) %] + + [% FOREACH head1 = Pod.head1; + FOREACH head2 = head1/head2; + ... + END; + END + %] + +=head2 String + +The String plugin implements an object-oriented interface for +manipulating strings. See L<Template::Plugin::String> for further +details. + + [% USE String 'Hello' %] + [% String.append(' World') %] + + [% msg = String.new('Another string') %] + [% msg.replace('string', 'text') %] + + The string "[% msg %]" is [% msg.length %] characters long. + +=head2 Table + +The Table plugin allows you to format a list of data items into a +virtual table by specifying a fixed number of rows or columns, with +an optional overlap. See L<Template::Plugin::Table> for further +details. + + [% USE table(list, rows=10, overlap=1) %] + + [% FOREACH item = table.col(3) %] + [% item %] + [% END %] + +=head2 URL + +The URL plugin provides a simple way of contructing URLs from a base +part and a variable set of parameters. See L<Template::Plugin::URL> +for further details. + + [% USE mycgi = url('/cgi-bin/bar.pl', debug=1) %] + + [% mycgi %] + # ==> /cgi/bin/bar.pl?debug=1 + + [% mycgi(mode='submit') %] + # ==> /cgi/bin/bar.pl?mode=submit&debug=1 + +=head2 Wrap + +The Wrap plugin uses the Text::Wrap module by David Muir Sharnoff +E<lt>muir@idiom.comE<gt> (with help from Tim Pierce and many many others) +to provide simple paragraph formatting. See L<Template::Plugin::Wrap> +and L<Text::Wrap> for further details. + + [% USE wrap %] + [% wrap(mytext, 40, '* ', ' ') %] # use wrap sub + [% mytext FILTER wrap(40) -%] # or wrap FILTER + +The Text::Wrap module is available from CPAN: + + http://www.cpan.org/modules/by-module/Text/ + +=head2 XML::DOM + +The XML::DOM plugin gives access to the XML Document Object Module via +Clark Cooper E<lt>cooper@sch.ge.comE<gt> and Enno Derksen's +E<lt>enno@att.comE<gt> XML::DOM module. See L<Template::Plugin::XML::DOM> +and L<XML::DOM> for further details. + + [% USE dom = XML.DOM %] + [% doc = dom.parse(filename) %] + + [% FOREACH node = doc.getElementsByTagName('CODEBASE') %] + * [% node.getAttribute('href') %] + [% END %] + +The plugin requires the XML::DOM module, available from CPAN: + + http://www.cpan.org/modules/by-module/XML/ + +=head2 XML::RSS + +The XML::RSS plugin is a simple interface to Jonathan Eisenzopf's +E<lt>eisen@pobox.comE<gt> XML::RSS module. A RSS (Rich Site Summary) +file is typically used to store short news 'headlines' describing +different links within a site. This plugin allows you to parse RSS +files and format the contents accordingly using templates. +See L<Template::Plugin::XML::RSS> and L<XML::RSS> for further details. + + [% USE news = XML.RSS(filename) %] + + [% FOREACH item = news.items %] + <a href="[% item.link %]">[% item.title %]</a> + [% END %] + +The XML::RSS module is available from CPAN: + + http://www.cpan.org/modules/by-module/XML/ + +=head2 XML::Simple + +This plugin implements an interface to the L<XML::Simple|XML::Simple> +module. + + [% USE xml = XML.Simple(xml_file_or_text) %] + + [% xml.head.title %] + +See L<Template::Plugin::XML::Simple> for further details. + +=head2 XML::Style + +This plugin defines a filter for performing simple stylesheet based +transformations of XML text. + + [% USE xmlstyle + table = { + attributes = { + border = 0 + cellpadding = 4 + cellspacing = 1 + } + } + %] + + [% FILTER xmlstyle %] + <table> + <tr> + <td>Foo</td> <td>Bar</td> <td>Baz</td> + </tr> + </table> + [% END %] + +See L<Template::Plugin::XML::Style> for further details. + +=head2 XML::XPath + +The XML::XPath plugin provides an interface to Matt Sergeant's +E<lt>matt@sergeant.orgE<gt> XML::XPath module. See +L<Template::Plugin::XML::XPath> and L<XML::XPath> for further details. + + [% USE xpath = XML.XPath(xmlfile) %] + [% FOREACH page = xpath.findnodes('/html/body/page') %] + [% page.getAttribute('title') %] + [% END %] + +The plugin requires the XML::XPath module, available from CPAN: + + http://www.cpan.org/modules/by-module/XML/ + + + + +=head1 BUGS / ISSUES + +=over 4 + +=item * + +It might be worthwhile being able to distinguish between absolute +module names and those which should be applied relative to PLUGIN_BASE +directories. For example, use 'MyNamespace::MyModule' to denote +absolute module names (e.g. LOAD_PERL), and 'MyNamespace.MyModule' to +denote relative to PLUGIN_BASE. + +=back + +=head1 AUTHOR + +Andy Wardley E<lt>abw@andywardley.comE<gt> + +L<http://www.andywardley.com/|http://www.andywardley.com/> + + + + +=head1 VERSION + +2.65, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L<Template|Template>, L<Template::Plugin|Template::Plugin>, L<Template::Context|Template::Context> diff --git a/lib/Template/Provider.pm b/lib/Template/Provider.pm new file mode 100644 index 0000000..ee599de --- /dev/null +++ b/lib/Template/Provider.pm @@ -0,0 +1,1433 @@ +#============================================================= -*-Perl-*- +# +# Template::Provider +# +# DESCRIPTION +# This module implements a class which handles the loading, compiling +# and caching of templates. Multiple Template::Provider objects can +# be stacked and queried in turn to effect a Chain-of-Command between +# them. A provider will attempt to return the requested template, +# an error (STATUS_ERROR) or decline to provide the template +# (STATUS_DECLINE), allowing subsequent providers to attempt to +# deliver it. See 'Design Patterns' for further details. +# +# AUTHOR +# Andy Wardley <abw@kfs.org> +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +# TODO: +# * optional provider prefix (e.g. 'http:') +# * fold ABSOLUTE and RELATIVE test cases into one regex? +# +#---------------------------------------------------------------------------- +# +# $Id: Provider.pm,v 2.70 2003/04/24 09:14:38 abw Exp $ +# +#============================================================================ + +package Template::Provider; + +require 5.004; + +use strict; +use vars qw( $VERSION $DEBUG $ERROR $DOCUMENT $STAT_TTL $MAX_DIRS ); +use base qw( Template::Base ); +use Template::Config; +use Template::Constants; +use Template::Document; +use File::Basename; +use File::Spec; + +$VERSION = sprintf("%d.%02d", q$Revision: 2.70 $ =~ /(\d+)\.(\d+)/); + +# name of document class +$DOCUMENT = 'Template::Document' unless defined $DOCUMENT; + +# maximum time between performing stat() on file to check staleness +$STAT_TTL = 1 unless defined $STAT_TTL; + +# maximum number of directories in an INCLUDE_PATH, to prevent runaways +$MAX_DIRS = 64 unless defined $MAX_DIRS; + +use constant PREV => 0; +use constant NAME => 1; +use constant DATA => 2; +use constant LOAD => 3; +use constant NEXT => 4; +use constant STAT => 5; + +$DEBUG = 0 unless defined $DEBUG; + +#======================================================================== +# -- PUBLIC METHODS -- +#======================================================================== + +#------------------------------------------------------------------------ +# fetch($name) +# +# Returns a compiled template for the name specified by parameter. +# The template is returned from the internal cache if it exists, or +# loaded and then subsequently cached. The ABSOLUTE and RELATIVE +# configuration flags determine if absolute (e.g. '/something...') +# and/or relative (e.g. './something') paths should be honoured. The +# INCLUDE_PATH is otherwise used to find the named file. $name may +# also be a reference to a text string containing the template text, +# or a file handle from which the content is read. The compiled +# template is not cached in these latter cases given that there is no +# filename to cache under. A subsequent call to store($name, +# $compiled) can be made to cache the compiled template for future +# fetch() calls, if necessary. +# +# Returns a compiled template or (undef, STATUS_DECLINED) if the +# template could not be found. On error (e.g. the file was found +# but couldn't be read or parsed), the pair ($error, STATUS_ERROR) +# is returned. The TOLERANT configuration option can be set to +# downgrade any errors to STATUS_DECLINE. +#------------------------------------------------------------------------ + +sub fetch { + my ($self, $name) = @_; + my ($data, $error); + + if (ref $name) { + # $name can be a reference to a scalar, GLOB or file handle + ($data, $error) = $self->_load($name); + ($data, $error) = $self->_compile($data) + unless $error; + $data = $data->{ data } + unless $error; + } + elsif (File::Spec->file_name_is_absolute($name)) { + # absolute paths (starting '/') allowed if ABSOLUTE set + ($data, $error) = $self->{ ABSOLUTE } + ? $self->_fetch($name) + : $self->{ TOLERANT } + ? (undef, Template::Constants::STATUS_DECLINED) + : ("$name: absolute paths are not allowed (set ABSOLUTE option)", + Template::Constants::STATUS_ERROR); + } + elsif ($name =~ m[^\.+/]) { + # anything starting "./" is relative to cwd, allowed if RELATIVE set + ($data, $error) = $self->{ RELATIVE } + ? $self->_fetch($name) + : $self->{ TOLERANT } + ? (undef, Template::Constants::STATUS_DECLINED) + : ("$name: relative paths are not allowed (set RELATIVE option)", + Template::Constants::STATUS_ERROR); + } + else { + # otherwise, it's a file name relative to INCLUDE_PATH + ($data, $error) = $self->{ INCLUDE_PATH } + ? $self->_fetch_path($name) + : (undef, Template::Constants::STATUS_DECLINED); + } + +# $self->_dump_cache() +# if $DEBUG > 1; + + return ($data, $error); +} + + +#------------------------------------------------------------------------ +# store($name, $data) +# +# Store a compiled template ($data) in the cached as $name. +#------------------------------------------------------------------------ + +sub store { + my ($self, $name, $data) = @_; + $self->_store($name, { + data => $data, + load => 0, + }); +} + + +#------------------------------------------------------------------------ +# load($name) +# +# Load a template without parsing/compiling it, suitable for use with +# the INSERT directive. There's some duplication with fetch() and at +# some point this could be reworked to integrate them a little closer. +#------------------------------------------------------------------------ + +sub load { + my ($self, $name) = @_; + my ($data, $error); + my $path = $name; + + if (File::Spec->file_name_is_absolute($name)) { + # absolute paths (starting '/') allowed if ABSOLUTE set + $error = "$name: absolute paths are not allowed (set ABSOLUTE option)" + unless $self->{ ABSOLUTE }; + } + elsif ($name =~ m[^\.+/]) { + # anything starting "./" is relative to cwd, allowed if RELATIVE set + $error = "$name: relative paths are not allowed (set RELATIVE option)" + unless $self->{ RELATIVE }; + } + else { + INCPATH: { + # otherwise, it's a file name relative to INCLUDE_PATH + my $paths = $self->paths() + || return ($self->error(), Template::Constants::STATUS_ERROR); + + foreach my $dir (@$paths) { + $path = "$dir/$name"; + last INCPATH + if -f $path; + } + undef $path; # not found + } + } + + if (defined $path && ! $error) { + local $/ = undef; # slurp files in one go + local *FH; + if (open(FH, $path)) { + $data = <FH>; + close(FH); + } + else { + $error = "$name: $!"; + } + } + + if ($error) { + return $self->{ TOLERANT } + ? (undef, Template::Constants::STATUS_DECLINED) + : ($error, Template::Constants::STATUS_ERROR); + } + elsif (! defined $path) { + return (undef, Template::Constants::STATUS_DECLINED); + } + else { + return ($data, Template::Constants::STATUS_OK); + } +} + + + +#------------------------------------------------------------------------ +# include_path(\@newpath) +# +# Accessor method for the INCLUDE_PATH setting. If called with an +# argument, this method will replace the existing INCLUDE_PATH with +# the new value. +#------------------------------------------------------------------------ + +sub include_path { + my ($self, $path) = @_; + $self->{ INCLUDE_PATH } = $path if $path; + return $self->{ INCLUDE_PATH }; +} + + +#------------------------------------------------------------------------ +# paths() +# +# Evaluates the INCLUDE_PATH list, ignoring any blank entries, and +# calling and subroutine or object references to return dynamically +# generated path lists. Returns a reference to a new list of paths +# or undef on error. +#------------------------------------------------------------------------ + +sub paths { + my $self = shift; + my @ipaths = @{ $self->{ INCLUDE_PATH } }; + my (@opaths, $dpaths, $dir); + my $count = $MAX_DIRS; + + while (@ipaths && --$count) { + $dir = shift @ipaths || next; + + # $dir can be a sub or object ref which returns a reference + # to a dynamically generated list of search paths. + + if (ref $dir eq 'CODE') { + eval { $dpaths = &$dir() }; + if ($@) { + chomp $@; + return $self->error($@); + } + unshift(@ipaths, @$dpaths); + next; + } + elsif (UNIVERSAL::can($dir, 'paths')) { + $dpaths = $dir->paths() + || return $self->error($dir->error()); + unshift(@ipaths, @$dpaths); + next; + } + else { + push(@opaths, $dir); + } + } + return $self->error("INCLUDE_PATH exceeds $MAX_DIRS directories") + if @ipaths; + + return \@opaths; +} + + +#------------------------------------------------------------------------ +# DESTROY +# +# The provider cache is implemented as a doubly linked list which Perl +# cannot free by itself due to the circular references between NEXT <=> +# PREV items. This cleanup method walks the list deleting all the NEXT/PREV +# references, allowing the proper cleanup to occur and memory to be +# repooled. +#------------------------------------------------------------------------ + +sub DESTROY { + my $self = shift; + my ($slot, $next); + + $slot = $self->{ HEAD }; + while ($slot) { + $next = $slot->[ NEXT ]; + undef $slot->[ PREV ]; + undef $slot->[ NEXT ]; + $slot = $next; + } + undef $self->{ HEAD }; + undef $self->{ TAIL }; +} + + + + +#======================================================================== +# -- PRIVATE METHODS -- +#======================================================================== + +#------------------------------------------------------------------------ +# _init() +# +# Initialise the cache. +#------------------------------------------------------------------------ + +sub _init { + my ($self, $params) = @_; + my $size = $params->{ CACHE_SIZE }; + my $path = $params->{ INCLUDE_PATH } || '.'; + my $cdir = $params->{ COMPILE_DIR } || ''; + my $dlim = $params->{ DELIMITER }; + my $debug; + + # tweak delim to ignore C:/ + unless (defined $dlim) { + $dlim = ($^O eq 'MSWin32') ? ':(?!\\/)' : ':'; + } + + # coerce INCLUDE_PATH to an array ref, if not already so + $path = [ split(/$dlim/, $path) ] + unless ref $path eq 'ARRAY'; + + # don't allow a CACHE_SIZE 1 because it breaks things and the + # additional checking isn't worth it + $size = 2 + if defined $size && ($size == 1 || $size < 0); + + if (defined ($debug = $params->{ DEBUG })) { + $self->{ DEBUG } = $debug & ( Template::Constants::DEBUG_PROVIDER + | Template::Constants::DEBUG_FLAGS ); + } + else { + $self->{ DEBUG } = $DEBUG; + } + + if ($self->{ DEBUG }) { + local $" = ', '; + $self->debug("creating cache of ", + defined $size ? $size : 'unlimited', + " slots for [ @$path ]"); + } + + # create COMPILE_DIR and sub-directories representing each INCLUDE_PATH + # element in which to store compiled files + if ($cdir) { + +# Stas' hack +# # this is a hack to solve the problem with INCLUDE_PATH using +# # relative dirs +# my $segments = 0; +# for (@$path) { +# my $c = 0; +# $c++ while m|\.\.|g; +# $segments = $c if $c > $segments; +# } +# $cdir .= "/".join "/",('hack') x $segments if $segments; +# + + require File::Path; + foreach my $dir (@$path) { + next if ref $dir; + my $wdir = $dir; + $wdir =~ s[:][]g if $^O eq 'MSWin32'; + $wdir =~ /(.*)/; # untaint + &File::Path::mkpath(File::Spec->catfile($cdir, $1)); + } + } + + $self->{ LOOKUP } = { }; + $self->{ SLOTS } = 0; + $self->{ SIZE } = $size; + $self->{ INCLUDE_PATH } = $path; + $self->{ DELIMITER } = $dlim; + $self->{ COMPILE_DIR } = $cdir; + $self->{ COMPILE_EXT } = $params->{ COMPILE_EXT } || ''; + $self->{ ABSOLUTE } = $params->{ ABSOLUTE } || 0; + $self->{ RELATIVE } = $params->{ RELATIVE } || 0; + $self->{ TOLERANT } = $params->{ TOLERANT } || 0; + $self->{ DOCUMENT } = $params->{ DOCUMENT } || $DOCUMENT; + $self->{ PARSER } = $params->{ PARSER }; + $self->{ DEFAULT } = $params->{ DEFAULT }; +# $self->{ PREFIX } = $params->{ PREFIX }; + $self->{ PARAMS } = $params; + + return $self; +} + + +#------------------------------------------------------------------------ +# _fetch($name) +# +# Fetch a file from cache or disk by specification of an absolute or +# relative filename. No search of the INCLUDE_PATH is made. If the +# file is found and loaded, it is compiled and cached. +#------------------------------------------------------------------------ + +sub _fetch { + my ($self, $name) = @_; + my $size = $self->{ SIZE }; + my ($slot, $data, $error); + + $self->debug("_fetch($name)") if $self->{ DEBUG }; + + my $compiled = $self->_compiled_filename($name); + + if (defined $size && ! $size) { + # caching disabled so load and compile but don't cache + if ($compiled && -f $compiled && (stat($name))[9] <= (stat($compiled))[9]) { + $data = $self->_load_compiled($compiled); + $error = $self->error() unless $data; + } + else { + ($data, $error) = $self->_load($name); + ($data, $error) = $self->_compile($data, $compiled) + unless $error; + $data = $data->{ data } + unless $error; + } + } + elsif ($slot = $self->{ LOOKUP }->{ $name }) { + # cached entry exists, so refresh slot and extract data + ($data, $error) = $self->_refresh($slot); + $data = $slot->[ DATA ] + unless $error; + } + else { + # nothing in cache so try to load, compile and cache + if ($compiled && -f $compiled && (stat($name))[9] <= (stat($compiled))[9]) { + $data = $self->_load_compiled($compiled); + $error = $self->error() unless $data; + $self->store($name, $data) unless $error; + } + else { + ($data, $error) = $self->_load($name); + ($data, $error) = $self->_compile($data, $compiled) + unless $error; + $data = $self->_store($name, $data) + unless $error; + } + + } + + return ($data, $error); +} + + +#------------------------------------------------------------------------ +# _fetch_path($name) +# +# Fetch a file from cache or disk by specification of an absolute cache +# name (e.g. 'header') or filename relative to one of the INCLUDE_PATH +# directories. If the file isn't already cached and can be found and +# loaded, it is compiled and cached under the full filename. +#------------------------------------------------------------------------ + +sub _fetch_path { + my ($self, $name) = @_; + my ($size, $compext, $compdir) = + @$self{ qw( SIZE COMPILE_EXT COMPILE_DIR ) }; + my ($dir, $paths, $path, $compiled, $slot, $data, $error); + local *FH; + + $self->debug("_fetch_path($name)") if $self->{ DEBUG }; + + # caching is enabled if $size is defined and non-zero or undefined + my $caching = (! defined $size || $size); + + INCLUDE: { + + # the template may have been stored using a non-filename name + if ($caching && ($slot = $self->{ LOOKUP }->{ $name })) { + # cached entry exists, so refresh slot and extract data + ($data, $error) = $self->_refresh($slot); + $data = $slot->[ DATA ] + unless $error; + last INCLUDE; + } + + $paths = $self->paths() || do { + $error = Template::Constants::STATUS_ERROR; + $data = $self->error(); + last INCLUDE; + }; + + # search the INCLUDE_PATH for the file, in cache or on disk + foreach $dir (@$paths) { + $path = "$dir/$name"; + + $self->debug("searching path: $path\n") if $self->{ DEBUG }; + + if ($caching && ($slot = $self->{ LOOKUP }->{ $path })) { + # cached entry exists, so refresh slot and extract data + ($data, $error) = $self->_refresh($slot); + $data = $slot->[ DATA ] + unless $error; + last INCLUDE; + } + elsif (-f $path) { + $compiled = $self->_compiled_filename($path) + if $compext || $compdir; + + if ($compiled && -f $compiled && (stat($path))[9] <= (stat($compiled))[9]) { + if ($data = $self->_load_compiled($compiled)) { + # store in cache + $data = $self->store($path, $data); + $error = Template::Constants::STATUS_OK; + last INCLUDE; + } + else { + warn($self->error(), "\n"); + } + } + # $compiled is set if an attempt to write the compiled + # template to disk should be made + + ($data, $error) = $self->_load($path, $name); + ($data, $error) = $self->_compile($data, $compiled) + unless $error; + $data = $self->_store($path, $data) + unless $error || ! $caching; + $data = $data->{ data } if ! $caching; + # all done if $error is OK or ERROR + last INCLUDE if ! $error + || $error == Template::Constants::STATUS_ERROR; + } + } + # template not found, so look for a DEFAULT template + my $default; + if (defined ($default = $self->{ DEFAULT }) && $name ne $default) { + $name = $default; + redo INCLUDE; + } + ($data, $error) = (undef, Template::Constants::STATUS_DECLINED); + } # INCLUDE + + return ($data, $error); +} + + + +sub _compiled_filename { + my ($self, $file) = @_; + my ($compext, $compdir) = @$self{ qw( COMPILE_EXT COMPILE_DIR ) }; + my ($path, $compiled); + + return undef + unless $compext || $compdir; + + $path = $file; + $path =~ /^(.+)$/s or die "invalid filename: $path"; + $path =~ s[:][]g if $^O eq 'MSWin32'; + + $compiled = "$path$compext"; + $compiled = File::Spec->catfile($compdir, $compiled) if length $compdir; + + return $compiled; +} + + +sub _load_compiled { + my ($self, $file) = @_; + my $compiled; + + # load compiled template via require(); we zap any + # %INC entry to ensure it is reloaded (we don't + # want 1 returned by require() to say it's in memory) + delete $INC{ $file }; + eval { $compiled = require $file; }; + return $@ + ? $self->error("compiled template $compiled: $@") + : $compiled; +} + + + +#------------------------------------------------------------------------ +# _load($name, $alias) +# +# Load template text from a string ($name = scalar ref), GLOB or file +# handle ($name = ref), or from an absolute filename ($name = scalar). +# Returns a hash array containing the following items: +# name filename or $alias, if provided, or 'input text', etc. +# text template text +# time modification time of file, or current time for handles/strings +# load time file was loaded (now!) +# +# On error, returns ($error, STATUS_ERROR), or (undef, STATUS_DECLINED) +# if TOLERANT is set. +#------------------------------------------------------------------------ + +sub _load { + my ($self, $name, $alias) = @_; + my ($data, $error); + my $tolerant = $self->{ TOLERANT }; + my $now = time; + local $/ = undef; # slurp files in one go + local *FH; + + $alias = $name unless defined $alias or ref $name; + + $self->debug("_load($name, ", defined $alias ? $alias : '<no alias>', + ')') if $self->{ DEBUG }; + + LOAD: { + if (ref $name eq 'SCALAR') { + # $name can be a SCALAR reference to the input text... + $data = { + name => defined $alias ? $alias : 'input text', + text => $$name, + time => $now, + load => 0, + }; + } + elsif (ref $name) { + # ...or a GLOB or file handle... + my $text = <$name>; + $data = { + name => defined $alias ? $alias : 'input file handle', + text => $text, + time => $now, + load => 0, + }; + } + elsif (-f $name) { + if (open(FH, $name)) { + my $text = <FH>; + $data = { + name => $alias, + text => $text, + time => (stat $name)[9], + load => $now, + }; + } + elsif ($tolerant) { + ($data, $error) = (undef, Template::Constants::STATUS_DECLINED); + } + else { + $data = "$alias: $!"; + $error = Template::Constants::STATUS_ERROR; + } + } + else { + ($data, $error) = (undef, Template::Constants::STATUS_DECLINED); + } + } + + return ($data, $error); +} + + +#------------------------------------------------------------------------ +# _refresh(\@slot) +# +# Private method called to mark a cache slot as most recently used. +# A reference to the slot array should be passed by parameter. The +# slot is relocated to the head of the linked list. If the file from +# which the data was loaded has been upated since it was compiled, then +# it is re-loaded from disk and re-compiled. +#------------------------------------------------------------------------ + +sub _refresh { + my ($self, $slot) = @_; + my ($head, $file, $data, $error); + + + $self->debug("_refresh([ ", + join(', ', map { defined $_ ? $_ : '<undef>' } @$slot), + '])') if $self->{ DEBUG }; + + # if it's more than $STAT_TTL seconds since we last performed a + # stat() on the file then we need to do it again and see if the file + # time has changed + if ( (time - $slot->[ STAT ]) > $STAT_TTL && stat $slot->[ NAME ] ) { + $slot->[ STAT ] = time; + + if ( (stat(_))[9] != $slot->[ LOAD ]) { + + $self->debug("refreshing cache file ", $slot->[ NAME ]) + if $self->{ DEBUG }; + + ($data, $error) = $self->_load($slot->[ NAME ], + $slot->[ DATA ]->{ name }); + ($data, $error) = $self->_compile($data) + unless $error; + + unless ($error) { + $slot->[ DATA ] = $data->{ data }; + $slot->[ LOAD ] = $data->{ time }; + } + } + } + + unless( $self->{ HEAD } == $slot ) { + # remove existing slot from usage chain... + if ($slot->[ PREV ]) { + $slot->[ PREV ]->[ NEXT ] = $slot->[ NEXT ]; + } + else { + $self->{ HEAD } = $slot->[ NEXT ]; + } + if ($slot->[ NEXT ]) { + $slot->[ NEXT ]->[ PREV ] = $slot->[ PREV ]; + } + else { + $self->{ TAIL } = $slot->[ PREV ]; + } + + # ..and add to start of list + $head = $self->{ HEAD }; + $head->[ PREV ] = $slot if $head; + $slot->[ PREV ] = undef; + $slot->[ NEXT ] = $head; + $self->{ HEAD } = $slot; + } + + return ($data, $error); +} + + +#------------------------------------------------------------------------ +# _store($name, $data) +# +# Private method called to add a data item to the cache. If the cache +# size limit has been reached then the oldest entry at the tail of the +# list is removed and its slot relocated to the head of the list and +# reused for the new data item. If the cache is under the size limit, +# or if no size limit is defined, then the item is added to the head +# of the list. +#------------------------------------------------------------------------ + +sub _store { + my ($self, $name, $data, $compfile) = @_; + my $size = $self->{ SIZE }; + my ($slot, $head); + + # extract the load time and compiled template from the data +# my $load = $data->{ load }; + my $load = (stat($name))[9]; + $data = $data->{ data }; + + $self->debug("_store($name, $data)") if $self->{ DEBUG }; + + if (defined $size && $self->{ SLOTS } >= $size) { + # cache has reached size limit, so reuse oldest entry + + $self->debug("reusing oldest cache entry (size limit reached: $size)\nslots: $self->{ SLOTS }") if $self->{ DEBUG }; + + # remove entry from tail of list + $slot = $self->{ TAIL }; + $slot->[ PREV ]->[ NEXT ] = undef; + $self->{ TAIL } = $slot->[ PREV ]; + + # remove name lookup for old node + delete $self->{ LOOKUP }->{ $slot->[ NAME ] }; + + # add modified node to head of list + $head = $self->{ HEAD }; + $head->[ PREV ] = $slot if $head; + @$slot = ( undef, $name, $data, $load, $head, time ); + $self->{ HEAD } = $slot; + + # add name lookup for new node + $self->{ LOOKUP }->{ $name } = $slot; + } + else { + # cache is under size limit, or none is defined + + $self->debug("adding new cache entry") if $self->{ DEBUG }; + + # add new node to head of list + $head = $self->{ HEAD }; + $slot = [ undef, $name, $data, $load, $head, time ]; + $head->[ PREV ] = $slot if $head; + $self->{ HEAD } = $slot; + $self->{ TAIL } = $slot unless $self->{ TAIL }; + + # add lookup from name to slot and increment nslots + $self->{ LOOKUP }->{ $name } = $slot; + $self->{ SLOTS }++; + } + + return $data; +} + + +#------------------------------------------------------------------------ +# _compile($data) +# +# Private method called to parse the template text and compile it into +# a runtime form. Creates and delegates a Template::Parser object to +# handle the compilation, or uses a reference passed in PARSER. On +# success, the compiled template is stored in the 'data' item of the +# $data hash and returned. On error, ($error, STATUS_ERROR) is returned, +# or (undef, STATUS_DECLINED) if the TOLERANT flag is set. +# The optional $compiled parameter may be passed to specify +# the name of a compiled template file to which the generated Perl +# code should be written. Errors are (for now...) silently +# ignored, assuming that failures to open a file for writing are +# intentional (e.g directory write permission). +#------------------------------------------------------------------------ + +sub _compile { + my ($self, $data, $compfile) = @_; + my $text = $data->{ text }; + my ($parsedoc, $error); + + $self->debug("_compile($data, ", + defined $compfile ? $compfile : '<no compfile>', ')') + if $self->{ DEBUG }; + + my $parser = $self->{ PARSER } + ||= Template::Config->parser($self->{ PARAMS }) + || return (Template::Config->error(), Template::Constants::STATUS_ERROR); + + # discard the template text - we don't need it any more + delete $data->{ text }; + + # call parser to compile template into Perl code + if ($parsedoc = $parser->parse($text, $data)) { + + $parsedoc->{ METADATA } = { + 'name' => $data->{ name }, + 'modtime' => $data->{ time }, + %{ $parsedoc->{ METADATA } }, + }; + + # write the Perl code to the file $compfile, if defined + if ($compfile) { + my $basedir = &File::Basename::dirname($compfile); + $basedir =~ /(.*)/; + $basedir = $1; + &File::Path::mkpath($basedir) unless -d $basedir; + + my $docclass = $self->{ DOCUMENT }; + $error = 'cache failed to write ' + . &File::Basename::basename($compfile) + . ': ' . $docclass->error() + unless $docclass->write_perl_file($compfile, $parsedoc); + + # set atime and mtime of newly compiled file, don't bother + # if time is undef + if (!defined($error) && defined $data->{ time }) { + my ($cfile) = $compfile =~ /^(.+)$/s or do { + return("invalid filename: $compfile", + Template::Constants::STATUS_ERROR); + }; + + my ($ctime) = $data->{ time } =~ /^(\d+)$/; + unless ($ctime || $ctime eq 0) { + return("invalid time: $ctime", + Template::Constants::STATUS_ERROR); + } + utime($ctime, $ctime, $cfile); + } + } + + unless ($error) { + return $data ## RETURN ## + if $data->{ data } = Template::Document->new($parsedoc); + $error = $Template::Document::ERROR; + } + } + else { + $error = Template::Exception->new( 'parse', "$data->{ name } " . + $parser->error() ); + } + + # return STATUS_ERROR, or STATUS_DECLINED if we're being tolerant + return $self->{ TOLERANT } + ? (undef, Template::Constants::STATUS_DECLINED) + : ($error, Template::Constants::STATUS_ERROR) +} + + +#------------------------------------------------------------------------ +# _dump() +# +# Debug method which returns a string representing the internal object +# state. +#------------------------------------------------------------------------ + +sub _dump { + my $self = shift; + my $size = $self->{ SIZE }; + my $parser = $self->{ PARSER }; + $parser = $parser ? $parser->_dump() : '<no parser>'; + $parser =~ s/\n/\n /gm; + $size = 'unlimited' unless defined $size; + + my $output = "[Template::Provider] {\n"; + my $format = " %-16s => %s\n"; + my $key; + + $output .= sprintf($format, 'INCLUDE_PATH', + '[ ' . join(', ', @{ $self->{ INCLUDE_PATH } }) . ' ]'); + $output .= sprintf($format, 'CACHE_SIZE', $size); + + foreach $key (qw( ABSOLUTE RELATIVE TOLERANT DELIMITER + COMPILE_EXT COMPILE_DIR )) { + $output .= sprintf($format, $key, $self->{ $key }); + } + $output .= sprintf($format, 'PARSER', $parser); + + + local $" = ', '; + my $lookup = $self->{ LOOKUP }; + $lookup = join('', map { + sprintf(" $format", $_, defined $lookup->{ $_ } + ? ('[ ' . join(', ', map { defined $_ ? $_ : '<undef>' } + @{ $lookup->{ $_ } }) . ' ]') : '<undef>'); + } sort keys %$lookup); + $lookup = "{\n$lookup }"; + + $output .= sprintf($format, LOOKUP => $lookup); + + $output .= '}'; + return $output; +} + + +#------------------------------------------------------------------------ +# _dump_cache() +# +# Debug method which prints the current state of the cache to STDERR. +#------------------------------------------------------------------------ + +sub _dump_cache { + my $self = shift; + my ($node, $lut, $count); + + $count = 0; + if ($node = $self->{ HEAD }) { + while ($node) { + $lut->{ $node } = $count++; + $node = $node->[ NEXT ]; + } + $node = $self->{ HEAD }; + print STDERR "CACHE STATE:\n"; + print STDERR " HEAD: ", $self->{ HEAD }->[ NAME ], "\n"; + print STDERR " TAIL: ", $self->{ TAIL }->[ NAME ], "\n"; + while ($node) { + my ($prev, $name, $data, $load, $next) = @$node; +# $name = '...' . substr($name, -10) if length $name > 10; + $prev = $prev ? "#$lut->{ $prev }<-": '<undef>'; + $next = $next ? "->#$lut->{ $next }": '<undef>'; + print STDERR " #$lut->{ $node } : [ $prev, $name, $data, $load, $next ]\n"; + $node = $node->[ NEXT ]; + } + } +} + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Provider - Provider module for loading/compiling templates + +=head1 SYNOPSIS + + $provider = Template::Provider->new(\%options); + + ($template, $error) = $provider->fetch($name); + +=head1 DESCRIPTION + +The Template::Provider is used to load, parse, compile and cache template +documents. This object may be sub-classed to provide more specific +facilities for loading, or otherwise providing access to templates. + +The Template::Context objects maintain a list of Template::Provider +objects which are polled in turn (via fetch()) to return a requested +template. Each may return a compiled template, raise an error, or +decline to serve the reqest, giving subsequent providers a chance to +do so. + +This is the "Chain of Responsiblity" pattern. See 'Design Patterns' for +further information. + +This documentation needs work. + +=head1 PUBLIC METHODS + +=head2 new(\%options) + +Constructor method which instantiates and returns a new Template::Provider +object. The optional parameter may be a hash reference containing any of +the following items: + +=over 4 + + + + +=item INCLUDE_PATH + +The INCLUDE_PATH is used to specify one or more directories in which +template files are located. When a template is requested that isn't +defined locally as a BLOCK, each of the INCLUDE_PATH directories is +searched in turn to locate the template file. Multiple directories +can be specified as a reference to a list or as a single string where +each directory is delimited by ':'. + + my $provider = Template::Provider->new({ + INCLUDE_PATH => '/usr/local/templates', + }); + + my $provider = Template::Provider->new({ + INCLUDE_PATH => '/usr/local/templates:/tmp/my/templates', + }); + + my $provider = Template::Provider->new({ + INCLUDE_PATH => [ '/usr/local/templates', + '/tmp/my/templates' ], + }); + +On Win32 systems, a little extra magic is invoked, ignoring delimiters +that have ':' followed by a '/' or '\'. This avoids confusion when using +directory names like 'C:\Blah Blah'. + +When specified as a list, the INCLUDE_PATH path can contain elements +which dynamically generate a list of INCLUDE_PATH directories. These +generator elements can be specified as a reference to a subroutine or +an object which implements a paths() method. + + my $provider = Template::Provider->new({ + INCLUDE_PATH => [ '/usr/local/templates', + \&incpath_generator, + My::IncPath::Generator->new( ... ) ], + }); + +Each time a template is requested and the INCLUDE_PATH examined, the +subroutine or object method will be called. A reference to a list of +directories should be returned. Generator subroutines should report +errors using die(). Generator objects should return undef and make an +error available via its error() method. + +For example: + + sub incpath_generator { + + # ...some code... + + if ($all_is_well) { + return \@list_of_directories; + } + else { + die "cannot generate INCLUDE_PATH...\n"; + } + } + +or: + + package My::IncPath::Generator; + + # Template::Base (or Class::Base) provides error() method + use Template::Base; + use base qw( Template::Base ); + + sub paths { + my $self = shift; + + # ...some code... + + if ($all_is_well) { + return \@list_of_directories; + } + else { + return $self->error("cannot generate INCLUDE_PATH...\n"); + } + } + + 1; + + + + + +=item DELIMITER + +Used to provide an alternative delimiter character sequence for +separating paths specified in the INCLUDE_PATH. The default +value for DELIMITER is ':'. + + # tolerate Silly Billy's file system conventions + my $provider = Template::Provider->new({ + DELIMITER => '; ', + INCLUDE_PATH => 'C:/HERE/NOW; D:/THERE/THEN', + }); + + # better solution: install Linux! :-) + +On Win32 systems, the default delimiter is a little more intelligent, +splitting paths only on ':' characters that aren't followed by a '/'. +This means that the following should work as planned, splitting the +INCLUDE_PATH into 2 separate directories, C:/foo and C:/bar. + + # on Win32 only + my $provider = Template::Provider->new({ + INCLUDE_PATH => 'C:/Foo:C:/Bar' + }); + +However, if you're using Win32 then it's recommended that you +explicitly set the DELIMITER character to something else (e.g. ';') +rather than rely on this subtle magic. + + + + +=item ABSOLUTE + +The ABSOLUTE flag is used to indicate if templates specified with +absolute filenames (e.g. '/foo/bar') should be processed. It is +disabled by default and any attempt to load a template by such a +name will cause a 'file' exception to be raised. + + my $provider = Template::Provider->new({ + ABSOLUTE => 1, + }); + + # this is why it's disabled by default + [% INSERT /etc/passwd %] + +On Win32 systems, the regular expression for matching absolute +pathnames is tweaked slightly to also detect filenames that start +with a driver letter and colon, such as: + + C:/Foo/Bar + + + + + + +=item RELATIVE + +The RELATIVE flag is used to indicate if templates specified with +filenames relative to the current directory (e.g. './foo/bar' or +'../../some/where/else') should be loaded. It is also disabled by +default, and will raise a 'file' error if such template names are +encountered. + + my $provider = Template::Provider->new({ + RELATIVE => 1, + }); + + [% INCLUDE ../logs/error.log %] + + + + + +=item DEFAULT + +The DEFAULT option can be used to specify a default template which should +be used whenever a specified template can't be found in the INCLUDE_PATH. + + my $provider = Template::Provider->new({ + DEFAULT => 'notfound.html', + }); + +If a non-existant template is requested through the Template process() +method, or by an INCLUDE, PROCESS or WRAPPER directive, then the +DEFAULT template will instead be processed, if defined. Note that the +DEFAULT template is not used when templates are specified with +absolute or relative filenames, or as a reference to a input file +handle or text string. + + + + + +=item CACHE_SIZE + +The Template::Provider module caches compiled templates to avoid the need +to re-parse template files or blocks each time they are used. The CACHE_SIZE +option is used to limit the number of compiled templates that the module +should cache. + +By default, the CACHE_SIZE is undefined and all compiled templates are +cached. When set to any positive value, the cache will be limited to +storing no more than that number of compiled templates. When a new +template is loaded and compiled and the cache is full (i.e. the number +of entries == CACHE_SIZE), the least recently used compiled template +is discarded to make room for the new one. + +The CACHE_SIZE can be set to 0 to disable caching altogether. + + my $provider = Template::Provider->new({ + CACHE_SIZE => 64, # only cache 64 compiled templates + }); + + my $provider = Template::Provider->new({ + CACHE_SIZE => 0, # don't cache any compiled templates + }); + + + + + + +=item COMPILE_EXT + +From version 2 onwards, the Template Toolkit has the ability to +compile templates to Perl code and save them to disk for subsequent +use (i.e. cache persistence). The COMPILE_EXT option may be +provided to specify a filename extension for compiled template files. +It is undefined by default and no attempt will be made to read or write +any compiled template files. + + my $provider = Template::Provider->new({ + COMPILE_EXT => '.ttc', + }); + +If COMPILE_EXT is defined (and COMPILE_DIR isn't, see below) then compiled +template files with the COMPILE_EXT extension will be written to the same +directory from which the source template files were loaded. + +Compiling and subsequent reuse of templates happens automatically +whenever the COMPILE_EXT or COMPILE_DIR options are set. The Template +Toolkit will automatically reload and reuse compiled files when it +finds them on disk. If the corresponding source file has been modified +since the compiled version as written, then it will load and re-compile +the source and write a new compiled version to disk. + +This form of cache persistence offers significant benefits in terms of +time and resources required to reload templates. Compiled templates can +be reloaded by a simple call to Perl's require(), leaving Perl to handle +all the parsing and compilation. This is a Good Thing. + +=item COMPILE_DIR + +The COMPILE_DIR option is used to specify an alternate directory root +under which compiled template files should be saved. + + my $provider = Template::Provider->new({ + COMPILE_DIR => '/tmp/ttc', + }); + +The COMPILE_EXT option may also be specified to have a consistent file +extension added to these files. + + my $provider1 = Template::Provider->new({ + COMPILE_DIR => '/tmp/ttc', + COMPILE_EXT => '.ttc1', + }); + + my $provider2 = Template::Provider->new({ + COMPILE_DIR => '/tmp/ttc', + COMPILE_EXT => '.ttc2', + }); + + +When COMPILE_EXT is undefined, the compiled template files have the +same name as the original template files, but reside in a different +directory tree. + +Each directory in the INCLUDE_PATH is replicated in full beneath the +COMPILE_DIR directory. This example: + + my $provider = Template::Provider->new({ + COMPILE_DIR => '/tmp/ttc', + INCLUDE_PATH => '/home/abw/templates:/usr/share/templates', + }); + +would create the following directory structure: + + /tmp/ttc/home/abw/templates/ + /tmp/ttc/usr/share/templates/ + +Files loaded from different INCLUDE_PATH directories will have their +compiled forms save in the relevant COMPILE_DIR directory. + +On Win32 platforms a filename may by prefixed by a drive letter and +colon. e.g. + + C:/My Templates/header + +The colon will be silently stripped from the filename when it is added +to the COMPILE_DIR value(s) to prevent illegal filename being generated. +Any colon in COMPILE_DIR elements will be left intact. For example: + + # Win32 only + my $provider = Template::Provider->new({ + DELIMITER => ';', + COMPILE_DIR => 'C:/TT2/Cache', + INCLUDE_PATH => 'C:/TT2/Templates;D:/My Templates', + }); + +This would create the following cache directories: + + C:/TT2/Cache/C/TT2/Templates + C:/TT2/Cache/D/My Templates + + + + +=item TOLERANT + +The TOLERANT flag is used by the various Template Toolkit provider +modules (Template::Provider, Template::Plugins, Template::Filters) to +control their behaviour when errors are encountered. By default, any +errors are reported as such, with the request for the particular +resource (template, plugin, filter) being denied and an exception +raised. When the TOLERANT flag is set to any true values, errors will +be silently ignored and the provider will instead return +STATUS_DECLINED. This allows a subsequent provider to take +responsibility for providing the resource, rather than failing the +request outright. If all providers decline to service the request, +either through tolerated failure or a genuine disinclination to +comply, then a 'E<lt>resourceE<gt> not found' exception is raised. + + + + + + +=item PARSER + +The Template::Parser module implements a parser object for compiling +templates into Perl code which can then be executed. A default object +of this class is created automatically and then used by the +Template::Provider whenever a template is loaded and requires +compilation. The PARSER option can be used to provide a reference to +an alternate parser object. + + my $provider = Template::Provider->new({ + PARSER => MyOrg::Template::Parser->new({ ... }), + }); + + + +=item DEBUG + +The DEBUG option can be used to enable debugging messages from the +Template::Provider module by setting it to include the DEBUG_PROVIDER +value. + + use Template::Constants qw( :debug ); + + my $template = Template->new({ + DEBUG => DEBUG_PROVIDER, + }); + + + +=back + +=head2 fetch($name) + +Returns a compiled template for the name specified. If the template +cannot be found then (undef, STATUS_DECLINED) is returned. If an error +occurs (e.g. read error, parse error) then ($error, STATUS_ERROR) is +returned, where $error is the error message generated. If the TOLERANT +flag is set the the method returns (undef, STATUS_DECLINED) instead of +returning an error. + +=head2 store($name, $template) + +Stores the compiled template, $template, in the cache under the name, +$name. Susbequent calls to fetch($name) will return this template in +preference to any disk-based file. + +=head2 include_path(\@newpath)) + +Accessor method for the INCLUDE_PATH setting. If called with an +argument, this method will replace the existing INCLUDE_PATH with +the new value. + +=head2 paths() + +This method generates a copy of the INCLUDE_PATH list. Any elements in the +list which are dynamic generators (e.g. references to subroutines or objects +implementing a paths() method) will be called and the list of directories +returned merged into the output list. + +It is possible to provide a generator which returns itself, thus sending +this method into an infinite loop. To detect and prevent this from happening, +the C<$MAX_DIRS> package variable, set to 64 by default, limits the maximum +number of paths that can be added to, or generated for the output list. If +this number is exceeded then the method will immediately return an error +reporting as much. + +=head1 AUTHOR + +Andy Wardley E<lt>abw@andywardley.comE<gt> + +L<http://www.andywardley.com/|http://www.andywardley.com/> + + + + +=head1 VERSION + +2.70, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L<Template|Template>, L<Template::Parser|Template::Parser>, L<Template::Context|Template::Context> diff --git a/lib/Template/Service.pm b/lib/Template/Service.pm new file mode 100644 index 0000000..e2ac533 --- /dev/null +++ b/lib/Template/Service.pm @@ -0,0 +1,765 @@ +#============================================================= -*-Perl-*- +# +# Template::Service +# +# DESCRIPTION +# Module implementing a template processing service which wraps a +# template within PRE_PROCESS and POST_PROCESS templates and offers +# ERROR recovery. +# +# AUTHOR +# Andy Wardley <abw@kfs.org> +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#---------------------------------------------------------------------------- +# +# $Id: Service.pm,v 2.70 2003/04/29 12:39:37 abw Exp $ +# +#============================================================================ + +package Template::Service; + +require 5.004; + +use strict; +use vars qw( $VERSION $DEBUG $ERROR ); +use base qw( Template::Base ); +use Template::Base; +use Template::Config; +use Template::Exception; +use Template::Constants; + +$VERSION = sprintf("%d.%02d", q$Revision: 2.70 $ =~ /(\d+)\.(\d+)/); +$DEBUG = 0 unless defined $DEBUG; + + +#======================================================================== +# ----- PUBLIC METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# process($template, \%params) +# +# Process a template within a service framework. A service may encompass +# PRE_PROCESS and POST_PROCESS templates and an ERROR hash which names +# templates to be substituted for the main template document in case of +# error. Each service invocation begins by resetting the state of the +# context object via a call to reset(). The AUTO_RESET option may be set +# to 0 (default: 1) to bypass this step. +#------------------------------------------------------------------------ + +sub process { + my ($self, $template, $params) = @_; + my $context = $self->{ CONTEXT }; + my ($name, $output, $procout, $error); + $output = ''; + + $self->debug("process($template, ", + defined $params ? $params : '<no params>', + ')') if $self->{ DEBUG }; + + $context->reset() + if $self->{ AUTO_RESET }; + + # pre-request compiled template from context so that we can alias it + # in the stash for pre-processed templates to reference + eval { $template = $context->template($template) }; + return $self->error($@) + if $@; + + # localise the variable stash with any parameters passed + # and set the 'template' variable + $params ||= { }; + $params->{ template } = $template + unless ref $template eq 'CODE'; + $context->localise($params); + + SERVICE: { + # PRE_PROCESS + eval { + foreach $name (@{ $self->{ PRE_PROCESS } }) { + $self->debug("PRE_PROCESS: $name") if $self->{ DEBUG }; + $output .= $context->process($name); + } + }; + last SERVICE if ($error = $@); + + # PROCESS + eval { + foreach $name (@{ $self->{ PROCESS } || [ $template ] }) { + $self->debug("PROCESS: $name") if $self->{ DEBUG }; + $procout .= $context->process($name); + } + }; + if ($error = $@) { + last SERVICE + unless defined ($procout = $self->_recover(\$error)); + } + + if (defined $procout) { + # WRAPPER + eval { + foreach $name (reverse @{ $self->{ WRAPPER } }) { + $self->debug("WRAPPER: $name") if $self->{ DEBUG }; + $procout = $context->process($name, { content => $procout }); + } + }; + last SERVICE if ($error = $@); + $output .= $procout; + } + + # POST_PROCESS + eval { + foreach $name (@{ $self->{ POST_PROCESS } }) { + $self->debug("POST_PROCESS: $name") if $self->{ DEBUG }; + $output .= $context->process($name); + } + }; + last SERVICE if ($error = $@); + } + + $context->delocalise(); + delete $params->{ template }; + + if ($error) { +# $error = $error->as_string if ref $error; + return $self->error($error); + } + + return $output; +} + + +#------------------------------------------------------------------------ +# context() +# +# Returns the internal CONTEXT reference. +#------------------------------------------------------------------------ + +sub context { + return $_[0]->{ CONTEXT }; +} + + +#======================================================================== +# -- PRIVATE METHODS -- +#======================================================================== + +sub _init { + my ($self, $config) = @_; + my ($item, $data, $context, $block, $blocks); + my $delim = $config->{ DELIMITER }; + $delim = ':' unless defined $delim; + + # coerce PRE_PROCESS, PROCESS and POST_PROCESS to arrays if necessary, + # by splitting on non-word characters + foreach $item (qw( PRE_PROCESS PROCESS POST_PROCESS WRAPPER )) { + $data = $config->{ $item }; + $self->{ $item } = [ ], next unless (defined $data); + $data = [ split($delim, $data || '') ] + unless ref $data eq 'ARRAY'; + $self->{ $item } = $data; + } + # unset PROCESS option unless explicitly specified in config + $self->{ PROCESS } = undef + unless defined $config->{ PROCESS }; + + $self->{ ERROR } = $config->{ ERROR } || $config->{ ERRORS }; + $self->{ AUTO_RESET } = defined $config->{ AUTO_RESET } + ? $config->{ AUTO_RESET } : 1; + $self->{ DEBUG } = ( $config->{ DEBUG } || 0 ) + & Template::Constants::DEBUG_SERVICE; + + $context = $self->{ CONTEXT } = $config->{ CONTEXT } + || Template::Config->context($config) + || return $self->error(Template::Config->error); + + return $self; +} + + +#------------------------------------------------------------------------ +# _recover(\$exception) +# +# Examines the internal ERROR hash array to find a handler suitable +# for the exception object passed by reference. Selecting the handler +# is done by delegation to the exception's select_handler() method, +# passing the set of handler keys as arguments. A 'default' handler +# may also be provided. The handler value represents the name of a +# template which should be processed. +#------------------------------------------------------------------------ + +sub _recover { + my ($self, $error) = @_; + my $context = $self->{ CONTEXT }; + my ($hkey, $handler, $output); + + # there shouldn't ever be a non-exception object received at this + # point... unless a module like CGI::Carp messes around with the + # DIE handler. + return undef + unless (ref $$error); + + # a 'stop' exception is thrown by [% STOP %] - we return the output + # buffer stored in the exception object + return $$error->text() + if $$error->type() eq 'stop'; + + my $handlers = $self->{ ERROR } + || return undef; ## RETURN + + if (ref $handlers eq 'HASH') { + if ($hkey = $$error->select_handler(keys %$handlers)) { + $handler = $handlers->{ $hkey }; + $self->debug("using error handler for $hkey") if $self->{ DEBUG }; + } + elsif ($handler = $handlers->{ default }) { + # use default handler + $self->debug("using default error handler") if $self->{ DEBUG }; + } + else { + return undef; ## RETURN + } + } + else { + $handler = $handlers; + $self->debug("using default error handler") if $self->{ DEBUG }; + } + + eval { $handler = $context->template($handler) }; + if ($@) { + $$error = $@; + return undef; ## RETURN + }; + + $context->stash->set('error', $$error); + eval { + $output .= $context->process($handler); + }; + if ($@) { + $$error = $@; + return undef; ## RETURN + } + + return $output; +} + + + +#------------------------------------------------------------------------ +# _dump() +# +# Debug method which return a string representing the internal object +# state. +#------------------------------------------------------------------------ + +sub _dump { + my $self = shift; + my $context = $self->{ CONTEXT }->_dump(); + $context =~ s/\n/\n /gm; + + my $error = $self->{ ERROR }; + $error = join('', + "{\n", + (map { " $_ => $error->{ $_ }\n" } + keys %$error), + "}\n") + if ref $error; + + local $" = ', '; + return <<EOF; +$self +PRE_PROCESS => [ @{ $self->{ PRE_PROCESS } } ] +POST_PROCESS => [ @{ $self->{ POST_PROCESS } } ] +ERROR => $error +CONTEXT => $context +EOF +} + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Service - General purpose template processing service + +=head1 SYNOPSIS + + use Template::Service; + + my $service = Template::Service->new({ + PRE_PROCESS => [ 'config', 'header' ], + POST_PROCESS => 'footer', + ERROR => { + user => 'user/index.html', + dbi => 'error/database', + default => 'error/default', + }, + }); + + my $output = $service->process($template_name, \%replace) + || die $service->error(), "\n"; + +=head1 DESCRIPTION + +The Template::Service module implements an object class for providing +a consistent template processing service. + +Standard header (PRE_PROCESS) and footer (POST_PROCESS) templates may +be specified which are prepended and appended to all templates +processed by the service (but not any other templates or blocks +INCLUDEd or PROCESSed from within). An ERROR hash may be specified +which redirects the service to an alternate template file in the case +of uncaught exceptions being thrown. This allows errors to be +automatically handled by the service and a guaranteed valid response +to be generated regardless of any processing problems encountered. + +A default Template::Service object is created by the Template module. +Any Template::Service options may be passed to the Template new() +constructor method and will be forwarded to the Template::Service +constructor. + + use Template; + + my $template = Template->new({ + PRE_PROCESS => 'header', + POST_PROCESS => 'footer', + }); + +Similarly, the Template::Service constructor will forward all configuration +parameters onto other default objects (e.g. Template::Context) that it may +need to instantiate. + +A Template::Service object (or subclass/derivative) can be explicitly +instantiated and passed to the Template new() constructor method as +the SERVICE item. + + use Template; + use Template::Service; + + my $service = Template::Service->new({ + PRE_PROCESS => 'header', + POST_PROCESS => 'footer', + }); + + my $template = Template->new({ + SERVICE => $service, + }); + +The Template::Service module can be sub-classed to create custom service +handlers. + + use Template; + use MyOrg::Template::Service; + + my $service = MyOrg::Template::Service->new({ + PRE_PROCESS => 'header', + POST_PROCESS => 'footer', + COOL_OPTION => 'enabled in spades', + }); + + my $template = Template->new({ + SERVICE => $service, + }); + +The Template module uses the Template::Config service() factory method +to create a default service object when required. The +$Template::Config::SERVICE package variable may be set to specify an +alternate service module. This will be loaded automatically and its +new() constructor method called by the service() factory method when +a default service object is required. Thus the previous example could +be written as: + + use Template; + + $Template::Config::SERVICE = 'MyOrg::Template::Service'; + + my $template = Template->new({ + PRE_PROCESS => 'header', + POST_PROCESS => 'footer', + COOL_OPTION => 'enabled in spades', + }); + +=head1 METHODS + +=head2 new(\%config) + +The new() constructor method is called to instantiate a Template::Service +object. Configuration parameters may be specified as a HASH reference or +as a list of (name =E<gt> value) pairs. + + my $service1 = Template::Service->new({ + PRE_PROCESS => 'header', + POST_PROCESS => 'footer', + }); + + my $service2 = Template::Service->new( ERROR => 'error.html' ); + +The new() method returns a Template::Service object (or sub-class) or +undef on error. In the latter case, a relevant error message can be +retrieved by the error() class method or directly from the +$Template::Service::ERROR package variable. + + my $service = Template::Service->new(\%config) + || die Template::Service->error(); + + my $service = Template::Service->new(\%config) + || die $Template::Service::ERROR; + +The following configuration items may be specified: + +=over 4 + + + + +=item PRE_PROCESS, POST_PROCESS + +These values may be set to contain the name(s) of template files +(relative to INCLUDE_PATH) which should be processed immediately +before and/or after each template. These do not get added to +templates processed into a document via directives such as INCLUDE, +PROCESS, WRAPPER etc. + + my $service = Template::Service->new({ + PRE_PROCESS => 'header', + POST_PROCESS => 'footer', + }; + +Multiple templates may be specified as a reference to a list. Each is +processed in the order defined. + + my $service = Template::Service->new({ + PRE_PROCESS => [ 'config', 'header' ], + POST_PROCESS => 'footer', + }; + +Alternately, multiple template may be specified as a single string, +delimited by ':'. This delimiter string can be changed via the +DELIMITER option. + + my $service = Template::Service->new({ + PRE_PROCESS => 'config:header', + POST_PROCESS => 'footer', + }; + +The PRE_PROCESS and POST_PROCESS templates are evaluated in the same +variable context as the main document and may define or update +variables for subsequent use. + +config: + + [% # set some site-wide variables + bgcolor = '#ffffff' + version = 2.718 + %] + +header: + + [% DEFAULT title = 'My Funky Web Site' %] + <html> + <head> + <title>[% title %] + + + +footer: + +

+ Version [% version %] + + + +The Template::Document object representing the main template being processed +is available within PRE_PROCESS and POST_PROCESS templates as the 'template' +variable. Metadata items defined via the META directive may be accessed +accordingly. + + $service->process('mydoc.html', $vars); + +mydoc.html: + + [% META title = 'My Document Title' %] + blah blah blah + ... + +header: + + + + [% template.title %] + + + + + + + + + + + + + + + +=item PROCESS + +The PROCESS option may be set to contain the name(s) of template files +(relative to INCLUDE_PATH) which should be processed instead of the +main template passed to the Template::Service process() method. This can +be used to apply consistent wrappers around all templates, similar to +the use of PRE_PROCESS and POST_PROCESS templates. + + my $service = Template::Service->new({ + PROCESS => 'content', + }; + + # processes 'content' instead of 'foo.html' + $service->process('foo.html'); + +A reference to the original template is available in the 'template' +variable. Metadata items can be inspected and the template can be +processed by specifying it as a variable reference (i.e. prefixed by +'$') to an INCLUDE, PROCESS or WRAPPER directive. + +content: + + + + [% template.title %] + + + + [% PROCESS $template %] +
+ © Copyright [% template.copyright %] + + + +foo.html: + + [% META + title = 'The Foo Page' + author = 'Fred Foo' + copyright = '2000 Fred Foo' + %] +

[% template.title %]

+ Welcome to the Foo Page, blah blah blah + +output: + + + + The Foo Page + + + +

The Foo Page

+ Welcome to the Foo Page, blah blah blah +
+ © Copyright 2000 Fred Foo + + + + + + + + + +=item ERROR + +The ERROR (or ERRORS if you prefer) configuration item can be used to +name a single template or specify a hash array mapping exception types +to templates which should be used for error handling. If an uncaught +exception is raised from within a template then the appropriate error +template will instead be processed. + +If specified as a single value then that template will be processed +for all uncaught exceptions. + + my $service = Template::Service->new({ + ERROR => 'error.html' + }); + +If the ERROR item is a hash reference the keys are assumed to be +exception types and the relevant template for a given exception will +be selected. A 'default' template may be provided for the general +case. Note that 'ERROR' can be pluralised to 'ERRORS' if you find +it more appropriate in this case. + + my $service = Template::Service->new({ + ERRORS => { + user => 'user/index.html', + dbi => 'error/database', + default => 'error/default', + }, + }); + +In this example, any 'user' exceptions thrown will cause the +'user/index.html' template to be processed, 'dbi' errors are handled +by 'error/database' and all others by the 'error/default' template. +Any PRE_PROCESS and/or POST_PROCESS templates will also be applied +to these error templates. + +Note that exception types are hierarchical and a 'foo' handler will +catch all 'foo.*' errors (e.g. foo.bar, foo.bar.baz) if a more +specific handler isn't defined. Be sure to quote any exception types +that contain periods to prevent Perl concatenating them into a single +string (i.e. C is parsed as 'user'.'passwd'). + + my $service = Template::Service->new({ + ERROR => { + 'user.login' => 'user/login.html', + 'user.passwd' => 'user/badpasswd.html', + 'user' => 'user/index.html', + 'default' => 'error/default', + }, + }); + +In this example, any template processed by the $service object, or +other templates or code called from within, can raise a 'user.login' +exception and have the service redirect to the 'user/login.html' +template. Similarly, a 'user.passwd' exception has a specific +handling template, 'user/badpasswd.html', while all other 'user' or +'user.*' exceptions cause a redirection to the 'user/index.html' page. +All other exception types are handled by 'error/default'. + + +Exceptions can be raised in a template using the THROW directive, + + [% THROW user.login 'no user id: please login' %] + +or by calling the throw() method on the current Template::Context object, + + $context->throw('user.passwd', 'Incorrect Password'); + $context->throw('Incorrect Password'); # type 'undef' + +or from Perl code by calling die() with a Template::Exception object, + + die (Template::Exception->new('user.denied', 'Invalid User ID')); + +or by simply calling die() with an error string. This is +automagically caught and converted to an exception of 'undef' +type which can then be handled in the usual way. + + die "I'm sorry Dave, I can't do that"; + + + + + + + +=item AUTO_RESET + +The AUTO_RESET option is set by default and causes the local BLOCKS +cache for the Template::Context object to be reset on each call to the +Template process() method. This ensures that any BLOCKs defined +within a template will only persist until that template is finished +processing. This prevents BLOCKs defined in one processing request +from interfering with other independent requests subsequently +processed by the same context object. + +The BLOCKS item may be used to specify a default set of block definitions +for the Template::Context object. Subsequent BLOCK definitions in templates +will over-ride these but they will be reinstated on each reset if AUTO_RESET +is enabled (default), or if the Template::Context reset() method is called. + + + + + + + +=item DEBUG + +The DEBUG option can be used to enable debugging messages from the +Template::Service module by setting it to include the DEBUG_SERVICE +value. + + use Template::Constants qw( :debug ); + + my $template = Template->new({ + DEBUG => DEBUG_SERVICE, + }); + + + + +=back + +=head2 process($input, \%replace) + +The process() method is called to process a template specified as the first +parameter, $input. This may be a file name, file handle (e.g. GLOB or IO::Handle) +or a reference to a text string containing the template text. An additional +hash reference may be passed containing template variable definitions. + +The method processes the template, adding any PRE_PROCESS or POST_PROCESS +templates defined, and returns the output text. An uncaught exception thrown +by the template will be handled by a relevant ERROR handler if defined. +Errors that occur in the PRE_PROCESS or POST_PROCESS templates, or those that +occur in the main input template and aren't handled, cause the method to +return undef to indicate failure. The appropriate error message can be +retrieved via the error() method. + + $service->process('myfile.html', { title => 'My Test File' }) + || die $service->error(); + + +=head2 context() + +Returns a reference to the internal context object which is, by default, an +instance of the Template::Context class. + +=head2 error() + +Returns the most recent error message. + +=head1 AUTHOR + +Andy Wardley Eabw@andywardley.comE + +L + + + + +=head1 VERSION + +2.70, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L, L diff --git a/lib/Template/Stash.pm b/lib/Template/Stash.pm new file mode 100644 index 0000000..4f26bca --- /dev/null +++ b/lib/Template/Stash.pm @@ -0,0 +1,1000 @@ +#============================================================= -*-Perl-*- +# +# Template::Stash +# +# DESCRIPTION +# Definition of an object class which stores and manages access to +# variables for the Template Toolkit. +# +# AUTHOR +# Andy Wardley +# +# COPYRIGHT +# Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#---------------------------------------------------------------------------- +# +# $Id: Stash.pm,v 2.78 2003/07/24 12:13:32 abw Exp $ +# +#============================================================================ + +package Template::Stash; + +require 5.004; + +use strict; +use vars qw( $VERSION $DEBUG $ROOT_OPS $SCALAR_OPS $HASH_OPS $LIST_OPS ); + +$VERSION = sprintf("%d.%02d", q$Revision: 2.78 $ =~ /(\d+)\.(\d+)/); + + +#======================================================================== +# -- PACKAGE VARIABLES AND SUBS -- +#======================================================================== + +#------------------------------------------------------------------------ +# Definitions of various pseudo-methods. ROOT_OPS are merged into all +# new Template::Stash objects, and are thus default global functions. +# SCALAR_OPS are methods that can be called on a scalar, and ditto +# respectively for LIST_OPS and HASH_OPS +#------------------------------------------------------------------------ + +$ROOT_OPS = { + 'inc' => sub { local $^W = 0; my $item = shift; ++$item }, + 'dec' => sub { local $^W = 0; my $item = shift; --$item }, +# import => \&hash_import, + defined $ROOT_OPS ? %$ROOT_OPS : (), +}; + +$SCALAR_OPS = { + 'item' => sub { $_[0] }, + 'list' => sub { [ $_[0] ] }, + 'hash' => sub { { value => $_[0] } }, + 'length' => sub { length $_[0] }, + 'size' => sub { return 1 }, + 'defined' => sub { return 1 }, + 'repeat' => sub { + my ($str, $count) = @_; + $str = '' unless defined $str; + $count ||= 1; + return $str x $count; + }, + 'search' => sub { + my ($str, $pattern) = @_; + return $str unless defined $str and defined $pattern; + return $str =~ /$pattern/; + }, + 'replace' => sub { + my ($str, $search, $replace) = @_; + $replace = '' unless defined $replace; + return $str unless defined $str and defined $search; + $str =~ s/$search/$replace/g; +# print STDERR "s [ $search ] [ $replace ] g\n"; +# eval "\$str =~ s$search$replaceg"; + return $str; + }, + 'match' => sub { + my ($str, $search) = @_; + return $str unless defined $str and defined $search; + my @matches = ($str =~ /$search/); + return @matches ? \@matches : ''; + }, + 'split' => sub { + my ($str, $split, @args) = @_; + $str = '' unless defined $str; + return [ defined $split ? split($split, $str, @args) + : split(' ', $str, @args) ]; + }, + 'chunk' => sub { + my ($string, $size) = @_; + my @list; + $size ||= 1; + if ($size < 0) { + # sexeger! It's faster to reverse the string, search + # it from the front and then reverse the output than to + # search it from the end, believe it nor not! + $string = reverse $string; + $size = -$size; + unshift(@list, scalar reverse $1) + while ($string =~ /((.{$size})|(.+))/g); + } + else { + push(@list, $1) while ($string =~ /((.{$size})|(.+))/g); + } + return \@list; + }, + + + defined $SCALAR_OPS ? %$SCALAR_OPS : (), +}; + +$HASH_OPS = { + 'item' => sub { my ($hash, $item) = @_; + $item = '' unless defined $item; + $hash->{ $item }; + }, + 'hash' => sub { $_[0] }, + 'size' => sub { scalar keys %{$_[0]} }, + 'keys' => sub { [ keys %{ $_[0] } ] }, + 'values' => sub { [ values %{ $_[0] } ] }, + 'each' => sub { [ %{ $_[0] } ] }, + 'list' => sub { my ($hash, $what) = @_; $what ||= ''; + return ($what eq 'keys') ? [ keys %$hash ] + : ($what eq 'values') ? [ values %$hash ] + : ($what eq 'each') ? [ %$hash ] + : [ map { { key => $_ , value => $hash->{ $_ } } } + keys %$hash ]; + }, + 'exists' => sub { exists $_[0]->{ $_[1] } }, + 'defined' => sub { defined $_[0]->{ $_[1] } }, + 'import' => \&hash_import, + 'sort' => sub { + my ($hash) = @_; + [ sort { lc $hash->{$a} cmp lc $hash->{$b} } (keys %$hash) ]; + }, + 'nsort' => sub { + my ($hash) = @_; + [ sort { $hash->{$a} <=> $hash->{$b} } (keys %$hash) ]; + }, + defined $HASH_OPS ? %$HASH_OPS : (), +}; + +$LIST_OPS = { + 'item' => sub { $_[0]->[ $_[1] || 0 ] }, + 'list' => sub { $_[0] }, + 'hash' => sub { my $list = shift; my $n = 0; + return { map { ($n++, $_) } @$list }; }, + 'push' => sub { my $list = shift; push(@$list, shift); return '' }, + 'pop' => sub { my $list = shift; pop(@$list) }, + 'unshift' => sub { my $list = shift; unshift(@$list, shift); return '' }, + 'shift' => sub { my $list = shift; shift(@$list) }, + 'max' => sub { local $^W = 0; my $list = shift; $#$list; }, + 'size' => sub { local $^W = 0; my $list = shift; $#$list + 1; }, + 'first' => sub { + my $list = shift; + return $list->[0] unless @_; + return [ @$list[0..$_[0]-1] ]; + }, + 'last' => sub { + my $list = shift; + return $list->[-1] unless @_; + return [ @$list[-$_[0]..-1] ]; + }, + 'reverse' => sub { my $list = shift; [ reverse @$list ] }, + 'grep' => sub { + my ($list, $pattern) = @_; + $pattern ||= ''; + return [ grep /$pattern/, @$list ]; + }, + 'join' => sub { + my ($list, $joint) = @_; + join(defined $joint ? $joint : ' ', + map { defined $_ ? $_ : '' } @$list) + }, + 'sort' => sub { + $^W = 0; + my ($list, $field) = @_; + return $list unless @$list > 1; # no need to sort 1 item lists + return $field # Schwartzian Transform + ? map { $_->[0] } # for case insensitivity + sort { $a->[1] cmp $b->[1] } + map { [ $_, lc(ref($_) eq 'HASH' + ? $_->{ $field } : + UNIVERSAL::can($_, $field) + ? $_->$field() : $_) ] } + @$list + : map { $_->[0] } + sort { $a->[1] cmp $b->[1] } + map { [ $_, lc $_ ] } + @$list + }, + 'nsort' => sub { + my ($list, $field) = @_; + return $list unless $#$list; # no need to sort 1 item lists + return $field # Schwartzian Transform + ? map { $_->[0] } # for case insensitivity + sort { $a->[1] <=> $b->[1] } + map { [ $_, lc(ref($_) eq 'HASH' + ? $_->{ $field } : + UNIVERSAL::can($_, $field) + ? $_->$field() : $_) ] } + @$list + : map { $_->[0] } + sort { $a->[1] <=> $b->[1] } + map { [ $_, lc $_ ] } + @$list + }, + 'unique' => sub { my %u; [ grep { ++$u{$_} == 1 } @{$_[0]} ] }, + 'merge' => sub { + my $list = shift; + return [ @$list, grep defined, map ref eq 'ARRAY' ? @$_ : undef, @_ ]; + }, + 'slice' => sub { + my ($list, $from, $to) = @_; + $from ||= 0; + $to = $#$list unless defined $to; + return [ @$list[$from..$to] ]; + }, + 'splice' => sub { + my ($list, $offset, $length, @replace) = @_; + + if (@replace) { + # @replace can contain a list of multiple replace items, or + # be a single reference to a list + @replace = @{ $replace[0] } + if @replace == 1 && ref $replace[0] eq 'ARRAY'; + return [ splice @$list, $offset, $length, @replace ]; + } + elsif (defined $length) { + return [ splice @$list, $offset, $length ]; + } + elsif (defined $offset) { + return [ splice @$list, $offset ]; + } + else { + return [ splice(@$list) ]; + } + }, + + defined $LIST_OPS ? %$LIST_OPS : (), +}; + +sub hash_import { + my ($hash, $imp) = @_; + $imp = {} unless ref $imp eq 'HASH'; + @$hash{ keys %$imp } = values %$imp; + return ''; +} + + +#------------------------------------------------------------------------ +# define_vmethod($type, $name, \&sub) +# +# Defines a virtual method of type $type (SCALAR, HASH, or LIST), with +# name $name, that invokes &sub when called. It is expected that &sub +# be able to handle the type that it will be called upon. +#------------------------------------------------------------------------ + +sub define_vmethod { + my ($class, $type, $name, $sub) = @_; + my $op; + $type = lc $type; + + if ($type =~ /^scalar|item$/) { + $op = $SCALAR_OPS; + } + elsif ($type eq 'hash') { + $op = $HASH_OPS; + } + elsif ($type =~ /^list|array$/) { + $op = $LIST_OPS; + } + else { + die "invalid vmethod type: $type\n"; + } + + $op->{ $name } = $sub; + + return 1; +} + + +#======================================================================== +# ----- CLASS METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# new(\%params) +# +# Constructor method which creates a new Template::Stash object. +# An optional hash reference may be passed containing variable +# definitions that will be used to initialise the stash. +# +# Returns a reference to a newly created Template::Stash. +#------------------------------------------------------------------------ + +sub new { + my $class = shift; + my $params = ref $_[0] eq 'HASH' ? shift(@_) : { @_ }; + + my $self = { + global => { }, + %$params, + %$ROOT_OPS, + '_PARENT' => undef, + }; + + bless $self, $class; +} + + +#======================================================================== +# ----- PUBLIC OBJECT METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# clone(\%params) +# +# Creates a copy of the current stash object to effect localisation +# of variables. The new stash is blessed into the same class as the +# parent (which may be a derived class) and has a '_PARENT' member added +# which contains a reference to the parent stash that created it +# ($self). This member is used in a successive declone() method call to +# return the reference to the parent. +# +# A parameter may be provided which should reference a hash of +# variable/values which should be defined in the new stash. The +# update() method is called to define these new variables in the cloned +# stash. +# +# Returns a reference to a cloned Template::Stash. +#------------------------------------------------------------------------ + +sub clone { + my ($self, $params) = @_; + $params ||= { }; + + # look out for magical 'import' argument which imports another hash + my $import = $params->{ import }; + if (defined $import && UNIVERSAL::isa($import, 'HASH')) { + delete $params->{ import }; + } + else { + undef $import; + } + + my $clone = bless { + %$self, # copy all parent members + %$params, # copy all new data + '_PARENT' => $self, # link to parent + }, ref $self; + + # perform hash import if defined + &{ $HASH_OPS->{ import }}($clone, $import) + if defined $import; + + return $clone; +} + + +#------------------------------------------------------------------------ +# declone($export) +# +# Returns a reference to the PARENT stash. When called in the following +# manner: +# $stash = $stash->declone(); +# the reference count on the current stash will drop to 0 and be "freed" +# and the caller will be left with a reference to the parent. This +# contains the state of the stash before it was cloned. +#------------------------------------------------------------------------ + +sub declone { + my $self = shift; + $self->{ _PARENT } || $self; +} + + +#------------------------------------------------------------------------ +# get($ident) +# +# Returns the value for an variable stored in the stash. The variable +# may be specified as a simple string, e.g. 'foo', or as an array +# reference representing compound variables. In the latter case, each +# pair of successive elements in the list represent a node in the +# compound variable. The first is the variable name, the second a +# list reference of arguments or 0 if undefined. So, the compound +# variable [% foo.bar('foo').baz %] would be represented as the list +# [ 'foo', 0, 'bar', ['foo'], 'baz', 0 ]. Returns the value of the +# identifier or an empty string if undefined. Errors are thrown via +# die(). +#------------------------------------------------------------------------ + +sub get { + my ($self, $ident, $args) = @_; + my ($root, $result); + $root = $self; + + if (ref $ident eq 'ARRAY' + || ($ident =~ /\./) + && ($ident = [ map { s/\(.*$//; ($_, 0) } split(/\./, $ident) ])) { + my $size = $#$ident; + + # if $ident is a list reference, then we evaluate each item in the + # identifier against the previous result, using the root stash + # ($self) as the first implicit 'result'... + + foreach (my $i = 0; $i <= $size; $i += 2) { + $result = $self->_dotop($root, @$ident[$i, $i+1]); + last unless defined $result; + $root = $result; + } + } + else { + $result = $self->_dotop($root, $ident, $args); + } + + return defined $result ? $result : $self->undefined($ident, $args); +} + + +#------------------------------------------------------------------------ +# set($ident, $value, $default) +# +# Updates the value for a variable in the stash. The first parameter +# should be the variable name or array, as per get(). The second +# parameter should be the intended value for the variable. The third, +# optional parameter is a flag which may be set to indicate 'default' +# mode. When set true, the variable will only be updated if it is +# currently undefined or has a false value. The magical 'IMPORT' +# variable identifier may be used to indicate that $value is a hash +# reference whose values should be imported. Returns the value set, +# or an empty string if not set (e.g. default mode). In the case of +# IMPORT, returns the number of items imported from the hash. +#------------------------------------------------------------------------ + +sub set { + my ($self, $ident, $value, $default) = @_; + my ($root, $result, $error); + + $root = $self; + + ELEMENT: { + if (ref $ident eq 'ARRAY' + || ($ident =~ /\./) + && ($ident = [ map { s/\(.*$//; ($_, 0) } + split(/\./, $ident) ])) { + + # a compound identifier may contain multiple elements (e.g. + # foo.bar.baz) and we must first resolve all but the last, + # using _dotop() with the $lvalue flag set which will create + # intermediate hashes if necessary... + my $size = $#$ident; + foreach (my $i = 0; $i < $size - 2; $i += 2) { + $result = $self->_dotop($root, @$ident[$i, $i+1], 1); + last ELEMENT unless defined $result; + $root = $result; + } + + # then we call _assign() to assign the value to the last element + $result = $self->_assign($root, @$ident[$size-1, $size], + $value, $default); + } + else { + $result = $self->_assign($root, $ident, 0, $value, $default); + } + } + + return defined $result ? $result : ''; +} + + +#------------------------------------------------------------------------ +# getref($ident) +# +# Returns a "reference" to a particular item. This is represented as a +# closure which will return the actual stash item when called. +# WARNING: still experimental! +#------------------------------------------------------------------------ + +sub getref { + my ($self, $ident, $args) = @_; + my ($root, $item, $result); + $root = $self; + + if (ref $ident eq 'ARRAY') { + my $size = $#$ident; + + foreach (my $i = 0; $i <= $size; $i += 2) { + ($item, $args) = @$ident[$i, $i + 1]; + last if $i >= $size - 2; # don't evaluate last node + last unless defined + ($root = $self->_dotop($root, $item, $args)); + } + } + else { + $item = $ident; + } + + if (defined $root) { + return sub { my @args = (@{$args||[]}, @_); + $self->_dotop($root, $item, \@args); + } + } + else { + return sub { '' }; + } +} + + + + +#------------------------------------------------------------------------ +# update(\%params) +# +# Update multiple variables en masse. No magic is performed. Simple +# variable names only. +#------------------------------------------------------------------------ + +sub update { + my ($self, $params) = @_; + + # look out for magical 'import' argument to import another hash + my $import = $params->{ import }; + if (defined $import && UNIVERSAL::isa($import, 'HASH')) { + @$self{ keys %$import } = values %$import; + delete $params->{ import }; + } + + @$self{ keys %$params } = values %$params; +} + + +#------------------------------------------------------------------------ +# undefined($ident, $args) +# +# Method called when a get() returns an undefined value. Can be redefined +# in a subclass to implement alternate handling. +#------------------------------------------------------------------------ + +sub undefined { + my ($self, $ident, $args); + return ''; +} + + +#======================================================================== +# ----- PRIVATE OBJECT METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# _dotop($root, $item, \@args, $lvalue) +# +# This is the core 'dot' operation method which evaluates elements of +# variables against their root. All variables have an implicit root +# which is the stash object itself (a hash). Thus, a non-compound +# variable 'foo' is actually '(stash.)foo', the compound 'foo.bar' is +# '(stash.)foo.bar'. The first parameter is a reference to the current +# root, initially the stash itself. The second parameter contains the +# name of the variable element, e.g. 'foo'. The third optional +# parameter is a reference to a list of any parenthesised arguments +# specified for the variable, which are passed to sub-routines, object +# methods, etc. The final parameter is an optional flag to indicate +# if this variable is being evaluated on the left side of an assignment +# (e.g. foo.bar.baz = 10). When set true, intermediated hashes will +# be created (e.g. bar) if necessary. +# +# Returns the result of evaluating the item against the root, having +# performed any variable "magic". The value returned can then be used +# as the root of the next _dotop() in a compound sequence. Returns +# undef if the variable is undefined. +#------------------------------------------------------------------------ + +sub _dotop { + my ($self, $root, $item, $args, $lvalue) = @_; + my $rootref = ref $root; + my $atroot = ($root eq $self); + my ($value, @result); + + $args ||= [ ]; + $lvalue ||= 0; + +# print STDERR "_dotop(root=$root, item=$item, args=[@$args])\n" +# if $DEBUG; + + # return undef without an error if either side of the dot is unviable + # or if an attempt is made to access a private member, starting _ or . + return undef + unless defined($root) and defined($item) and $item !~ /^[\._]/; + + if ($atroot || $rootref eq 'HASH') { + + # if $root is a regular HASH or a Template::Stash kinda HASH (the + # *real* root of everything). We first lookup the named key + # in the hash, or create an empty hash in its place if undefined + # and the $lvalue flag is set. Otherwise, we check the HASH_OPS + # pseudo-methods table, calling the code if found, or return undef. + + if (defined($value = $root->{ $item })) { + return $value unless ref $value eq 'CODE'; ## RETURN + @result = &$value(@$args); ## @result + } + elsif ($lvalue) { + # we create an intermediate hash if this is an lvalue + return $root->{ $item } = { }; ## RETURN + } + # ugly hack: only allow import vmeth to be called on root stash + elsif (($value = $HASH_OPS->{ $item }) + && ! $atroot || $item eq 'import') { + @result = &$value($root, @$args); ## @result + } + elsif ( ref $item eq 'ARRAY' ) { + # hash slice + return [@$root{@$item}]; ## RETURN + } + } + elsif ($rootref eq 'ARRAY') { + + # if root is an ARRAY then we check for a LIST_OPS pseudo-method + # (except for l-values for which it doesn't make any sense) + # or return the numerical index into the array, or undef + + if (($value = $LIST_OPS->{ $item }) && ! $lvalue) { + @result = &$value($root, @$args); ## @result + } + elsif ($item =~ /^-?\d+$/) { + $value = $root->[$item]; + return $value unless ref $value eq 'CODE'; ## RETURN + @result = &$value(@$args); ## @result + } + elsif ( ref $item eq 'ARRAY' ) { + # array slice + return [@$root[@$item]]; ## RETURN + } + } + + # NOTE: we do the can-can because UNIVSERAL::isa($something, 'UNIVERSAL') + # doesn't appear to work with CGI, returning true for the first call + # and false for all subsequent calls. + + elsif (ref($root) && UNIVERSAL::can($root, 'can')) { + + # if $root is a blessed reference (i.e. inherits from the + # UNIVERSAL object base class) then we call the item as a method. + # If that fails then we try to fallback on HASH behaviour if + # possible. + eval { @result = $root->$item(@$args); }; + + if ($@) { + # temporary hack - required to propogate errors thrown + # by views; if $@ is a ref (e.g. Template::Exception + # object then we assume it's a real error that needs + # real throwing + + die $@ if ref($@) || ($@ !~ /Can't locate object method/); + + # failed to call object method, so try some fallbacks + if (UNIVERSAL::isa($root, 'HASH') + && defined($value = $root->{ $item })) { + return $value unless ref $value eq 'CODE'; ## RETURN + @result = &$value(@$args); + } + elsif (UNIVERSAL::isa($root, 'ARRAY') + && ($value = $LIST_OPS->{ $item })) { + @result = &$value($root, @$args); + } + elsif ($value = $SCALAR_OPS->{ $item }) { + @result = &$value($root, @$args); + } + elsif ($value = $LIST_OPS->{ $item }) { + @result = &$value([$root], @$args); + } + elsif ($self->{ _DEBUG }) { + @result = (undef, $@); + } + } + } + elsif (($value = $SCALAR_OPS->{ $item }) && ! $lvalue) { + # at this point, it doesn't look like we've got a reference to + # anything we know about, so we try the SCALAR_OPS pseudo-methods + # table (but not for l-values) + @result = &$value($root, @$args); ## @result + } + elsif (($value = $LIST_OPS->{ $item }) && ! $lvalue) { + # last-ditch: can we promote a scalar to a one-element + # list and apply a LIST_OPS virtual method? + @result = &$value([$root], @$args); + } + elsif ($self->{ _DEBUG }) { + die "don't know how to access [ $root ].$item\n"; ## DIE + } + else { + @result = (); + } + + # fold multiple return items into a list unless first item is undef + if (defined $result[0]) { + return ## RETURN + scalar @result > 1 ? [ @result ] : $result[0]; + } + elsif (defined $result[1]) { + die $result[1]; ## DIE + } + elsif ($self->{ _DEBUG }) { + die "$item is undefined\n"; ## DIE + } + + return undef; +} + + +#------------------------------------------------------------------------ +# _assign($root, $item, \@args, $value, $default) +# +# Similar to _dotop() above, but assigns a value to the given variable +# instead of simply returning it. The first three parameters are the +# root item, the item and arguments, as per _dotop(), followed by the +# value to which the variable should be set and an optional $default +# flag. If set true, the variable will only be set if currently false +# (undefined/zero) +#------------------------------------------------------------------------ + +sub _assign { + my ($self, $root, $item, $args, $value, $default) = @_; + my $rootref = ref $root; + my $atroot = ($root eq $self); + my $result; + $args ||= [ ]; + $default ||= 0; + +# print(STDERR "_assign(root=$root, item=$item, args=[@$args], \n", +# "value=$value, default=$default)\n") +# if $DEBUG; + + # return undef without an error if either side of the dot is unviable + # or if an attempt is made to update a private member, starting _ or . + return undef ## RETURN + unless $root and defined $item and $item !~ /^[\._]/; + + if ($rootref eq 'HASH' || $atroot) { +# if ($item eq 'IMPORT' && UNIVERSAL::isa($value, 'HASH')) { +# # import hash entries into root hash +# @$root{ keys %$value } = values %$value; +# return ''; ## RETURN +# } + # if the root is a hash we set the named key + return ($root->{ $item } = $value) ## RETURN + unless $default && $root->{ $item }; + } + elsif ($rootref eq 'ARRAY' && $item =~ /^-?\d+$/) { + # or set a list item by index number + return ($root->[$item] = $value) ## RETURN + unless $default && $root->{ $item }; + } + elsif (UNIVERSAL::isa($root, 'UNIVERSAL')) { + # try to call the item as a method of an object + + return $root->$item(@$args, $value) ## RETURN + unless $default && $root->$item(); + +# 2 issues: +# - method call should be wrapped in eval { } +# - fallback on hash methods if object method not found +# +# eval { $result = $root->$item(@$args, $value); }; +# +# if ($@) { +# die $@ if ref($@) || ($@ !~ /Can't locate object method/); +# +# # failed to call object method, so try some fallbacks +# if (UNIVERSAL::isa($root, 'HASH') && exists $root->{ $item }) { +# $result = ($root->{ $item } = $value) +# unless $default && $root->{ $item }; +# } +# } +# return $result; ## RETURN + + } + else { + die "don't know how to assign to [$root].[$item]\n"; ## DIE + } + + return undef; +} + + +#------------------------------------------------------------------------ +# _dump() +# +# Debug method which returns a string representing the internal state +# of the object. The method calls itself recursively to dump sub-hashes. +#------------------------------------------------------------------------ + +sub _dump { + my $self = shift; + return "[Template::Stash] " . $self->_dump_frame(2); +} + +sub _dump_frame { + my ($self, $indent) = @_; + $indent ||= 1; + my $buffer = ' '; + my $pad = $buffer x $indent; + my $text = "{\n"; + local $" = ', '; + + my ($key, $value); + + return $text . "...excessive recursion, terminating\n" + if $indent > 32; + + foreach $key (keys %$self) { + $value = $self->{ $key }; + $value = '' unless defined $value; + next if $key =~ /^\./; + if (ref($value) eq 'ARRAY') { + $value = '[ ' . join(', ', map { defined $_ ? $_ : '' } + @$value) . ' ]'; + } + elsif (ref $value eq 'HASH') { + $value = _dump_frame($value, $indent + 1); + } + + $text .= sprintf("$pad%-16s => $value\n", $key); + } + $text .= $buffer x ($indent - 1) . '}'; + return $text; +} + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Stash - Magical storage for template variables + +=head1 SYNOPSIS + + use Template::Stash; + + my $stash = Template::Stash->new(\%vars); + + # get variable values + $value = $stash->get($variable); + $value = $stash->get(\@compound); + + # set variable value + $stash->set($variable, $value); + $stash->set(\@compound, $value); + + # default variable value + $stash->set($variable, $value, 1); + $stash->set(\@compound, $value, 1); + + # set variable values en masse + $stash->update(\%new_vars) + + # methods for (de-)localising variables + $stash = $stash->clone(\%new_vars); + $stash = $stash->declone(); + +=head1 DESCRIPTION + +The Template::Stash module defines an object class which is used to store +variable values for the runtime use of the template processor. Variable +values are stored internally in a hash reference (which itself is blessed +to create the object) and are accessible via the get() and set() methods. + +Variables may reference hash arrays, lists, subroutines and objects +as well as simple values. The stash automatically performs the right +magic when dealing with variables, calling code or object methods, +indexing into lists, hashes, etc. + +The stash has clone() and declone() methods which are used by the +template processor to make temporary copies of the stash for +localising changes made to variables. + +=head1 PUBLIC METHODS + +=head2 new(\%params) + +The new() constructor method creates and returns a reference to a new +Template::Stash object. + + my $stash = Template::Stash->new(); + +A hash reference may be passed to provide variables and values which +should be used to initialise the stash. + + my $stash = Template::Stash->new({ var1 => 'value1', + var2 => 'value2' }); + +=head2 get($variable) + +The get() method retrieves the variable named by the first parameter. + + $value = $stash->get('var1'); + +Dotted compound variables can be retrieved by specifying the variable +elements by reference to a list. Each node in the variable occupies +two entries in the list. The first gives the name of the variable +element, the second is a reference to a list of arguments for that +element, or 0 if none. + + [% foo.bar(10).baz(20) %] + + $stash->get([ 'foo', 0, 'bar', [ 10 ], 'baz', [ 20 ] ]); + +=head2 set($variable, $value, $default) + +The set() method sets the variable name in the first parameter to the +value specified in the second. + + $stash->set('var1', 'value1'); + +If the third parameter evaluates to a true value, the variable is +set only if it did not have a true value before. + + $stash->set('var2', 'default_value', 1); + +Dotted compound variables may be specified as per get() above. + + [% foo.bar = 30 %] + + $stash->set([ 'foo', 0, 'bar', 0 ], 30); + +The magical variable 'IMPORT' can be specified whose corresponding +value should be a hash reference. The contents of the hash array are +copied (i.e. imported) into the current namespace. + + # foo.bar = baz, foo.wiz = waz + $stash->set('foo', { 'bar' => 'baz', 'wiz' => 'waz' }); + + # import 'foo' into main namespace: foo = baz, wiz = waz + $stash->set('IMPORT', $stash->get('foo')); + +=head2 clone(\%params) + +The clone() method creates and returns a new Template::Stash object which +represents a localised copy of the parent stash. Variables can be +freely updated in the cloned stash and when declone() is called, the +original stash is returned with all its members intact and in the +same state as they were before clone() was called. + +For convenience, a hash of parameters may be passed into clone() which +is used to update any simple variable (i.e. those that don't contain any +namespace elements like 'foo' and 'bar' but not 'foo.bar') variables while +cloning the stash. For adding and updating complex variables, the set() +method should be used after calling clone(). This will correctly resolve +and/or create any necessary namespace hashes. + +A cloned stash maintains a reference to the stash that it was copied +from in its '_PARENT' member. + +=head2 declone() + +The declone() method returns the '_PARENT' reference and can be used to +restore the state of a stash as described above. + +=head1 AUTHOR + +Andy Wardley Eabw@andywardley.comE + +L + + + + +=head1 VERSION + +2.78, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L, L diff --git a/lib/Template/Stash/Context.pm b/lib/Template/Stash/Context.pm new file mode 100644 index 0000000..8f9cfdb --- /dev/null +++ b/lib/Template/Stash/Context.pm @@ -0,0 +1,781 @@ +#============================================================= -*-Perl-*- +# +# Template::Stash::Context +# +# DESCRIPTION +# This is an alternate stash object which includes a patch from +# Craig Barratt to implement various new virtual methods to allow +# dotted template variable to denote if object methods and subroutines +# should be called in scalar or list context. It adds a little overhead +# to each stash call and I'm a little wary of doing that. So for now, +# it's implemented as a separate stash module which will allow us to +# test it out, benchmark it and switch it in or out as we require. +# +# This is what Craig has to say about it: +# +# Here's a better set of features for the core. Attached is a new version +# of Stash.pm (based on TT2.02) that: +# +# - supports the special op "scalar" that forces scalar context on +# function calls, eg: +# +# cgi.param("foo").scalar +# +# calls cgi.param("foo") in scalar context (unlike my wimpy +# scalar op from last night). Array context is the default. +# +# With non-function operands, scalar behaves like the perl +# version (eg: no-op for scalar, size for arrays, etc). +# +# - supports the special op "ref" that behaves like the perl ref. +# If applied to a function the function is not called. Eg: +# +# cgi.param("foo").ref +# +# does *not* call cgi.param and evaluates to "CODE". Similarly, +# HASH.ref, ARRAY.ref return what you expect. +# +# - adds a new scalar and list op called "array" that is a no-op for +# arrays and promotes scalars to one-element arrays. +# +# - allows scalar ops to be applied to arrays and hashes in place, +# eg: ARRAY.repeat(3) repeats each element in place. +# +# - allows list ops to be applied to scalars by promoting the scalars +# to one-element arrays (like an implicit "array"). So you can +# do things like SCALAR.size, SCALAR.join and get a useful result. +# +# This also means you can now use x.0 to safely get the first element +# whether x is an array or scalar. +# +# The new Stash.pm passes the TT2.02 test suite. But I haven't tested the +# new features very much. One nagging implementation problem is that the +# "scalar" and "ref" ops have higher precedence than user variable names. +# +# AUTHORS +# Andy Wardley +# Craig Barratt +# +# COPYRIGHT +# Copyright (C) 1996-2001 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2001 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#---------------------------------------------------------------------------- +# +# $Id: Context.pm,v 1.53 2003/04/24 09:14:47 abw Exp $ +# +#============================================================================ + +package Template::Stash::Context; + +require 5.004; + +use strict; +use Template::Stash; +use vars qw( $VERSION $DEBUG $ROOT_OPS $SCALAR_OPS $HASH_OPS $LIST_OPS ); + +$VERSION = sprintf("%d.%02d", q$Revision: 1.53 $ =~ /(\d+)\.(\d+)/); + + +#======================================================================== +# -- PACKAGE VARIABLES AND SUBS -- +#======================================================================== + +#------------------------------------------------------------------------ +# copy virtual methods from those in the regular Template::Stash +#------------------------------------------------------------------------ + +$ROOT_OPS = { + %$Template::Stash::ROOT_OPS, + defined $ROOT_OPS ? %$ROOT_OPS : (), +}; + +$SCALAR_OPS = { + %$Template::Stash::SCALAR_OPS, + 'array' => sub { return [$_[0]] }, + defined $SCALAR_OPS ? %$SCALAR_OPS : (), +}; + +$LIST_OPS = { + %$Template::Stash::LIST_OPS, + 'array' => sub { return $_[0] }, + defined $LIST_OPS ? %$LIST_OPS : (), +}; + +$HASH_OPS = { + %$Template::Stash::HASH_OPS, + defined $HASH_OPS ? %$HASH_OPS : (), +}; + + + +#======================================================================== +# ----- CLASS METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# new(\%params) +# +# Constructor method which creates a new Template::Stash object. +# An optional hash reference may be passed containing variable +# definitions that will be used to initialise the stash. +# +# Returns a reference to a newly created Template::Stash. +#------------------------------------------------------------------------ + +sub new { + my $class = shift; + my $params = ref $_[0] eq 'HASH' ? shift(@_) : { @_ }; + + my $self = { + global => { }, + %$params, + %$ROOT_OPS, + '_PARENT' => undef, + }; + + bless $self, $class; +} + + +#======================================================================== +# ----- PUBLIC OBJECT METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# clone(\%params) +# +# Creates a copy of the current stash object to effect localisation +# of variables. The new stash is blessed into the same class as the +# parent (which may be a derived class) and has a '_PARENT' member added +# which contains a reference to the parent stash that created it +# ($self). This member is used in a successive declone() method call to +# return the reference to the parent. +# +# A parameter may be provided which should reference a hash of +# variable/values which should be defined in the new stash. The +# update() method is called to define these new variables in the cloned +# stash. +# +# Returns a reference to a cloned Template::Stash. +#------------------------------------------------------------------------ + +sub clone { + my ($self, $params) = @_; + $params ||= { }; + + # look out for magical 'import' argument which imports another hash + my $import = $params->{ import }; + if (defined $import && UNIVERSAL::isa($import, 'HASH')) { + delete $params->{ import }; + } + else { + undef $import; + } + + my $clone = bless { + %$self, # copy all parent members + %$params, # copy all new data + '_PARENT' => $self, # link to parent + }, ref $self; + + # perform hash import if defined + &{ $HASH_OPS->{ import }}($clone, $import) + if defined $import; + + return $clone; +} + + +#------------------------------------------------------------------------ +# declone($export) +# +# Returns a reference to the PARENT stash. When called in the following +# manner: +# $stash = $stash->declone(); +# the reference count on the current stash will drop to 0 and be "freed" +# and the caller will be left with a reference to the parent. This +# contains the state of the stash before it was cloned. +#------------------------------------------------------------------------ + +sub declone { + my $self = shift; + $self->{ _PARENT } || $self; +} + + +#------------------------------------------------------------------------ +# get($ident) +# +# Returns the value for an variable stored in the stash. The variable +# may be specified as a simple string, e.g. 'foo', or as an array +# reference representing compound variables. In the latter case, each +# pair of successive elements in the list represent a node in the +# compound variable. The first is the variable name, the second a +# list reference of arguments or 0 if undefined. So, the compound +# variable [% foo.bar('foo').baz %] would be represented as the list +# [ 'foo', 0, 'bar', ['foo'], 'baz', 0 ]. Returns the value of the +# identifier or an empty string if undefined. Errors are thrown via +# die(). +#------------------------------------------------------------------------ + +sub get { + my ($self, $ident, $args) = @_; + my ($root, $result); + $root = $self; + + if (ref $ident eq 'ARRAY' + || ($ident =~ /\./) + && ($ident = [ map { s/\(.*$//; ($_, 0) } split(/\./, $ident) ])) { + my $size = $#$ident; + + # if $ident is a list reference, then we evaluate each item in the + # identifier against the previous result, using the root stash + # ($self) as the first implicit 'result'... + + foreach (my $i = 0; $i <= $size; $i += 2) { + if ( $i + 2 <= $size && ($ident->[$i+2] eq "scalar" + || $ident->[$i+2] eq "ref") ) { + $result = $self->_dotop($root, @$ident[$i, $i+1], 0, + $ident->[$i+2]); + $i += 2; + } else { + $result = $self->_dotop($root, @$ident[$i, $i+1]); + } + last unless defined $result; + $root = $result; + } + } + else { + $result = $self->_dotop($root, $ident, $args); + } + + return defined $result ? $result : ''; +} + + +#------------------------------------------------------------------------ +# set($ident, $value, $default) +# +# Updates the value for a variable in the stash. The first parameter +# should be the variable name or array, as per get(). The second +# parameter should be the intended value for the variable. The third, +# optional parameter is a flag which may be set to indicate 'default' +# mode. When set true, the variable will only be updated if it is +# currently undefined or has a false value. The magical 'IMPORT' +# variable identifier may be used to indicate that $value is a hash +# reference whose values should be imported. Returns the value set, +# or an empty string if not set (e.g. default mode). In the case of +# IMPORT, returns the number of items imported from the hash. +#------------------------------------------------------------------------ + +sub set { + my ($self, $ident, $value, $default) = @_; + my ($root, $result, $error); + + $root = $self; + + ELEMENT: { + if (ref $ident eq 'ARRAY' + || ($ident =~ /\./) + && ($ident = [ map { s/\(.*$//; ($_, 0) } + split(/\./, $ident) ])) { + + # a compound identifier may contain multiple elements (e.g. + # foo.bar.baz) and we must first resolve all but the last, + # using _dotop() with the $lvalue flag set which will create + # intermediate hashes if necessary... + my $size = $#$ident; + foreach (my $i = 0; $i < $size - 2; $i += 2) { + $result = $self->_dotop($root, @$ident[$i, $i+1], 1); + last ELEMENT unless defined $result; + $root = $result; + } + + # then we call _assign() to assign the value to the last element + $result = $self->_assign($root, @$ident[$size-1, $size], + $value, $default); + } + else { + $result = $self->_assign($root, $ident, 0, $value, $default); + } + } + + return defined $result ? $result : ''; +} + + +#------------------------------------------------------------------------ +# getref($ident) +# +# Returns a "reference" to a particular item. This is represented as a +# closure which will return the actual stash item when called. +# WARNING: still experimental! +#------------------------------------------------------------------------ + +sub getref { + my ($self, $ident, $args) = @_; + my ($root, $item, $result); + $root = $self; + + if (ref $ident eq 'ARRAY') { + my $size = $#$ident; + + foreach (my $i = 0; $i <= $size; $i += 2) { + ($item, $args) = @$ident[$i, $i + 1]; + last if $i >= $size - 2; # don't evaluate last node + last unless defined + ($root = $self->_dotop($root, $item, $args)); + } + } + else { + $item = $ident; + } + + if (defined $root) { + return sub { my @args = (@{$args||[]}, @_); + $self->_dotop($root, $item, \@args); + } + } + else { + return sub { '' }; + } +} + + + + +#------------------------------------------------------------------------ +# update(\%params) +# +# Update multiple variables en masse. No magic is performed. Simple +# variable names only. +#------------------------------------------------------------------------ + +sub update { + my ($self, $params) = @_; + + # look out for magical 'import' argument to import another hash + my $import = $params->{ import }; + if (defined $import && UNIVERSAL::isa($import, 'HASH')) { + @$self{ keys %$import } = values %$import; + delete $params->{ import }; + } + + @$self{ keys %$params } = values %$params; +} + + +#======================================================================== +# ----- PRIVATE OBJECT METHODS ----- +#======================================================================== + +#------------------------------------------------------------------------ +# _dotop($root, $item, \@args, $lvalue, $nextItem) +# +# This is the core 'dot' operation method which evaluates elements of +# variables against their root. All variables have an implicit root +# which is the stash object itself (a hash). Thus, a non-compound +# variable 'foo' is actually '(stash.)foo', the compound 'foo.bar' is +# '(stash.)foo.bar'. The first parameter is a reference to the current +# root, initially the stash itself. The second parameter contains the +# name of the variable element, e.g. 'foo'. The third optional +# parameter is a reference to a list of any parenthesised arguments +# specified for the variable, which are passed to sub-routines, object +# methods, etc. The final parameter is an optional flag to indicate +# if this variable is being evaluated on the left side of an assignment +# (e.g. foo.bar.baz = 10). When set true, intermediated hashes will +# be created (e.g. bar) if necessary. +# +# Returns the result of evaluating the item against the root, having +# performed any variable "magic". The value returned can then be used +# as the root of the next _dotop() in a compound sequence. Returns +# undef if the variable is undefined. +#------------------------------------------------------------------------ + +sub _dotop { + my ($self, $root, $item, $args, $lvalue, $nextItem) = @_; + my $rootref = ref $root; + my ($value, @result, $ret, $retVal); + $nextItem ||= ""; + my $scalarContext = 1 if ( $nextItem eq "scalar" ); + my $returnRef = 1 if ( $nextItem eq "ref" ); + + $args ||= [ ]; + $lvalue ||= 0; + +# print STDERR "_dotop(root=$root, item=$item, args=[@$args])\n" +# if $DEBUG; + + # return undef without an error if either side of the dot is unviable + # or if an attempt is made to access a private member, starting _ or . + return undef + unless defined($root) and defined($item) and $item !~ /^[\._]/; + + if (ref(\$root) eq "SCALAR" && !$lvalue && + (($value = $LIST_OPS->{ $item }) || $item =~ /^-?\d+$/) ) { + # + # Promote scalar to one element list, to be processed below. + # + $rootref = 'ARRAY'; + $root = [$root]; + } + if ($rootref eq __PACKAGE__ || $rootref eq 'HASH') { + + # if $root is a regular HASH or a Template::Stash kinda HASH (the + # *real* root of everything). We first lookup the named key + # in the hash, or create an empty hash in its place if undefined + # and the $lvalue flag is set. Otherwise, we check the HASH_OPS + # pseudo-methods table, calling the code if found, or return undef. + + if (defined($value = $root->{ $item })) { + ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef, + $scalarContext); + return $retVal if ( $ret ); ## RETURN + } + elsif ($lvalue) { + # we create an intermediate hash if this is an lvalue + return $root->{ $item } = { }; ## RETURN + } + elsif ($value = $HASH_OPS->{ $item }) { + @result = &$value($root, @$args); ## @result + } + elsif (ref $item eq 'ARRAY') { + # hash slice + return [@$root{@$item}]; ## RETURN + } + elsif ($value = $SCALAR_OPS->{ $item }) { + # + # Apply scalar ops to every hash element, in place. + # + foreach my $key ( keys %$root ) { + $root->{$key} = &$value($root->{$key}, @$args); + } + } + } + elsif ($rootref eq 'ARRAY') { + + # if root is an ARRAY then we check for a LIST_OPS pseudo-method + # (except for l-values for which it doesn't make any sense) + # or return the numerical index into the array, or undef + + if (($value = $LIST_OPS->{ $item }) && ! $lvalue) { + @result = &$value($root, @$args); ## @result + } + elsif (($value = $SCALAR_OPS->{ $item }) && ! $lvalue) { + # + # Apply scalar ops to every array element, in place. + # + for ( my $i = 0 ; $i < @$root ; $i++ ) { + $root->[$i] = &$value($root->[$i], @$args); ## @result + } + } + elsif ($item =~ /^-?\d+$/) { + $value = $root->[$item]; + ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef, + $scalarContext); + return $retVal if ( $ret ); ## RETURN + } + elsif (ref $item eq 'ARRAY' ) { + # array slice + return [@$root[@$item]]; ## RETURN + } + } + + # NOTE: we do the can-can because UNIVSERAL::isa($something, 'UNIVERSAL') + # doesn't appear to work with CGI, returning true for the first call + # and false for all subsequent calls. + + elsif (ref($root) && UNIVERSAL::can($root, 'can')) { + + # if $root is a blessed reference (i.e. inherits from the + # UNIVERSAL object base class) then we call the item as a method. + # If that fails then we try to fallback on HASH behaviour if + # possible. + return ref $root->can($item) if ( $returnRef ); ## RETURN + eval { + @result = $scalarContext ? scalar $root->$item(@$args) + : $root->$item(@$args); ## @result + }; + + if ($@) { + # failed to call object method, so try some fallbacks + if (UNIVERSAL::isa($root, 'HASH') + && defined($value = $root->{ $item })) { + ($ret, $retVal, @result) = _dotop_return($value, $args, + $returnRef, $scalarContext); + return $retVal if ( $ret ); ## RETURN + } + elsif (UNIVERSAL::isa($root, 'ARRAY') + && ($value = $LIST_OPS->{ $item })) { + @result = &$value($root, @$args); + } + else { + @result = (undef, $@); + } + } + } + elsif (($value = $SCALAR_OPS->{ $item }) && ! $lvalue) { + + # at this point, it doesn't look like we've got a reference to + # anything we know about, so we try the SCALAR_OPS pseudo-methods + # table (but not for l-values) + + @result = &$value($root, @$args); ## @result + } + elsif ($self->{ _DEBUG }) { + die "don't know how to access [ $root ].$item\n"; ## DIE + } + else { + @result = (); + } + + # fold multiple return items into a list unless first item is undef + if (defined $result[0]) { + return ref(@result > 1 ? [ @result ] : $result[0]) + if ( $returnRef ); ## RETURN + if ( $scalarContext ) { + return scalar @result if ( @result > 1 ); ## RETURN + return scalar(@{$result[0]}) if ( ref $result[0] eq "ARRAY" ); + return scalar(%{$result[0]}) if ( ref $result[0] eq "HASH" ); + return $result[0]; ## RETURN + } else { + return @result > 1 ? [ @result ] : $result[0]; ## RETURN + } + } + elsif (defined $result[1]) { + die $result[1]; ## DIE + } + elsif ($self->{ _DEBUG }) { + die "$item is undefined\n"; ## DIE + } + + return undef; +} + +#------------------------------------------------------------------------ +# ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef, +# $scalarContext); +# +# Handle the various return processing for _dotop +#------------------------------------------------------------------------ +sub _dotop_return +{ + my($value, $args, $returnRef, $scalarContext) = @_; + my(@result); + + return (1, ref $value) if ( $returnRef ); ## RETURN + if ( $scalarContext ) { + return (1, scalar(@$value)) if ref $value eq 'ARRAY'; ## RETURN + return (1, scalar(%$value)) if ref $value eq 'HASH'; ## RETURN + return (1, scalar($value)) unless ref $value eq 'CODE'; ## RETURN; + @result = scalar &$value(@$args) ## @result; + } else { + return (1, $value) unless ref $value eq 'CODE'; ## RETURN + @result = &$value(@$args); ## @result + } + return (0, undef, @result); +} + + +#------------------------------------------------------------------------ +# _assign($root, $item, \@args, $value, $default) +# +# Similar to _dotop() above, but assigns a value to the given variable +# instead of simply returning it. The first three parameters are the +# root item, the item and arguments, as per _dotop(), followed by the +# value to which the variable should be set and an optional $default +# flag. If set true, the variable will only be set if currently false +# (undefined/zero) +#------------------------------------------------------------------------ + +sub _assign { + my ($self, $root, $item, $args, $value, $default) = @_; + my $rootref = ref $root; + my $result; + $args ||= [ ]; + $default ||= 0; + +# print(STDERR "_assign(root=$root, item=$item, args=[@$args], \n", +# "value=$value, default=$default)\n") +# if $DEBUG; + + # return undef without an error if either side of the dot is unviable + # or if an attempt is made to update a private member, starting _ or . + return undef ## RETURN + unless $root and defined $item and $item !~ /^[\._]/; + + if ($rootref eq 'HASH' || $rootref eq __PACKAGE__) { +# if ($item eq 'IMPORT' && UNIVERSAL::isa($value, 'HASH')) { +# # import hash entries into root hash +# @$root{ keys %$value } = values %$value; +# return ''; ## RETURN +# } + # if the root is a hash we set the named key + return ($root->{ $item } = $value) ## RETURN + unless $default && $root->{ $item }; + } + elsif ($rootref eq 'ARRAY' && $item =~ /^-?\d+$/) { + # or set a list item by index number + return ($root->[$item] = $value) ## RETURN + unless $default && $root->{ $item }; + } + elsif (UNIVERSAL::isa($root, 'UNIVERSAL')) { + # try to call the item as a method of an object + return $root->$item(@$args, $value); ## RETURN + } + else { + die "don't know how to assign to [$root].[$item]\n"; ## DIE + } + + return undef; +} + + +#------------------------------------------------------------------------ +# _dump() +# +# Debug method which returns a string representing the internal state +# of the object. The method calls itself recursively to dump sub-hashes. +#------------------------------------------------------------------------ + +sub _dump { + my $self = shift; + my $indent = shift || 1; + my $buffer = ' '; + my $pad = $buffer x $indent; + my $text = ''; + local $" = ', '; + + my ($key, $value); + + + return $text . "...excessive recursion, terminating\n" + if $indent > 32; + + foreach $key (keys %$self) { + + $value = $self->{ $key }; + $value = '' unless defined $value; + + if (ref($value) eq 'ARRAY') { + $value = "$value [@$value]"; + } + $text .= sprintf("$pad%-8s => $value\n", $key); + next if $key =~ /^\./; + if (UNIVERSAL::isa($value, 'HASH')) { + $text .= _dump($value, $indent + 1); + } + } + $text; +} + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Stash::Context - Experimetal stash allowing list/scalar context definition + +=head1 SYNOPSIS + + use Template; + use Template::Stash::Context; + + my $stash = Template::Stash::Context->new(\%vars); + my $tt2 = Template->new({ STASH => $stash }); + +=head1 DESCRIPTION + +This is an alternate stash object which includes a patch from +Craig Barratt to implement various new virtual methods to allow +dotted template variable to denote if object methods and subroutines +should be called in scalar or list context. It adds a little overhead +to each stash call and I'm a little wary of applying that to the core +default stash without investigating the effects first. So for now, +it's implemented as a separate stash module which will allow us to +test it out, benchmark it and switch it in or out as we require. + +This is what Craig has to say about it: + +Here's a better set of features for the core. Attached is a new version +of Stash.pm (based on TT2.02) that: + +* supports the special op "scalar" that forces scalar context on +function calls, eg: + + cgi.param("foo").scalar + +calls cgi.param("foo") in scalar context (unlike my wimpy +scalar op from last night). Array context is the default. + +With non-function operands, scalar behaves like the perl +version (eg: no-op for scalar, size for arrays, etc). + +* supports the special op "ref" that behaves like the perl ref. +If applied to a function the function is not called. Eg: + + cgi.param("foo").ref + +does *not* call cgi.param and evaluates to "CODE". Similarly, +HASH.ref, ARRAY.ref return what you expect. + +* adds a new scalar and list op called "array" that is a no-op for +arrays and promotes scalars to one-element arrays. + +* allows scalar ops to be applied to arrays and hashes in place, +eg: ARRAY.repeat(3) repeats each element in place. + +* allows list ops to be applied to scalars by promoting the scalars +to one-element arrays (like an implicit "array"). So you can +do things like SCALAR.size, SCALAR.join and get a useful result. + +This also means you can now use x.0 to safely get the first element +whether x is an array or scalar. + +The new Stash.pm passes the TT2.02 test suite. But I haven't tested the +new features very much. One nagging implementation problem is that the +"scalar" and "ref" ops have higher precedence than user variable names. + +=head1 AUTHOR + +Andy Wardley Eabw@andywardley.comE + +L + + + + +=head1 VERSION + +1.53, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L diff --git a/lib/Template/Stash/XS.pm b/lib/Template/Stash/XS.pm new file mode 100644 index 0000000..ca37c08 --- /dev/null +++ b/lib/Template/Stash/XS.pm @@ -0,0 +1,176 @@ +#============================================================= -*-Perl-*- +# +# Template::Stash::XS +# +# DESCRIPTION +# +# Perl bootstrap for XS module. Inherits methods from +# Template::Stash when not implemented in the XS module. +# +#======================================================================== + +package Template::Stash::XS; + +use Template; +use Template::Stash; + +BEGIN { + require DynaLoader; + @Template::Stash::XS::ISA = qw( DynaLoader Template::Stash ); + + eval { + bootstrap Template::Stash::XS $Template::VERSION; + }; + if ($@) { + die "Couldn't load Template::Stash::XS $Template::VERSION:\n\n$@\n"; + } +} + + +sub DESTROY { + # no op + 1; +} + + +# catch missing method calls here so perl doesn't barf +# trying to load *.al files +sub AUTOLOAD { + my ($self, @args) = @_; + my @c = caller(0); + my $auto = $AUTOLOAD; + + $auto =~ s/.*:://; + $self =~ s/=.*//; + + die "Can't locate object method \"$auto\"" . + " via package \"$self\" at $c[1] line $c[2]\n"; +} + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Stash::XS - Experimetal high-speed stash written in XS + +=head1 SYNOPSIS + + use Template; + use Template::Stash::XS; + + my $stash = Template::Stash::XS->new(\%vars); + my $tt2 = Template->new({ STASH => $stash }); + +=head1 DESCRIPTION + +This module loads the XS version of Template::Stash::XS. It should +behave very much like the old one, but run about twice as fast. +See the synopsis above for usage information. + +Only a few methods (such as get and set) have been implemented in XS. +The others are inherited from Template::Stash. + +=head1 NOTE + +To always use the XS version of Stash, modify the Template/Config.pm +module near line 45: + + $STASH = 'Template::Stash::XS'; + +If you make this change, then there is no need to explicitly create +an instance of Template::Stash::XS as seen in the SYNOPSIS above. Just +use Template as normal. + +Alternatively, in your code add this line before creating a Template +object: + + $Template::Config::STASH = 'Template::Stash::XS'; + +To use the original, pure-perl version restore this line in +Template/Config.pm: + + $STASH = 'Template::Stash'; + +Or in your code: + + $Template::Config::STASH = 'Template::Stash'; + +You can elect to have this performed once for you at installation +time by answering 'y' or 'n' to the question that asks if you want +to make the XS Stash the default. + +=head1 BUGS + +Please report bugs to the Template Toolkit mailing list +templates@template-toolkit.org + +As of version 2.05 of the Template Toolkit, use of the XS Stash is +known to have 2 potentially troublesome side effects. The first +problem is that accesses to tied hashes (e.g. Apache::Session) may not +work as expected. This should be fixed in an imminent release. If +you are using tied hashes then it is suggested that you use the +regular Stash by default, or write a thin wrapper around your tied +hashes to enable the XS Stash to access items via regular method +calls. + +The second potential problem is that enabling the XS Stash causes all +the Template Toolkit modules to be installed in an architecture +dependant library, e.g. in + + /usr/lib/perl5/site_perl/5.6.0/i386-linux/Template + +instead of + + /usr/lib/perl5/site_perl/5.6.0/Template + +At the time of writing, we're not sure why this is happening but it's +likely that this is either a bug or intentional feature in the Perl +ExtUtils::MakeMaker module. As far as I know, Perl always checks the +architecture dependant directories before the architecture independant +ones. Therefore, a newer version of the Template Toolkit installed +with the XS Stash enabled should be used by Perl in preference to any +existing version using the regular stash. However, if you install a +future version of the Template Toolkit with the XS Stash disabled, you +may find that Perl continues to use the older version with XS Stash +enabled in preference. + +=head1 AUTHORS + +Andy Wardley Eabw@tt2.orgE + +Doug Steinwand Edsteinwand@citysearch.comE + +=head1 VERSION + +Template Toolkit version 2.10, released on 24 July 2003. + + + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + + + +=head1 SEE ALSO + +L + diff --git a/lib/Template/Test.pm b/lib/Template/Test.pm new file mode 100644 index 0000000..ba5915f --- /dev/null +++ b/lib/Template/Test.pm @@ -0,0 +1,701 @@ +#============================================================= -*-Perl-*- +# +# Template::Test +# +# DESCRIPTION +# Module defining a test harness which processes template input and +# then compares the output against pre-define expected output. +# Generates test output compatible with Test::Harness. This was +# originally the t/texpect.pl script. +# +# AUTHOR +# Andy Wardley +# +# COPYRIGHT +# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved. +# Copyright (C) 1998-2000 Canon Research Centre Europe Ltd. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#---------------------------------------------------------------------------- +# +# $Id: Test.pm,v 2.64 2003/04/29 12:29:49 abw Exp $ +# +#============================================================================ + +package Template::Test; + +require 5.004; + +use strict; +use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS + $VERSION $DEBUG $EXTRA $PRESERVE $REASON $NO_FLUSH + $loaded %callsign); +use Template qw( :template ); +use Exporter; + +$VERSION = sprintf("%d.%02d", q$Revision: 2.64 $ =~ /(\d+)\.(\d+)/); +$DEBUG = 0; +@ISA = qw( Exporter ); +@EXPORT = qw( ntests ok is match flush skip_all test_expect callsign banner ); +@EXPORT_OK = ( 'assert' ); +%EXPORT_TAGS = ( all => [ @EXPORT_OK, @EXPORT ] ); +$| = 1; + +$REASON = 'not applicable on this platform'; +$NO_FLUSH = 0; +$EXTRA = 0; # any extra tests to come after test_expect() +$PRESERVE = 0 # don't mangle newlines in output/expect + unless defined $PRESERVE; + +# always set binmode on Win32 machines so that any output generated +# is true to what we expect +$Template::BINMODE = ($^O eq 'MSWin32') ? 1 : 0; + +my @results = (); +my ($ntests, $ok_count); +*is = \&match; + +END { + # ensure flush() is called to print any cached results + flush(); +} + + +#------------------------------------------------------------------------ +# ntests($n) +# +# Declare how many (more) tests are expected to come. If ok() is called +# before ntests() then the results are cached instead of being printed +# to STDOUT. When ntests() is called, the total number of tests +# (including any cached) is known and the "1..$ntests" line can be +# printed along with the cached results. After that, calls to ok() +# generated printed output immediately. +#------------------------------------------------------------------------ + +sub ntests { + $ntests = shift; + # add any pre-declared extra tests, or pre-stored test @results, to + # the grand total of tests + $ntests += $EXTRA + scalar @results; + $ok_count = 1; + print $ntests ? "1..$ntests\n" : "1..$ntests # skipped: $REASON\n"; + # flush cached results + foreach my $pre_test (@results) { + ok(@$pre_test); + } +} + + +#------------------------------------------------------------------------ +# ok($truth, $msg) +# +# Tests the value passed for truth and generates an "ok $n" or "not ok $n" +# line accordingly. If ntests() hasn't been called then we cached +# results for later, instead. +#------------------------------------------------------------------------ + +sub ok { + my ($ok, $msg) = @_; + + # cache results if ntests() not yet called + unless ($ok_count) { + push(@results, [ $ok, $msg ]); + return $ok; + } + + $msg = defined $msg ? " - $msg" : ''; + if ($ok) { + print "ok ", $ok_count++, "$msg\n"; + } + else { + print STDERR "FAILED $ok_count: $msg\n" if defined $msg; + print "not ok ", $ok_count++, "$msg\n"; + } +} + + + +#------------------------------------------------------------------------ +# assert($truth, $error) +# +# Test value for truth, die if false. +#------------------------------------------------------------------------ + +sub assert { + my ($ok, $err) = @_; + return ok(1) if $ok; + + # failed + my ($pkg, $file, $line) = caller(); + $err ||= "assert failed"; + $err .= " at $file line $line\n"; + ok(0); + die $err; +} + +#------------------------------------------------------------------------ +# match( $result, $expect ) +#------------------------------------------------------------------------ + +sub match { + my ($result, $expect, $msg) = @_; + my $count = $ok_count ? $ok_count : scalar @results + 1; + + # force stringification of $result to avoid 'no eq method' overload errors + $result = "$result" if ref $result; + + if ($result eq $expect) { + return ok(1, $msg); + } + else { + print STDERR "FAILED $count:\n expect: [$expect]\n result: [$result]\n"; + return ok(0, $msg); + } +} + + +#------------------------------------------------------------------------ +# flush() +# +# Flush any tests results. +#------------------------------------------------------------------------ + +sub flush { + ntests(0) + unless $ok_count || $NO_FLUSH; +} + + +#------------------------------------------------------------------------ +# skip_all($reason) +# +# Skip all tests, setting $REASON to contain any message passed. Calls +# exit(0) which triggers flush() which generates a "1..0 # $REASON" +# string to keep to test harness happy. +#------------------------------------------------------------------------ + +sub skip_all { + $REASON = join('', @_); + exit(0); +} + + +#------------------------------------------------------------------------ +# test_expect($input, $template, \%replace) +# +# This is the main testing sub-routine. The $input parameter should be a +# text string or a filehandle reference (e.g. GLOB or IO::Handle) from +# which the input text can be read. The input should contain a number +# of tests which are split up and processed individually, comparing the +# generated output against the expected output. Tests should be defined +# as follows: +# +# -- test -- +# test input +# -- expect -- +# expected output +# +# -- test -- +# etc... +# +# The number of tests is determined and ntests() is called to generate +# the "0..$n" line compatible with Test::Harness. Each test input is +# then processed by the Template object passed as the second parameter, +# $template. This may also be a hash reference containing configuration +# which are used to instantiate a Template object, or may be left +# undefined in which case a default Template object will be instantiated. +# The third parameter, also optional, may be a reference to a hash array +# defining template variables. This is passed to the template process() +# method. +#------------------------------------------------------------------------ + +sub test_expect { + my ($src, $tproc, $params) = @_; + my ($input, @tests); + my ($output, $expect, $match); + my $count = 0; + my $ttprocs; + + # read input text + eval { + local $/ = undef; + $input = ref $src ? <$src> : $src; + }; + if ($@) { + ntests(1); ok(0); + warn "Cannot read input text from $src\n"; + return undef; + } + + # remove any comment lines + $input =~ s/^#.*?\n//gm; + + # remove anything before '-- start --' and/or after '-- stop --' + $input = $' if $input =~ /\s*--\s*start\s*--\s*/; + $input = $` if $input =~ /\s*--\s*stop\s*--\s*/; + + @tests = split(/^\s*--\s*test\s*--\s*\n/im, $input); + + # if the first line of the file was '--test--' (optional) then the + # first test will be empty and can be discarded + shift(@tests) if $tests[0] =~ /^\s*$/; + + ntests(3 + scalar(@tests) * 2); + + # first test is that Template loaded OK, which it did + ok(1, 'running test_expect()'); + + # optional second param may contain a Template reference or a HASH ref + # of constructor options, or may be undefined + if (ref($tproc) eq 'HASH') { + # create Template object using hash of config items + $tproc = Template->new($tproc) + || die Template->error(), "\n"; + } + elsif (ref($tproc) eq 'ARRAY') { + # list of [ name => $tproc, name => $tproc ], use first $tproc + $ttprocs = { @$tproc }; + $tproc = $tproc->[1]; + } + elsif (! ref $tproc) { + $tproc = Template->new() + || die Template->error(), "\n"; + } + # otherwise, we assume it's a Template reference + + # test: template processor created OK + ok($tproc, 'template processor is engaged'); + + # third test is that the input read ok, which it did + ok(1, 'input read and split into ' . scalar @tests . ' tests'); + + # the remaining tests are defined in @tests... + foreach $input (@tests) { + $count++; + my $name = ''; + + if ($input =~ s/^\s*-- name:? (.*?) --\s*\n//im) { + $name = $1; + } + else { + $name = "template text $count"; + } + + # split input by a line like "-- expect --" + ($input, $expect) = + split(/^\s*--\s*expect\s*--\s*\n/im, $input); + $expect = '' + unless defined $expect; + + $output = ''; + + # input text may be prefixed with "-- use name --" to indicate a + # Template object in the $ttproc hash which we should use + if ($input =~ s/^\s*--\s*use\s+(\S+)\s*--\s*\n//im) { + my $ttname = $1; + my $ttlookup; + if ($ttlookup = $ttprocs->{ $ttname }) { + $tproc = $ttlookup; + } + else { + warn "no such template object to use: $ttname\n"; + } + } + + # process input text + $tproc->process(\$input, $params, \$output) || do { + warn "Template process failed: ", $tproc->error(), "\n"; + # report failure and automatically fail the expect match + ok(0, "$name process FAILED: " . subtext($input)); + ok(0, '(obviously did not match expected)'); + next; + }; + + # processed OK + ok(1, "$name processed OK: " . subtext($input)); + + # another hack: if the '-- expect --' section starts with + # '-- process --' then we process the expected output + # before comparing it with the generated output. This is + # slightly twisted but it makes it possible to run tests + # where the expected output isn't static. See t/date.t for + # an example. + + if ($expect =~ s/^\s*--+\s*process\s*--+\s*\n//im) { + my $out; + $tproc->process(\$expect, $params, \$out) || do { + warn("Template process failed (expect): ", + $tproc->error(), "\n"); + # report failure and automatically fail the expect match + ok(0, "failed to process expected output [" + . subtext($expect) . ']'); + next; + }; + $expect = $out; + }; + + # strip any trailing blank lines from expected and real output + foreach ($expect, $output) { + s/\n*\Z//mg; + } + + $match = ($expect eq $output) ? 1 : 0; + if (! $match || $DEBUG) { + print "MATCH FAILED\n" + unless $match; + + my ($copyi, $copye, $copyo) = ($input, $expect, $output); + unless ($PRESERVE) { + foreach ($copyi, $copye, $copyo) { + s/\n/\\n/g; + } + } + printf(" input: [%s]\nexpect: [%s]\noutput: [%s]\n", + $copyi, $copye, $copyo); + } + + ok($match, $match ? "$name matched expected" : "$name did not match expected"); + }; +} + +#------------------------------------------------------------------------ +# callsign() +# +# Returns a hash array mapping lower a..z to their phonetic alphabet +# equivalent. +#------------------------------------------------------------------------ + +sub callsign { + my %callsign; + @callsign{ 'a'..'z' } = qw( + alpha bravo charlie delta echo foxtrot golf hotel india + juliet kilo lima mike november oscar papa quebec romeo + sierra tango umbrella victor whisky x-ray yankee zulu ); + return \%callsign; +} + + +#------------------------------------------------------------------------ +# banner($text) +# +# Prints a banner with the specified text if $DEBUG is set. +#------------------------------------------------------------------------ + +sub banner { + return unless $DEBUG; + my $text = join('', @_); + my $count = $ok_count ? $ok_count - 1 : scalar @results; + print "-" x 72, "\n$text ($count tests completed)\n", "-" x 72, "\n"; +} + + +sub subtext { + my $text = shift; + $text =~ s/\s*$//sg; + $text = substr($text, 0, 32) . '...' if length $text > 32; + $text =~ s/\n/\\n/g; + return $text; +} + + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Test - Module for automating TT2 test scripts + +=head1 SYNOPSIS + + use Template::Test; + + $Template::Test::DEBUG = 0; # set this true to see each test running + $Template::Test::EXTRA = 2; # 2 extra tests follow test_expect()... + + # ok() can be called any number of times before test_expect + ok( $true_or_false ) + + # test_expect() splits $input into individual tests, processes each + # and compares generated output against expected output + test_expect($input, $template, \%replace ); + + # $input is text or filehandle (e.g. DATA section after __END__) + test_expect( $text ); + test_expect( \*DATA ); + + # $template is a Template object or configuration hash + my $template_cfg = { ... }; + test_expect( $input, $template_cfg ); + my $template_obj = Template->new($template_cfg); + test_expect( $input, $template_obj ); + + # $replace is a hash reference of template variables + my $replace = { + a => 'alpha', + b => 'bravo' + }; + test_expect( $input, $template, $replace ); + + # ok() called after test_expect should be declared in $EXTRA (2) + ok( $true_or_false ) + ok( $true_or_false ) + +=head1 DESCRIPTION + +The Template::Test module defines the test_expect() and other related +subroutines which can be used to automate test scripts for the +Template Toolkit. See the numerous tests in the 't' sub-directory of +the distribution for examples of use. + +The test_expect() subroutine splits an input document into a number +of separate tests, processes each one using the Template Toolkit and +then compares the generated output against an expected output, also +specified in the input document. It generates the familiar "ok/not +ok" output compatible with Test::Harness. + +The test input should be specified as a text string or a reference to +a filehandle (e.g. GLOB or IO::Handle) from which it can be read. In +particular, this allows the test input to be placed after the __END__ +marker and read via the DATA filehandle. + + use Template::Test; + + test_expect(\*DATA); + + __END__ + # this is the first test (this is a comment) + -- test -- + blah blah blah [% foo %] + -- expect -- + blah blah blah value_of_foo + + # here's the second test (no surprise, so is this) + -- test -- + more blah blah [% bar %] + -- expect -- + more blah blah value_of_bar + +Blank lines between test sections are generally ignored. Any line starting +with '#' is treated as a comment and is ignored. + +The second and third parameters to test_expect() are optional. The second +may be either a reference to a Template object which should be used to +process the template fragments, or a reference to a hash array containing +configuration values which should be used to instantiate a new Template +object. + + # pass reference to config hash + my $config = { + INCLUDE_PATH => '/here/there:/every/where', + POST_CHOMP => 1, + }; + test_expect(\*DATA, $config); + + # or create Template object explicitly + my $template = Template->new($config); + test_expect(\*DATA, $template); + + +The third parameter may be used to reference a hash array of template +variable which should be defined when processing the tests. This is +passed to the Template process() method. + + my $replace = { + a => 'alpha', + b => 'bravo', + }; + + test_expect(\*DATA, $config, $replace); + +The second parameter may be left undefined to specify a default Template +configuration. + + test_expect(\*DATA, undef, $replace); + +For testing the output of different Template configurations, a +reference to a list of named Template objects also may be passed as +the second parameter. + + my $tt1 = Template->new({ ... }); + my $tt2 = Template->new({ ... }); + my @tts = [ one => $tt1, two => $tt1 ]; + +The first object in the list is used by default. Other objects may be +switched in with the '-- use $name --' marker. This should immediately +follow a '-- test --' line. That object will then be used for the rest +of the test, or until a different object is selected. + + -- test -- + -- use one -- + [% blah %] + -- expect -- + blah, blah + + -- test -- + still using one... + -- expect -- + ... + + -- test -- + -- use two -- + [% blah %] + -- expect -- + blah, blah, more blah + +The test_expect() sub counts the number of tests, and then calls ntests() +to generate the familiar "1..$ntests\n" test harness line. Each +test defined generates two test numbers. The first indicates +that the input was processed without error, and the second that the +output matches that expected. + +Additional test may be run before test_expect() by calling ok(). +These test results are cached until ntests() is called and the final +number of tests can be calculated. Then, the "1..$ntests" line is +output, along with "ok $n" / "not ok $n" lines for each of the cached +test result. Subsequent calls to ok() then generate an output line +immediately. + + my $something = SomeObject->new(); + ok( $something ); + + my $other = AnotherThing->new(); + ok( $other ); + + test_expect(\*DATA); + +If any tests are to follow after test_expect() is called then these +should be pre-declared by setting the $EXTRA package variable. This +value (default: 0) is added to the grand total calculated by ntests(). +The results of the additional tests are also registered by calling ok(). + + $Template::Test::EXTRA = 2; + + # can call ok() any number of times before test_expect() + ok( $did_that_work ); + ok( $make_sure ); + ok( $dead_certain ); + + # number of tests... + test_expect(\*DATA, $config, $replace); + + # here's those $EXTRA tests + ok( defined $some_result && ref $some_result eq 'ARRAY' ); + ok( $some_result->[0] eq 'some expected value' ); + +If you don't want to call test_expect() at all then you can call +ntests($n) to declare the number of tests and generate the test +header line. After that, simply call ok() for each test passing +a true or false values to indicate that the test passed or failed. + + ntests(2); + ok(1); + ok(0); + +If you're really lazy, you can just call ok() and not bother declaring +the number of tests at all. All tests results will be cached until the +end of the script and then printed in one go before the program exits. + + ok( $x ); + ok( $y ); + +You can identify only a specific part of the input file for testing +using the '-- start --' and '-- stop --' markers. Anything before the +first '-- start --' is ignored, along with anything after the next +'-- stop --' marker. + + -- test -- + this is test 1 (not performed) + -- expect -- + this is test 1 (not performed) + + -- start -- + + -- test -- + this is test 2 + -- expect -- + this is test 2 + + -- stop -- + + ... + +For historical reasons and general utility, the module also defines a +'callsign' subroutine which returns a hash mapping a..z to their phonetic +alphabet equivalent (e.g. radio callsigns). This is used by many +of the test scripts as a "known source" of variable values. + + test_expect(\*DATA, $config, callsign()); + +A banner() subroutine is also provided which prints a simple banner +including any text passed as parameters, if $DEBUG is set. + + banner('Testing something-or-other'); + +example output: + + #------------------------------------------------------------ + # Testing something-or-other (27 tests completed) + #------------------------------------------------------------ + +The $DEBUG package variable can be set to enable debugging mode. + +The $PRESERVE package variable can be set to stop the test_expect() +from converting newlines in the output and expected output into +the literal strings '\n'. + +=head1 HISTORY + +This module started its butt-ugly life as the t/texpect.pl script. It +was cleaned up to became the Template::Test module some time around +version 0.29. It underwent further cosmetic surgery for version 2.00 +but still retains some rear-end resemblances. + +=head1 BUGS / KNOWN "FEATURES" + +Imports all methods by default. This is generally a Bad Thing, but +this module is only used in test scripts (i.e. at build time) so a) we +don't really care and b) it saves typing. + +The line splitter may be a bit dumb, especially if it sees lines like +-- this -- that aren't supposed to be special markers. So don't do that. + +=head1 AUTHOR + +Andy Wardley Eabw@andywardley.comE + +L + + + + +=head1 VERSION + +2.64, distributed as part of the +Template Toolkit version 2.10, released on 24 July 2003. + +=head1 COPYRIGHT + + Copyright (C) 1996-2003 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L diff --git a/lib/Template/View.pm b/lib/Template/View.pm new file mode 100644 index 0000000..312ff45 --- /dev/null +++ b/lib/Template/View.pm @@ -0,0 +1,754 @@ +#============================================================= -*-Perl-*- +# +# Template::View +# +# DESCRIPTION +# A custom view of a template processing context. Can be used to +# implement custom "skins". +# +# AUTHOR +# Andy Wardley +# +# COPYRIGHT +# Copyright (C) 2000 Andy Wardley. All Rights Reserved. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +# TODO +# * allowing print to have a hash ref as final args will cause problems +# if you do this: [% view.print(hash1, hash2, hash3) %]. Current +# work-around is to do [% view.print(hash1); view.print(hash2); +# view.print(hash3) %] or [% view.print(hash1, hash2, hash3, { }) %] +# +# REVISION +# $Id: View.pm,v 2.8 2002/04/15 15:53:37 abw Exp $ +# +#============================================================================ + +package Template::View; + +require 5.004; + +use strict; +use vars qw( $VERSION $DEBUG $AUTOLOAD @BASEARGS $MAP ); +use base qw( Template::Base ); + +$VERSION = sprintf("%d.%02d", q$Revision: 2.8 $ =~ /(\d+)\.(\d+)/); +$DEBUG = 0 unless defined $DEBUG; +@BASEARGS = qw( context ); +$MAP = { + HASH => 'hash', + ARRAY => 'list', + TEXT => 'text', + default => '', +}; + +#$DEBUG = 1; + +#------------------------------------------------------------------------ +# _init(\%config) +# +# Initialisation method called by the Template::Base class new() +# constructor. $self->{ context } has already been set, by virtue of +# being named in @BASEARGS. Remaining config arguments are presented +# as a hash reference. +#------------------------------------------------------------------------ + +sub _init { + my ($self, $config) = @_; + + # move 'context' somewhere more private + $self->{ _CONTEXT } = $self->{ context }; + delete $self->{ context }; + + # generate table mapping object types to templates + my $map = $config->{ map } || { }; + $map->{ default } = $config->{ default } unless defined $map->{ default }; + $self->{ map } = { + %$MAP, + %$map, + }; + + # local BLOCKs definition table + $self->{ _BLOCKS } = $config->{ blocks } || { }; + + # name of presentation method which printed objects might provide + $self->{ method } = defined $config->{ method } + ? $config->{ method } : 'present'; + + # view is sealed by default preventing variable update after + # definition, however we don't actually seal a view until the + # END of the view definition + my $sealed = $config->{ sealed }; + $sealed = 1 unless defined $sealed; + $self->{ sealed } = $sealed ? 1 : 0; + + # copy remaining config items from $config or set defaults + foreach my $arg (qw( base prefix suffix notfound silent )) { + $self->{ $arg } = $config->{ $arg } || ''; + } + + # name of data item used by view() + $self->{ item } = $config->{ item } || 'item'; + + # map methods of form ${include_prefix}_foobar() to include('foobar')? + $self->{ include_prefix } = $config->{ include_prefix } || 'include_'; + # what about mapping foobar() to include('foobar')? + $self->{ include_naked } = defined $config->{ include_naked } + ? $config->{ include_naked } : 1; + + # map methods of form ${view_prefix}_foobar() to include('foobar')? + $self->{ view_prefix } = $config->{ view_prefix } || 'view_'; + # what about mapping foobar() to view('foobar')? + $self->{ view_naked } = $config->{ view_naked } || 0; + + # the view is initially unsealed, allowing directives in the initial + # view template to create data items via the AUTOLOAD; once sealed via + # call to seal(), the AUTOLOAD will not update any internal items. + delete @$config{ qw( base method map default prefix suffix notfound item + include_prefix include_naked silent sealed + view_prefix view_naked blocks ) }; + $config = { %{ $self->{ base }->{ data } }, %$config } + if $self->{ base }; + $self->{ data } = $config; + $self->{ SEALED } = 0; + + return $self; +} + + +#------------------------------------------------------------------------ +# seal() +# unseal() +# +# Seal or unseal the view to allow/prevent new datat items from being +# automatically created by the AUTOLOAD method. +#------------------------------------------------------------------------ + +sub seal { + my $self = shift; + $self->{ SEALED } = $self->{ sealed }; +} + +sub unseal { + my $self = shift; + $self->{ SEALED } = 0; +} + + +#------------------------------------------------------------------------ +# clone(\%config) +# +# Cloning method which takes a copy of $self and then applies to it any +# modifications specified in the $config hash passed as an argument. +# Configuration items may also be specified as a list of "name => $value" +# arguments. Returns a reference to the cloned Template::View object. +# +# NOTE: may need to copy BLOCKS??? +#------------------------------------------------------------------------ + +sub clone { + my $self = shift; + my $clone = bless { %$self }, ref $self; + my $config = ref $_[0] eq 'HASH' ? shift : { @_ }; + + # merge maps + $clone->{ map } = { + %{ $self->{ map } }, + %{ $config->{ map } || { } }, + }; + + # "map => { default=>'xxx' }" can be specified as "default => 'xxx'" + $clone->{ map }->{ default } = $config->{ default } + if defined $config->{ default }; + + # update any remaining config items + my @args = qw( base prefix suffix notfound item method include_prefix + include_naked view_prefix view_naked ); + foreach my $arg (@args) { + $clone->{ $arg } = $config->{ $arg } if defined $config->{ $arg }; + } + push(@args, qw( default map )); + delete @$config{ @args }; + + # anything left is data + my $data = $clone->{ data } = { %{ $self->{ data } } }; + @$data{ keys %$config } = values %$config; + + return $clone; +} + + +#------------------------------------------------------------------------ +# print(@items, ..., \%config) +# +# Prints @items in turn by mapping each to an approriate template using +# the internal 'map' hash. If an entry isn't found and the item is an +# object that implements the method named in the internal 'method' item, +# (default: 'present'), then the method will be called passing a reference +# to $self, against which the presenter method may make callbacks (e.g. +# to view_item()). If the presenter method isn't implemented, then the +# 'default' map entry is consulted and used if defined. The final argument +# may be a reference to a hash array providing local overrides to the internal +# defaults for various items (prefix, suffix, etc). In the presence +# of this parameter, a clone of the current object is first made, applying +# any configuration updates, and control is then delegated to it. +#------------------------------------------------------------------------ + +sub print { + my $self = shift; + + # if final config hash is specified then create a clone and delegate to it + # NOTE: potential problem when called print(\%data_hash1, \%data_hash2); + if ((scalar @_ > 1) && (ref $_[-1] eq 'HASH')) { + my $cfg = pop @_; + my $clone = $self->clone($cfg) + || return; + return $clone->print(@_) + || $self->error($clone->error()); + } + my ($item, $type, $template, $present); + my $method = $self->{ method }; + my $map = $self->{ map }; + my $output = ''; + + # print each argument + foreach $item (@_) { + my $newtype; + + if (! ($type = ref $item)) { + # non-references are TEXT + $type = 'TEXT'; + $template = $map->{ $type }; + } + elsif (! defined ($template = $map->{ $type })) { + # no specific map entry for object, maybe it implements a + # 'present' (or other) method? +# $self->DEBUG("determining if $item can $method\n") if $DEBUG; + if ( $method && UNIVERSAL::can($item, $method) ) { + $self->DEBUG("Calling \$item->$method\n") if $DEBUG; + $present = $item->$method($self); ## call item method + # undef returned indicates error, note that we expect + # $item to have called error() on the view + return unless defined $present; + $output .= $present; + next; ## NEXT + } + elsif ( UNIVERSAL::isa($item, 'HASH' ) + && defined($newtype = $item->{$method}) + && defined($template = $map->{"$method=>$newtype"})) { + } + elsif ( defined($newtype) + && defined($template = $map->{"$method=>*"}) ) { + $template =~ s/\*/$newtype/; + } + elsif (! ($template = $map->{ default }) ) { + # default not defined, so construct template name from type + ($template = $type) =~ s/\W+/_/g; + } + } +# else { +# $self->DEBUG("defined map type for $type: $template\n"); +# } + $self->DEBUG("printing view '", $template || '', "', $item\n") if $DEBUG; + $output .= $self->view($template, $item) + if $template; + } + return $output; +} + + +#------------------------------------------------------------------------ +# view($template, $item, \%vars) +# +# Wrapper around include() which expects a template name, $template, +# followed by a data item, $item, and optionally, a further hash array +# of template variables. The $item is added as an entry to the $vars +# hash (which is created empty if not passed as an argument) under the +# name specified by the internal 'item' member, which is appropriately +# 'item' by default. Thus an external object present() method can +# callback against this object method, simply passing a data item to +# be displayed. The external object doesn't have to know what the +# view expects the item to be called in the $vars hash. +#------------------------------------------------------------------------ + +sub view { + my ($self, $template, $item) = splice(@_, 0, 3); + my $vars = ref $_[0] eq 'HASH' ? shift : { @_ }; + $vars->{ $self->{ item } } = $item if defined $item; + $self->include($template, $vars); +} + + +#------------------------------------------------------------------------ +# include($template, \%vars) +# +# INCLUDE a template, $template, mapped according to the current prefix, +# suffix, default, etc., where $vars is an optional hash reference +# containing template variable definitions. If the template isn't found +# then the method will default to any 'notfound' template, if defined +# as an internal item. +#------------------------------------------------------------------------ + +sub include { + my ($self, $template, $vars) = @_; + my $context = $self->{ _CONTEXT }; + + $template = $self->template($template); + + $vars = { } unless ref $vars eq 'HASH'; + $vars->{ view } ||= $self; + + $context->include( $template, $vars ); + +# DEBUGGING +# my $out = $context->include( $template, $vars ); +# print STDERR "VIEW return [$out]\n"; +# return $out; +} + + +#------------------------------------------------------------------------ +# template($template) +# +# Returns a compiled template for the specified template name, according +# to the current configuration parameters. +#------------------------------------------------------------------------ + +sub template { + my ($self, $name) = @_; + my $context = $self->{ _CONTEXT }; + return $context->throw(Template::Constants::ERROR_VIEW, + "no view template specified") + unless $name; + + my $notfound = $self->{ notfound }; + my $base = $self->{ base }; + my ($template, $block, $error); + + return $block + if ($block = $self->{ _BLOCKS }->{ $name }); + + # try the named template + $template = $self->template_name($name); + $self->DEBUG("looking for $template\n") if $DEBUG; + eval { $template = $context->template($template) }; + + # try asking the base view if not found + if (($error = $@) && $base) { + $self->DEBUG("asking base for $name\n") if $DEBUG; + eval { $template = $base->template($name) }; + } + + # try the 'notfound' template (if defined) if that failed + if (($error = $@) && $notfound) { + unless ($template = $self->{ _BLOCKS }->{ $notfound }) { + $notfound = $self->template_name($notfound); + $self->DEBUG("not found, looking for $notfound\n") if $DEBUG; + eval { $template = $context->template($notfound) }; + + return $context->throw(Template::Constants::ERROR_VIEW, $error) + if $@; # return first error + } + } + elsif ($error) { + $self->DEBUG("no 'notfound'\n") + if $DEBUG; + return $context->throw(Template::Constants::ERROR_VIEW, $error); + } + return $template; +} + + +#------------------------------------------------------------------------ +# template_name($template) +# +# Returns the name of the specified template with any appropriate prefix +# and/or suffix added. +#------------------------------------------------------------------------ + +sub template_name { + my ($self, $template) = @_; + $template = $self->{ prefix } . $template . $self->{ suffix } + if $template; + + $self->DEBUG("template name: $template\n") if $DEBUG; + return $template; +} + + +#------------------------------------------------------------------------ +# default($val) +# +# Special case accessor to retrieve/update 'default' as an alias for +# '$map->{ default }'. +#------------------------------------------------------------------------ + +sub default { + my $self = shift; + return @_ ? ($self->{ map }->{ default } = shift) + : $self->{ map }->{ default }; +} + + +#------------------------------------------------------------------------ +# AUTOLOAD +# + +# Returns/updates public internal data items (i.e. not prefixed '_' or +# '.') or presents a view if the method matches the view_prefix item, +# e.g. view_foo(...) => view('foo', ...). Similarly, the +# include_prefix is used, if defined, to map include_foo(...) to +# include('foo', ...). If that fails then the entire method name will +# be used as the name of a template to include iff the include_named +# parameter is set (default: 1). Last attempt is to match the entire +# method name to a view() call, iff view_naked is set. Otherwise, a +# 'view' exception is raised reporting the error "no such view member: +# $method". +#------------------------------------------------------------------------ + +sub AUTOLOAD { + my $self = shift; + my $item = $AUTOLOAD; + $item =~ s/.*:://; + return if $item eq 'DESTROY'; + + if ($item =~ /^[\._]/) { + return $self->{ _CONTEXT }->throw(Template::Constants::ERROR_VIEW, + "attempt to view private member: $item"); + } + elsif (exists $self->{ $item }) { + # update existing config item (e.g. 'prefix') if unsealed + return $self->{ _CONTEXT }->throw(Template::Constants::ERROR_VIEW, + "cannot update config item in sealed view: $item") + if @_ && $self->{ SEALED }; + $self->DEBUG("accessing item: $item\n") if $DEBUG; + return @_ ? ($self->{ $item } = shift) : $self->{ $item }; + } + elsif (exists $self->{ data }->{ $item }) { + # get/update existing data item (must be unsealed to update) + if (@_ && $self->{ SEALED }) { + return $self->{ _CONTEXT }->throw(Template::Constants::ERROR_VIEW, + "cannot update item in sealed view: $item") + unless $self->{ silent }; + # ignore args if silent + @_ = (); + } + $self->DEBUG(@_ ? "updating data item: $item <= $_[0]\n" + : "returning data item: $item\n") if $DEBUG; + return @_ ? ($self->{ data }->{ $item } = shift) + : $self->{ data }->{ $item }; + } + elsif (@_ && ! $self->{ SEALED }) { + # set data item if unsealed + $self->DEBUG("setting unsealed data: $item => @_\n") if $DEBUG; + $self->{ data }->{ $item } = shift; + } + elsif ($item =~ s/^$self->{ view_prefix }//) { + $self->DEBUG("returning view($item)\n") if $DEBUG; + return $self->view($item, @_); + } + elsif ($item =~ s/^$self->{ include_prefix }//) { + $self->DEBUG("returning include($item)\n") if $DEBUG; + return $self->include($item, @_); + } + elsif ($self->{ include_naked }) { + $self->DEBUG("returning naked include($item)\n") if $DEBUG; + return $self->include($item, @_); + } + elsif ($self->{ view_naked }) { + $self->DEBUG("returning naked view($item)\n") if $DEBUG; + return $self->view($item, @_); + } + else { + return $self->{ _CONTEXT }->throw(Template::Constants::ERROR_VIEW, + "no such view member: $item"); + } +} + + +1; + + +__END__ + +=head1 NAME + +Template::View - customised view of a template processing context + +=head1 SYNOPSIS + + # define a view + [% VIEW view + # some standard args + prefix => 'my_', + suffix => '.tt2', + notfound => 'no_such_file' + ... + + # any other data + title => 'My View title' + other_item => 'Joe Random Data' + ... + %] + # add new data definitions, via 'my' self reference + [% my.author = "$abw.name <$abw.email>" %] + [% my.copy = "© Copyright 2000 $my.author" %] + + # define a local block + [% BLOCK header %] + This is the header block, title: [% title or my.title %] + [% END %] + + [% END %] + + # access data items for view + [% view.title %] + [% view.other_item %] + + # access blocks directly ('include_naked' option, set by default) + [% view.header %] + [% view.header(title => 'New Title') %] + + # non-local templates have prefix/suffix attached + [% view.footer %] # => [% INCLUDE my_footer.tt2 %] + + # more verbose form of block access + [% view.include( 'header', title => 'The Header Title' ) %] + [% view.include_header( title => 'The Header Title' ) %] + + # very short form of above ('include_naked' option, set by default) + [% view.header( title => 'The Header Title' ) %] + + # non-local templates have prefix/suffix attached + [% view.footer %] # => [% INCLUDE my_footer.tt2 %] + + # fallback on the 'notfound' template ('my_no_such_file.tt2') + # if template not found + [% view.include('missing') %] + [% view.include_missing %] + [% view.missing %] + + # print() includes a template relevant to argument type + [% view.print("some text") %] # type=TEXT, template='text' + + [% BLOCK my_text.tt2 %] # 'text' with prefix/suffix + Text: [% item %] + [% END %] + + # now print() a hash ref, mapped to 'hash' template + [% view.print(some_hash_ref) %] # type=HASH, template='hash' + + [% BLOCK my_hash.tt2 %] # 'hash' with prefix/suffix + hash keys: [% item.keys.sort.join(', ') + [% END %] + + # now print() a list ref, mapped to 'list' template + [% view.print(my_list_ref) %] # type=ARRAY, template='list' + + [% BLOCK my_list.tt2 %] # 'list' with prefix/suffix + list: [% item.join(', ') %] + [% END %] + + # print() maps 'My::Object' to 'My_Object' + [% view.print(myobj) %] + + [% BLOCK my_My_Object.tt2 %] + [% item.this %], [% item.that %] + [% END %] + + # update mapping table + [% view.map.ARRAY = 'my_list_template' %] + [% view.map.TEXT = 'my_text_block' %] + + + # change prefix, suffix, item name, etc. + [% view.prefix = 'your_' %] + [% view.default = 'anyobj' %] + ... + +=head1 DESCRIPTION + +TODO + +=head1 METHODS + +=head2 new($context, \%config) + +Creates a new Template::View presenting a custom view of the specified +$context object. + +A reference to a hash array of configuration options may be passed as the +second argument. + +=over 4 + +=item prefix + +Prefix added to all template names. + + [% USE view(prefix => 'my_') %] + [% view.view('foo', a => 20) %] # => my_foo + +=item suffix + +Suffix added to all template names. + + [% USE view(suffix => '.tt2') %] + [% view.view('foo', a => 20) %] # => foo.tt2 + +=item map + +Hash array mapping reference types to template names. The print() +method uses this to determine which template to use to present any +particular item. The TEXT, HASH and ARRAY items default to 'test', +'hash' and 'list' appropriately. + + [% USE view(map => { ARRAY => 'my_list', + HASH => 'your_hash', + My::Foo => 'my_foo', } ) %] + + [% view.print(some_text) %] # => text + [% view.print(a_list) %] # => my_list + [% view.print(a_hash) %] # => your_hash + [% view.print(a_foo) %] # => my_foo + + [% BLOCK text %] + Text: [% item %] + [% END %] + + [% BLOCK my_list %] + list: [% item.join(', ') %] + [% END %] + + [% BLOCK your_hash %] + hash keys: [% item.keys.sort.join(', ') + [% END %] + + [% BLOCK my_foo %] + Foo: [% item.this %], [% item.that %] + [% END %] + +=item method + +Name of a method which objects passed to print() may provide for presenting +themselves to the view. If a specific map entry can't be found for an +object reference and it supports the method (default: 'present') then +the method will be called, passing the view as an argument. The object +can then make callbacks against the view to present itself. + + package Foo; + + sub present { + my ($self, $view) = @_; + return "a regular view of a Foo\n"; + } + + sub debug { + my ($self, $view) = @_; + return "a debug view of a Foo\n"; + } + +In a template: + + [% USE view %] + [% view.print(my_foo_object) %] # a regular view of a Foo + + [% USE view(method => 'debug') %] + [% view.print(my_foo_object) %] # a debug view of a Foo + +=item default + +Default template to use if no specific map entry is found for an item. + + [% USE view(default => 'my_object') %] + + [% view.print(objref) %] # => my_object + +If no map entry or default is provided then the view will attempt to +construct a template name from the object class, substituting any +sequence of non-word characters to single underscores, e.g. + + # 'fubar' is an object of class Foo::Bar + [% view.print(fubar) %] # => Foo_Bar + +Any current prefix and suffix will be added to both the default template +name and any name constructed from the object class. + +=item notfound + +Fallback template to use if any other isn't found. + +=item item + +Name of the template variable to which the print() method assigns the current +item. Defaults to 'item'. + + [% USE view %] + [% BLOCK list %] + [% item.join(', ') %] + [% END %] + [% view.print(a_list) %] + + [% USE view(item => 'thing') %] + [% BLOCK list %] + [% thing.join(', ') %] + [% END %] + [% view.print(a_list) %] + +=item view_prefix + +Prefix of methods which should be mapped to view() by AUTOLOAD. Defaults +to 'view_'. + + [% USE view %] + [% view.view_header() %] # => view('header') + + [% USE view(view_prefix => 'show_me_the_' %] + [% view.show_me_the_header() %] # => view('header') + +=item view_naked + +Flag to indcate if any attempt should be made to map method names to +template names where they don't match the view_prefix. Defaults to 0. + + [% USE view(view_naked => 1) %] + + [% view.header() %] # => view('header') + +=back + +=head2 print( $obj1, $obj2, ... \%config) + +TODO + +=head2 view( $template, \%vars, \%config ); + +TODO + +=head1 AUTHOR + +Andy Wardley Eabw@kfs.orgE + +=head1 REVISION + +$Revision: 2.8 $ + +=head1 COPYRIGHT + +Copyright (C) 2000 Andy Wardley. All Rights Reserved. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L, + +=cut + + + + + diff --git a/lib/Text/Balanced.pm b/lib/Text/Balanced.pm new file mode 100644 index 0000000..aa09c3e --- /dev/null +++ b/lib/Text/Balanced.pm @@ -0,0 +1,2301 @@ +# EXTRACT VARIOUSLY DELIMITED TEXT SEQUENCES FROM STRINGS. +# FOR FULL DOCUMENTATION SEE Balanced.pod + +use 5.005; +use strict; + +package Text::Balanced; + +use Exporter; +use SelfLoader; +use vars qw { $VERSION @ISA %EXPORT_TAGS }; + +$VERSION = '1.90'; +@ISA = qw ( Exporter ); + +%EXPORT_TAGS = ( ALL => [ qw( + &extract_delimited + &extract_bracketed + &extract_quotelike + &extract_codeblock + &extract_variable + &extract_tagged + &extract_multiple + + &gen_delimited_pat + &gen_extract_tagged + + &delimited_pat + ) ] ); + +Exporter::export_ok_tags('ALL'); + +# PROTOTYPES + +sub _match_bracketed($$$$$$); +sub _match_variable($$); +sub _match_codeblock($$$$$$$); +sub _match_quotelike($$$$); + +# HANDLE RETURN VALUES IN VARIOUS CONTEXTS + +sub _failmsg { + my ($message, $pos) = @_; + $@ = bless { error=>$message, pos=>$pos }, "Text::Balanced::ErrorMsg"; +} + +sub _fail +{ + my ($wantarray, $textref, $message, $pos) = @_; + _failmsg $message, $pos if $message; + return ("",$$textref,"") if $wantarray; + return undef; +} + +sub _succeed +{ + $@ = undef; + my ($wantarray,$textref) = splice @_, 0, 2; + my ($extrapos, $extralen) = @_>18 ? splice(@_, -2, 2) : (0,0); + my ($startlen) = $_[5]; + my $remainderpos = $_[2]; + if ($wantarray) + { + my @res; + while (my ($from, $len) = splice @_, 0, 2) + { + push @res, substr($$textref,$from,$len); + } + if ($extralen) { # CORRECT FILLET + my $extra = substr($res[0], $extrapos-$startlen, $extralen, "\n"); + $res[1] = "$extra$res[1]"; + eval { substr($$textref,$remainderpos,0) = $extra; + substr($$textref,$extrapos,$extralen,"\n")} ; + #REARRANGE HERE DOC AND FILLET IF POSSIBLE + pos($$textref) = $remainderpos-$extralen+1; # RESET \G + } + else { + pos($$textref) = $remainderpos; # RESET \G + } + return @res; + } + else + { + my $match = substr($$textref,$_[0],$_[1]); + substr($match,$extrapos-$_[0]-$startlen,$extralen,"") if $extralen; + my $extra = $extralen + ? substr($$textref, $extrapos, $extralen)."\n" : ""; + eval {substr($$textref,$_[4],$_[1]+$_[5])=$extra} ; #CHOP OUT PREFIX & MATCH, IF POSSIBLE + pos($$textref) = $_[4]; # RESET \G + return $match; + } +} + +# BUILD A PATTERN MATCHING A SIMPLE DELIMITED STRING + +sub gen_delimited_pat($;$) # ($delimiters;$escapes) +{ + my ($dels, $escs) = @_; + return "" unless $dels =~ /\S/; + $escs = '\\' unless $escs; + $escs .= substr($escs,-1) x (length($dels)-length($escs)); + my @pat = (); + my $i; + for ($i=0; $i\0-\377/[[(({{</) + { + return _fail $wantarray, $textref, + "Did not find a suitable bracket in delimiter: \"$_[1]\"", + 0; + } + my $posbug = pos; + $ldel = join('|', map { quotemeta $_ } split('', $ldel)); + $rdel = join('|', map { quotemeta $_ } split('', $rdel)); + pos = $posbug; + + my $startpos = pos $$textref || 0; + my @match = _match_bracketed($textref,$pre, $ldel, $qdel, $quotelike, $rdel); + + return _fail ($wantarray, $textref) unless @match; + + return _succeed ( $wantarray, $textref, + $match[2], $match[5]+2, # MATCH + @match[8,9], # REMAINDER + @match[0,1], # PREFIX + ); +} + +sub _match_bracketed($$$$$$) # $textref, $pre, $ldel, $qdel, $quotelike, $rdel +{ + my ($textref, $pre, $ldel, $qdel, $quotelike, $rdel) = @_; + my ($startpos, $ldelpos, $endpos) = (pos $$textref = pos $$textref||0); + unless ($$textref =~ m/\G$pre/gc) + { + _failmsg "Did not find prefix: /$pre/", $startpos; + return; + } + + $ldelpos = pos $$textref; + + unless ($$textref =~ m/\G($ldel)/gc) + { + _failmsg "Did not find opening bracket after prefix: \"$pre\"", + pos $$textref; + pos $$textref = $startpos; + return; + } + + my @nesting = ( $1 ); + my $textlen = length $$textref; + while (pos $$textref < $textlen) + { + next if $$textref =~ m/\G\\./gcs; + + if ($$textref =~ m/\G($ldel)/gc) + { + push @nesting, $1; + } + elsif ($$textref =~ m/\G($rdel)/gc) + { + my ($found, $brackettype) = ($1, $1); + if ($#nesting < 0) + { + _failmsg "Unmatched closing bracket: \"$found\"", + pos $$textref; + pos $$textref = $startpos; + return; + } + my $expected = pop(@nesting); + $expected =~ tr/({[/; + if ($expected ne $brackettype) + { + _failmsg qq{Mismatched closing bracket: expected "$expected" but found "$found"}, + pos $$textref; + pos $$textref = $startpos; + return; + } + last if $#nesting < 0; + } + elsif ($qdel && $$textref =~ m/\G([$qdel])/gc) + { + $$textref =~ m/\G[^\\$1]*(?:\\.[^\\$1]*)*(\Q$1\E)/gsc and next; + _failmsg "Unmatched embedded quote ($1)", + pos $$textref; + pos $$textref = $startpos; + return; + } + elsif ($quotelike && _match_quotelike($textref,"",1,0)) + { + next; + } + + else { $$textref =~ m/\G(?:[a-zA-Z0-9]+|.)/gcs } + } + if ($#nesting>=0) + { + _failmsg "Unmatched opening bracket(s): " + . join("..",@nesting)."..", + pos $$textref; + pos $$textref = $startpos; + return; + } + + $endpos = pos $$textref; + + return ( + $startpos, $ldelpos-$startpos, # PREFIX + $ldelpos, 1, # OPENING BRACKET + $ldelpos+1, $endpos-$ldelpos-2, # CONTENTS + $endpos-1, 1, # CLOSING BRACKET + $endpos, length($$textref)-$endpos, # REMAINDER + ); +} + +sub revbracket($) +{ + my $brack = reverse $_[0]; + $brack =~ tr/[({/; + return $brack; +} + +my $XMLNAME = q{[a-zA-Z_:][a-zA-Z0-9_:.-]*}; + +sub extract_tagged (;$$$$$) # ($text, $opentag, $closetag, $pre, \%options) +{ + my $textref = defined $_[0] ? \$_[0] : \$_; + my $ldel = $_[1]; + my $rdel = $_[2]; + my $pre = defined $_[3] ? $_[3] : '\s*'; + my %options = defined $_[4] ? %{$_[4]} : (); + my $omode = defined $options{fail} ? $options{fail} : ''; + my $bad = ref($options{reject}) eq 'ARRAY' ? join('|', @{$options{reject}}) + : defined($options{reject}) ? $options{reject} + : '' + ; + my $ignore = ref($options{ignore}) eq 'ARRAY' ? join('|', @{$options{ignore}}) + : defined($options{ignore}) ? $options{ignore} + : '' + ; + + if (!defined $ldel) { $ldel = '<\w+(?:' . gen_delimited_pat(q{'"}) . '|[^>])*>'; } + $@ = undef; + + my @match = _match_tagged($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore); + + return _fail(wantarray, $textref) unless @match; + return _succeed wantarray, $textref, + $match[2], $match[3]+$match[5]+$match[7], # MATCH + @match[8..9,0..1,2..7]; # REM, PRE, BITS +} + +sub _match_tagged # ($$$$$$$) +{ + my ($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore) = @_; + my $rdelspec; + + my ($startpos, $opentagpos, $textpos, $parapos, $closetagpos, $endpos) = ( pos($$textref) = pos($$textref)||0 ); + + unless ($$textref =~ m/\G($pre)/gc) + { + _failmsg "Did not find prefix: /$pre/", pos $$textref; + goto failed; + } + + $opentagpos = pos($$textref); + + unless ($$textref =~ m/\G$ldel/gc) + { + _failmsg "Did not find opening tag: /$ldel/", pos $$textref; + goto failed; + } + + $textpos = pos($$textref); + + if (!defined $rdel) + { + $rdelspec = $&; + unless ($rdelspec =~ s/\A([[(<{]+)($XMLNAME).*/ quotemeta "$1\/$2". revbracket($1) /oes) + { + _failmsg "Unable to construct closing tag to match: $rdel", + pos $$textref; + goto failed; + } + } + else + { + $rdelspec = eval "qq{$rdel}" || do { + my $del; + for (qw,~ ! ^ & * ) _ + - = } ] : " ; ' > . ? / | ',) + { next if $rdel =~ /\Q$_/; $del = $_; last } + unless ($del) { + use Carp; + croak "Can't interpolate right delimiter $rdel" + } + eval "qq$del$rdel$del"; + }; + } + + while (pos($$textref) < length($$textref)) + { + next if $$textref =~ m/\G\\./gc; + + if ($$textref =~ m/\G(\n[ \t]*\n)/gc ) + { + $parapos = pos($$textref) - length($1) + unless defined $parapos; + } + elsif ($$textref =~ m/\G($rdelspec)/gc ) + { + $closetagpos = pos($$textref)-length($1); + goto matched; + } + elsif ($ignore && $$textref =~ m/\G(?:$ignore)/gc) + { + next; + } + elsif ($bad && $$textref =~ m/\G($bad)/gcs) + { + pos($$textref) -= length($1); # CUT OFF WHATEVER CAUSED THE SHORTNESS + goto short if ($omode eq 'PARA' || $omode eq 'MAX'); + _failmsg "Found invalid nested tag: $1", pos $$textref; + goto failed; + } + elsif ($$textref =~ m/\G($ldel)/gc) + { + my $tag = $1; + pos($$textref) -= length($tag); # REWIND TO NESTED TAG + unless (_match_tagged(@_)) # MATCH NESTED TAG + { + goto short if $omode eq 'PARA' || $omode eq 'MAX'; + _failmsg "Found unbalanced nested tag: $tag", + pos $$textref; + goto failed; + } + } + else { $$textref =~ m/./gcs } + } + +short: + $closetagpos = pos($$textref); + goto matched if $omode eq 'MAX'; + goto failed unless $omode eq 'PARA'; + + if (defined $parapos) { pos($$textref) = $parapos } + else { $parapos = pos($$textref) } + + return ( + $startpos, $opentagpos-$startpos, # PREFIX + $opentagpos, $textpos-$opentagpos, # OPENING TAG + $textpos, $parapos-$textpos, # TEXT + $parapos, 0, # NO CLOSING TAG + $parapos, length($$textref)-$parapos, # REMAINDER + ); + +matched: + $endpos = pos($$textref); + return ( + $startpos, $opentagpos-$startpos, # PREFIX + $opentagpos, $textpos-$opentagpos, # OPENING TAG + $textpos, $closetagpos-$textpos, # TEXT + $closetagpos, $endpos-$closetagpos, # CLOSING TAG + $endpos, length($$textref)-$endpos, # REMAINDER + ); + +failed: + _failmsg "Did not find closing tag", pos $$textref unless $@; + pos($$textref) = $startpos; + return; +} + +sub extract_variable (;$$) +{ + my $textref = defined $_[0] ? \$_[0] : \$_; + return ("","","") unless defined $$textref; + my $pre = defined $_[1] ? $_[1] : '\s*'; + + my @match = _match_variable($textref,$pre); + + return _fail wantarray, $textref unless @match; + + return _succeed wantarray, $textref, + @match[2..3,4..5,0..1]; # MATCH, REMAINDER, PREFIX +} + +sub _match_variable($$) +{ +# $# +# $^ +# $$ + my ($textref, $pre) = @_; + my $startpos = pos($$textref) = pos($$textref)||0; + unless ($$textref =~ m/\G($pre)/gc) + { + _failmsg "Did not find prefix: /$pre/", pos $$textref; + return; + } + my $varpos = pos($$textref); + unless ($$textref =~ m{\G\$\s*(?!::)(\d+|[][&`'+*./|,";%=~:?!\@<>()-]|\^[a-z]?)}gci) + { + unless ($$textref =~ m/\G((\$#?|[*\@\%]|\\&)+)/gc) + { + _failmsg "Did not find leading dereferencer", pos $$textref; + pos $$textref = $startpos; + return; + } + my $deref = $1; + + unless ($$textref =~ m/\G\s*(?:::|')?(?:[_a-z]\w*(?:::|'))*[_a-z]\w*/gci + or _match_codeblock($textref, "", '\{', '\}', '\{', '\}', 0) + or $deref eq '$#' or $deref eq '$$' ) + { + _failmsg "Bad identifier after dereferencer", pos $$textref; + pos $$textref = $startpos; + return; + } + } + + while (1) + { + next if $$textref =~ m/\G\s*(?:->)?\s*[{]\w+[}]/gc; + next if _match_codeblock($textref, + qr/\s*->\s*(?:[_a-zA-Z]\w+\s*)?/, + qr/[({[]/, qr/[)}\]]/, + qr/[({[]/, qr/[)}\]]/, 0); + next if _match_codeblock($textref, + qr/\s*/, qr/[{[]/, qr/[}\]]/, + qr/[{[]/, qr/[}\]]/, 0); + next if _match_variable($textref,'\s*->\s*'); + next if $$textref =~ m/\G\s*->\s*\w+(?![{([])/gc; + last; + } + + my $endpos = pos($$textref); + return ($startpos, $varpos-$startpos, + $varpos, $endpos-$varpos, + $endpos, length($$textref)-$endpos + ); +} + +sub extract_codeblock (;$$$$$) +{ + my $textref = defined $_[0] ? \$_[0] : \$_; + my $wantarray = wantarray; + my $ldel_inner = defined $_[1] ? $_[1] : '{'; + my $pre = defined $_[2] ? $_[2] : '\s*'; + my $ldel_outer = defined $_[3] ? $_[3] : $ldel_inner; + my $rd = $_[4]; + my $rdel_inner = $ldel_inner; + my $rdel_outer = $ldel_outer; + my $posbug = pos; + for ($ldel_inner, $ldel_outer) { tr/[]()<>{}\0-\377/[[((<<{{/ds } + for ($rdel_inner, $rdel_outer) { tr/[]()<>{}\0-\377/]]))>>}}/ds } + for ($ldel_inner, $ldel_outer, $rdel_inner, $rdel_outer) + { + $_ = '('.join('|',map { quotemeta $_ } split('',$_)).')' + } + pos = $posbug; + + my @match = _match_codeblock($textref, $pre, + $ldel_outer, $rdel_outer, + $ldel_inner, $rdel_inner, + $rd); + return _fail($wantarray, $textref) unless @match; + return _succeed($wantarray, $textref, + @match[2..3,4..5,0..1] # MATCH, REMAINDER, PREFIX + ); + +} + +sub _match_codeblock($$$$$$$) +{ + my ($textref, $pre, $ldel_outer, $rdel_outer, $ldel_inner, $rdel_inner, $rd) = @_; + my $startpos = pos($$textref) = pos($$textref) || 0; + unless ($$textref =~ m/\G($pre)/gc) + { + _failmsg qq{Did not match prefix /$pre/ at"} . + substr($$textref,pos($$textref),20) . + q{..."}, + pos $$textref; + return; + } + my $codepos = pos($$textref); + unless ($$textref =~ m/\G($ldel_outer)/gc) # OUTERMOST DELIMITER + { + _failmsg qq{Did not find expected opening bracket at "} . + substr($$textref,pos($$textref),20) . + q{..."}, + pos $$textref; + pos $$textref = $startpos; + return; + } + my $closing = $1; + $closing =~ tr/([<{/)]>}/; + my $matched; + my $patvalid = 1; + while (pos($$textref) < length($$textref)) + { + $matched = ''; + if ($rd && $$textref =~ m#\G(\Q(?)\E|\Q(s?)\E|\Q(s)\E)#gc) + { + $patvalid = 0; + next; + } + + if ($$textref =~ m/\G\s*#.*/gc) + { + next; + } + + if ($$textref =~ m/\G\s*($rdel_outer)/gc) + { + unless ($matched = ($closing && $1 eq $closing) ) + { + next if $1 eq '>'; # MIGHT BE A "LESS THAN" + _failmsg q{Mismatched closing bracket at "} . + substr($$textref,pos($$textref),20) . + qq{...". Expected '$closing'}, + pos $$textref; + } + last; + } + + if (_match_variable($textref,'\s*') || + _match_quotelike($textref,'\s*',$patvalid,$patvalid) ) + { + $patvalid = 0; + next; + } + + + # NEED TO COVER MANY MORE CASES HERE!!! + if ($$textref =~ m#\G\s*( [-+*x/%^&|.]=? + | [!=]~ + | =(?!>) + | (\*\*|&&|\|\||<<|>>)=? + | split|grep|map|return + | [([] + )#gcx) + { + $patvalid = 1; + next; + } + + if ( _match_codeblock($textref, '\s*', $ldel_inner, $rdel_inner, $ldel_inner, $rdel_inner, $rd) ) + { + $patvalid = 1; + next; + } + + if ($$textref =~ m/\G\s*$ldel_outer/gc) + { + _failmsg q{Improperly nested codeblock at "} . + substr($$textref,pos($$textref),20) . + q{..."}, + pos $$textref; + last; + } + + $patvalid = 0; + $$textref =~ m/\G\s*(\w+|[-=>]>|.|\Z)/gc; + } + continue { $@ = undef } + + unless ($matched) + { + _failmsg 'No match found for opening bracket', pos $$textref + unless $@; + return; + } + + my $endpos = pos($$textref); + return ( $startpos, $codepos-$startpos, + $codepos, $endpos-$codepos, + $endpos, length($$textref)-$endpos, + ); +} + + +my %mods = ( + 'none' => '[cgimsox]*', + 'm' => '[cgimsox]*', + 's' => '[cegimsox]*', + 'tr' => '[cds]*', + 'y' => '[cds]*', + 'qq' => '', + 'qx' => '', + 'qw' => '', + 'qr' => '[imsx]*', + 'q' => '', + ); + +sub extract_quotelike (;$$) +{ + my $textref = $_[0] ? \$_[0] : \$_; + my $wantarray = wantarray; + my $pre = defined $_[1] ? $_[1] : '\s*'; + + my @match = _match_quotelike($textref,$pre,1,0); + return _fail($wantarray, $textref) unless @match; + return _succeed($wantarray, $textref, + $match[2], $match[18]-$match[2], # MATCH + @match[18,19], # REMAINDER + @match[0,1], # PREFIX + @match[2..17], # THE BITS + @match[20,21], # ANY FILLET? + ); +}; + +sub _match_quotelike($$$$) # ($textref, $prepat, $allow_raw_match) +{ + my ($textref, $pre, $rawmatch, $qmark) = @_; + + my ($textlen,$startpos, + $oppos, + $preld1pos,$ld1pos,$str1pos,$rd1pos, + $preld2pos,$ld2pos,$str2pos,$rd2pos, + $modpos) = ( length($$textref), pos($$textref) = pos($$textref) || 0 ); + + unless ($$textref =~ m/\G($pre)/gc) + { + _failmsg qq{Did not find prefix /$pre/ at "} . + substr($$textref, pos($$textref), 20) . + q{..."}, + pos $$textref; + return; + } + $oppos = pos($$textref); + + my $initial = substr($$textref,$oppos,1); + + if ($initial && $initial =~ m|^[\"\'\`]| + || $rawmatch && $initial =~ m|^/| + || $qmark && $initial =~ m|^\?|) + { + unless ($$textref =~ m/ \Q$initial\E [^\\$initial]* (\\.[^\\$initial]*)* \Q$initial\E /gcsx) + { + _failmsg qq{Did not find closing delimiter to match '$initial' at "} . + substr($$textref, $oppos, 20) . + q{..."}, + pos $$textref; + pos $$textref = $startpos; + return; + } + $modpos= pos($$textref); + $rd1pos = $modpos-1; + + if ($initial eq '/' || $initial eq '?') + { + $$textref =~ m/\G$mods{none}/gc + } + + my $endpos = pos($$textref); + return ( + $startpos, $oppos-$startpos, # PREFIX + $oppos, 0, # NO OPERATOR + $oppos, 1, # LEFT DEL + $oppos+1, $rd1pos-$oppos-1, # STR/PAT + $rd1pos, 1, # RIGHT DEL + $modpos, 0, # NO 2ND LDEL + $modpos, 0, # NO 2ND STR + $modpos, 0, # NO 2ND RDEL + $modpos, $endpos-$modpos, # MODIFIERS + $endpos, $textlen-$endpos, # REMAINDER + ); + } + + unless ($$textref =~ m{\G((?:m|s|qq|qx|qw|q|qr|tr|y)\b(?=\s*\S)|<<)}gc) + { + _failmsg q{No quotelike operator found after prefix at "} . + substr($$textref, pos($$textref), 20) . + q{..."}, + pos $$textref; + pos $$textref = $startpos; + return; + } + + my $op = $1; + $preld1pos = pos($$textref); + if ($op eq '<<') { + $ld1pos = pos($$textref); + my $label; + if ($$textref =~ m{\G([A-Za-z_]\w*)}gc) { + $label = $1; + } + elsif ($$textref =~ m{ \G ' ([^'\\]* (?:\\.[^'\\]*)*) ' + | \G " ([^"\\]* (?:\\.[^"\\]*)*) " + | \G ` ([^`\\]* (?:\\.[^`\\]*)*) ` + }gcsx) { + $label = $+; + } + else { + $label = ""; + } + my $extrapos = pos($$textref); + $$textref =~ m{.*\n}gc; + $str1pos = pos($$textref); + unless ($$textref =~ m{.*?\n(?=$label\n)}gc) { + _failmsg qq{Missing here doc terminator ('$label') after "} . + substr($$textref, $startpos, 20) . + q{..."}, + pos $$textref; + pos $$textref = $startpos; + return; + } + $rd1pos = pos($$textref); + $$textref =~ m{$label\n}gc; + $ld2pos = pos($$textref); + return ( + $startpos, $oppos-$startpos, # PREFIX + $oppos, length($op), # OPERATOR + $ld1pos, $extrapos-$ld1pos, # LEFT DEL + $str1pos, $rd1pos-$str1pos, # STR/PAT + $rd1pos, $ld2pos-$rd1pos, # RIGHT DEL + $ld2pos, 0, # NO 2ND LDEL + $ld2pos, 0, # NO 2ND STR + $ld2pos, 0, # NO 2ND RDEL + $ld2pos, 0, # NO MODIFIERS + $ld2pos, $textlen-$ld2pos, # REMAINDER + $extrapos, $str1pos-$extrapos, # FILLETED BIT + ); + } + + $$textref =~ m/\G\s*/gc; + $ld1pos = pos($$textref); + $str1pos = $ld1pos+1; + + unless ($$textref =~ m/\G(\S)/gc) # SHOULD USE LOOKAHEAD + { + _failmsg "No block delimiter found after quotelike $op", + pos $$textref; + pos $$textref = $startpos; + return; + } + pos($$textref) = $ld1pos; # HAVE TO DO THIS BECAUSE LOOKAHEAD BROKEN + my ($ldel1, $rdel1) = ("\Q$1","\Q$1"); + if ($ldel1 =~ /[[(<{]/) + { + $rdel1 =~ tr/[({/; + _match_bracketed($textref,"",$ldel1,"","",$rdel1) + || do { pos $$textref = $startpos; return }; + } + else + { + $$textref =~ /$ldel1[^\\$ldel1]*(\\.[^\\$ldel1]*)*$ldel1/gcs + || do { pos $$textref = $startpos; return }; + } + $ld2pos = $rd1pos = pos($$textref)-1; + + my $second_arg = $op =~ /s|tr|y/ ? 1 : 0; + if ($second_arg) + { + my ($ldel2, $rdel2); + if ($ldel1 =~ /[[(<{]/) + { + unless ($$textref =~ /\G\s*(\S)/gc) # SHOULD USE LOOKAHEAD + { + _failmsg "Missing second block for quotelike $op", + pos $$textref; + pos $$textref = $startpos; + return; + } + $ldel2 = $rdel2 = "\Q$1"; + $rdel2 =~ tr/[({/; + } + else + { + $ldel2 = $rdel2 = $ldel1; + } + $str2pos = $ld2pos+1; + + if ($ldel2 =~ /[[(<{]/) + { + pos($$textref)--; # OVERCOME BROKEN LOOKAHEAD + _match_bracketed($textref,"",$ldel2,"","",$rdel2) + || do { pos $$textref = $startpos; return }; + } + else + { + $$textref =~ /[^\\$ldel2]*(\\.[^\\$ldel2]*)*$ldel2/gcs + || do { pos $$textref = $startpos; return }; + } + $rd2pos = pos($$textref)-1; + } + else + { + $ld2pos = $str2pos = $rd2pos = $rd1pos; + } + + $modpos = pos $$textref; + + $$textref =~ m/\G($mods{$op})/gc; + my $endpos = pos $$textref; + + return ( + $startpos, $oppos-$startpos, # PREFIX + $oppos, length($op), # OPERATOR + $ld1pos, 1, # LEFT DEL + $str1pos, $rd1pos-$str1pos, # STR/PAT + $rd1pos, 1, # RIGHT DEL + $ld2pos, $second_arg, # 2ND LDEL (MAYBE) + $str2pos, $rd2pos-$str2pos, # 2ND STR (MAYBE) + $rd2pos, $second_arg, # 2ND RDEL (MAYBE) + $modpos, $endpos-$modpos, # MODIFIERS + $endpos, $textlen-$endpos, # REMAINDER + ); +} + +my $def_func = +[ + sub { extract_variable($_[0], '') }, + sub { extract_quotelike($_[0],'') }, + sub { extract_codeblock($_[0],'{}','') }, +]; + +sub extract_multiple (;$$$$) # ($text, $functions_ref, $max_fields, $ignoreunknown) +{ + my $textref = defined($_[0]) ? \$_[0] : \$_; + my $posbug = pos; + my ($lastpos, $firstpos); + my @fields = (); + + #for ($$textref) + { + my @func = defined $_[1] ? @{$_[1]} : @{$def_func}; + my $max = defined $_[2] && $_[2]>0 ? $_[2] : 1_000_000_000; + my $igunk = $_[3]; + + pos $$textref ||= 0; + + unless (wantarray) + { + use Carp; + carp "extract_multiple reset maximal count to 1 in scalar context" + if $^W && defined($_[2]) && $max > 1; + $max = 1 + } + + my $unkpos; + my $func; + my $class; + + my @class; + foreach $func ( @func ) + { + if (ref($func) eq 'HASH') + { + push @class, (keys %$func)[0]; + $func = (values %$func)[0]; + } + else + { + push @class, undef; + } + } + + FIELD: while (pos($$textref) < length($$textref)) + { + my ($field, $rem); + my @bits; + foreach my $i ( 0..$#func ) + { + my $pref; + $func = $func[$i]; + $class = $class[$i]; + $lastpos = pos $$textref; + if (ref($func) eq 'CODE') + { ($field,$rem,$pref) = @bits = $func->($$textref); + # print "[$field|$rem]" if $field; + } + elsif (ref($func) eq 'Text::Balanced::Extractor') + { @bits = $field = $func->extract($$textref) } + elsif( $$textref =~ m/\G$func/gc ) + { @bits = $field = defined($1) ? $1 : $& } + $pref ||= ""; + if (defined($field) && length($field)) + { + if (!$igunk) { + $unkpos = pos $$textref + if length($pref) && !defined($unkpos); + if (defined $unkpos) + { + push @fields, substr($$textref, $unkpos, $lastpos-$unkpos).$pref; + $firstpos = $unkpos unless defined $firstpos; + undef $unkpos; + last FIELD if @fields == $max; + } + } + push @fields, $class + ? bless (\$field, $class) + : $field; + $firstpos = $lastpos unless defined $firstpos; + $lastpos = pos $$textref; + last FIELD if @fields == $max; + next FIELD; + } + } + if ($$textref =~ /\G(.)/gcs) + { + $unkpos = pos($$textref)-1 + unless $igunk || defined $unkpos; + } + } + + if (defined $unkpos) + { + push @fields, substr($$textref, $unkpos); + $firstpos = $unkpos unless defined $firstpos; + $lastpos = length $$textref; + } + last; + } + + pos $$textref = $lastpos; + return @fields if wantarray; + + $firstpos ||= 0; + eval { substr($$textref,$firstpos,$lastpos-$firstpos)=""; + pos $$textref = $firstpos }; + return $fields[0]; +} + + +sub gen_extract_tagged # ($opentag, $closetag, $pre, \%options) +{ + my $ldel = $_[0]; + my $rdel = $_[1]; + my $pre = defined $_[2] ? $_[2] : '\s*'; + my %options = defined $_[3] ? %{$_[3]} : (); + my $omode = defined $options{fail} ? $options{fail} : ''; + my $bad = ref($options{reject}) eq 'ARRAY' ? join('|', @{$options{reject}}) + : defined($options{reject}) ? $options{reject} + : '' + ; + my $ignore = ref($options{ignore}) eq 'ARRAY' ? join('|', @{$options{ignore}}) + : defined($options{ignore}) ? $options{ignore} + : '' + ; + + if (!defined $ldel) { $ldel = '<\w+(?:' . gen_delimited_pat(q{'"}) . '|[^>])*>'; } + + my $posbug = pos; + for ($ldel, $pre, $bad, $ignore) { $_ = qr/$_/ if $_ } + pos = $posbug; + + my $closure = sub + { + my $textref = defined $_[0] ? \$_[0] : \$_; + my @match = Text::Balanced::_match_tagged($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore); + + return _fail(wantarray, $textref) unless @match; + return _succeed wantarray, $textref, + $match[2], $match[3]+$match[5]+$match[7], # MATCH + @match[8..9,0..1,2..7]; # REM, PRE, BITS + }; + + bless $closure, 'Text::Balanced::Extractor'; +} + +package Text::Balanced::Extractor; + +sub extract($$) # ($self, $text) +{ + &{$_[0]}($_[1]); +} + +package Text::Balanced::ErrorMsg; + +use overload '""' => sub { "$_[0]->{error}, detected at offset $_[0]->{pos}" }; + +1; + +__END__ + +=head1 NAME + +Text::Balanced - Extract delimited text sequences from strings. + + +=head1 SYNOPSIS + + use Text::Balanced qw ( + extract_delimited + extract_bracketed + extract_quotelike + extract_codeblock + extract_variable + extract_tagged + extract_multiple + + gen_delimited_pat + gen_extract_tagged + ); + + # Extract the initial substring of $text that is delimited by + # two (unescaped) instances of the first character in $delim. + + ($extracted, $remainder) = extract_delimited($text,$delim); + + + # Extract the initial substring of $text that is bracketed + # with a delimiter(s) specified by $delim (where the string + # in $delim contains one or more of '(){}[]<>'). + + ($extracted, $remainder) = extract_bracketed($text,$delim); + + + # Extract the initial substring of $text that is bounded by + # an XML tag. + + ($extracted, $remainder) = extract_tagged($text); + + + # Extract the initial substring of $text that is bounded by + # a C...C pair. Don't allow nested C tags + + ($extracted, $remainder) = + extract_tagged($text,"BEGIN","END",undef,{bad=>["BEGIN"]}); + + + # Extract the initial substring of $text that represents a + # Perl "quote or quote-like operation" + + ($extracted, $remainder) = extract_quotelike($text); + + + # Extract the initial substring of $text that represents a block + # of Perl code, bracketed by any of character(s) specified by $delim + # (where the string $delim contains one or more of '(){}[]<>'). + + ($extracted, $remainder) = extract_codeblock($text,$delim); + + + # Extract the initial substrings of $text that would be extracted by + # one or more sequential applications of the specified functions + # or regular expressions + + @extracted = extract_multiple($text, + [ \&extract_bracketed, + \&extract_quotelike, + \&some_other_extractor_sub, + qr/[xyz]*/, + 'literal', + ]); + +# Create a string representing an optimized pattern (a la Friedl) +# that matches a substring delimited by any of the specified characters +# (in this case: any type of quote or a slash) + + $patstring = gen_delimited_pat(q{'"`/}); + + +# Generate a reference to an anonymous sub that is just like extract_tagged +# but pre-compiled and optimized for a specific pair of tags, and consequently +# much faster (i.e. 3 times faster). It uses qr// for better performance on +# repeated calls, so it only works under Perl 5.005 or later. + + $extract_head = gen_extract_tagged('',''); + + ($extracted, $remainder) = $extract_head->($text); + + +=head1 DESCRIPTION + +The various C subroutines may be used to +extract a delimited substring, possibly after skipping a +specified prefix string. By default, that prefix is +optional whitespace (C), but you can change it to whatever +you wish (see below). + +The substring to be extracted must appear at the +current C location of the string's variable +(or at index zero, if no C position is defined). +In other words, the C subroutines I +extract the first occurance of a substring anywhere +in a string (like an unanchored regex would). Rather, +they extract an occurance of the substring appearing +immediately at the current matching position in the +string (like a C<\G>-anchored regex would). + + + +=head2 General behaviour in list contexts + +In a list context, all the subroutines return a list, the first three +elements of which are always: + +=over 4 + +=item [0] + +The extracted string, including the specified delimiters. +If the extraction fails an empty string is returned. + +=item [1] + +The remainder of the input string (i.e. the characters after the +extracted string). On failure, the entire string is returned. + +=item [2] + +The skipped prefix (i.e. the characters before the extracted string). +On failure, the empty string is returned. + +=back + +Note that in a list context, the contents of the original input text (the first +argument) are not modified in any way. + +However, if the input text was passed in a variable, that variable's +C value is updated to point at the first character after the +extracted text. That means that in a list context the various +subroutines can be used much like regular expressions. For example: + + while ( $next = (extract_quotelike($text))[0] ) + { + # process next quote-like (in $next) + } + + +=head2 General behaviour in scalar and void contexts + +In a scalar context, the extracted string is returned, having first been +removed from the input text. Thus, the following code also processes +each quote-like operation, but actually removes them from $text: + + while ( $next = extract_quotelike($text) ) + { + # process next quote-like (in $next) + } + +Note that if the input text is a read-only string (i.e. a literal), +no attempt is made to remove the extracted text. + +In a void context the behaviour of the extraction subroutines is +exactly the same as in a scalar context, except (of course) that the +extracted substring is not returned. + +=head2 A note about prefixes + +Prefix patterns are matched without any trailing modifiers (C etc.) +This can bite you if you're expecting a prefix specification like +'.*?(?=

)' to skip everything up to the first

tag. Such a prefix +pattern will only succeed if the

tag is on the current line, since +. normally doesn't match newlines. + +To overcome this limitation, you need to turn on /s matching within +the prefix pattern, using the C<(?s)> directive: '(?s).*?(?=

)' + + +=head2 C + +The C function formalizes the common idiom +of extracting a single-character-delimited substring from the start of +a string. For example, to extract a single-quote delimited string, the +following code is typically used: + + ($remainder = $text) =~ s/\A('(\\.|[^'])*')//s; + $extracted = $1; + +but with C it can be simplified to: + + ($extracted,$remainder) = extract_delimited($text, "'"); + +C takes up to four scalars (the input text, the +delimiters, a prefix pattern to be skipped, and any escape characters) +and extracts the initial substring of the text that +is appropriately delimited. If the delimiter string has multiple +characters, the first one encountered in the text is taken to delimit +the substring. +The third argument specifies a prefix pattern that is to be skipped +(but must be present!) before the substring is extracted. +The final argument specifies the escape character to be used for each +delimiter. + +All arguments are optional. If the escape characters are not specified, +every delimiter is escaped with a backslash (C<\>). +If the prefix is not specified, the +pattern C<'\s*'> - optional whitespace - is used. If the delimiter set +is also not specified, the set C is used. If the text to be processed +is not specified either, C<$_> is used. + +In list context, C returns a array of three +elements, the extracted substring (I), the remainder of the text, and the skipped prefix (if +any). If a suitable delimited substring is not found, the first +element of the array is the empty string, the second is the complete +original text, and the prefix returned in the third element is an +empty string. + +In a scalar context, just the extracted substring is returned. In +a void context, the extracted substring (and any prefix) are simply +removed from the beginning of the first argument. + +Examples: + + # Remove a single-quoted substring from the very beginning of $text: + + $substring = extract_delimited($text, "'", ''); + + # Remove a single-quoted Pascalish substring (i.e. one in which + # doubling the quote character escapes it) from the very + # beginning of $text: + + $substring = extract_delimited($text, "'", '', "'"); + + # Extract a single- or double- quoted substring from the + # beginning of $text, optionally after some whitespace + # (note the list context to protect $text from modification): + + ($substring) = extract_delimited $text, q{"'}; + + + # Delete the substring delimited by the first '/' in $text: + + $text = join '', (extract_delimited($text,'/','[^/]*')[2,1]; + +Note that this last example is I the same as deleting the first +quote-like pattern. For instance, if C<$text> contained the string: + + "if ('./cmd' =~ m/$UNIXCMD/s) { $cmd = $1; }" + +then after the deletion it would contain: + + "if ('.$UNIXCMD/s) { $cmd = $1; }" + +not: + + "if ('./cmd' =~ ms) { $cmd = $1; }" + + +See L<"extract_quotelike"> for a (partial) solution to this problem. + + +=head2 C + +Like C<"extract_delimited">, the C function takes +up to three optional scalar arguments: a string to extract from, a delimiter +specifier, and a prefix pattern. As before, a missing prefix defaults to +optional whitespace and a missing text defaults to C<$_>. However, a missing +delimiter specifier defaults to C<'{}()[]EE'> (see below). + +C extracts a balanced-bracket-delimited +substring (using any one (or more) of the user-specified delimiter +brackets: '(..)', '{..}', '[..]', or '<..>'). Optionally it will also +respect quoted unbalanced brackets (see below). + +A "delimiter bracket" is a bracket in list of delimiters passed as +C's second argument. Delimiter brackets are +specified by giving either the left or right (or both!) versions +of the required bracket(s). Note that the order in which +two or more delimiter brackets are specified is not significant. + +A "balanced-bracket-delimited substring" is a substring bounded by +matched brackets, such that any other (left or right) delimiter +bracket I the substring is also matched by an opposite +(right or left) delimiter bracket I. Any +type of bracket not in the delimiter list is treated as an ordinary +character. + +In other words, each type of bracket specified as a delimiter must be +balanced and correctly nested within the substring, and any other kind of +("non-delimiter") bracket in the substring is ignored. + +For example, given the string: + + $text = "{ an '[irregularly :-(] {} parenthesized >:-)' string }"; + +then a call to C in a list context: + + @result = extract_bracketed( $text, '{}' ); + +would return: + + ( "{ an '[irregularly :-(] {} parenthesized >:-)' string }" , "" , "" ) + +since both sets of C<'{..}'> brackets are properly nested and evenly balanced. +(In a scalar context just the first element of the array would be returned. In +a void context, C<$text> would be replaced by an empty string.) + +Likewise the call in: + + @result = extract_bracketed( $text, '{[' ); + +would return the same result, since all sets of both types of specified +delimiter brackets are correctly nested and balanced. + +However, the call in: + + @result = extract_bracketed( $text, '{([<' ); + +would fail, returning: + + ( undef , "{ an '[irregularly :-(] {} parenthesized >:-)' string }" ); + +because the embedded pairs of C<'(..)'>s and C<'[..]'>s are "cross-nested" and +the embedded C<'E'> is unbalanced. (In a scalar context, this call would +return an empty string. In a void context, C<$text> would be unchanged.) + +Note that the embedded single-quotes in the string don't help in this +case, since they have not been specified as acceptable delimiters and are +therefore treated as non-delimiter characters (and ignored). + +However, if a particular species of quote character is included in the +delimiter specification, then that type of quote will be correctly handled. +for example, if C<$text> is: + + $text = 'link'; + +then + + @result = extract_bracketed( $text, '<">' ); + +returns: + + ( '', 'link', "" ) + +as expected. Without the specification of C<"> as an embedded quoter: + + @result = extract_bracketed( $text, '<>' ); + +the result would be: + + ( 'link', "" ) + +In addition to the quote delimiters C<'>, C<">, and C<`>, full Perl quote-like +quoting (i.e. q{string}, qq{string}, etc) can be specified by including the +letter 'q' as a delimiter. Hence: + + @result = extract_bracketed( $text, '' ); + +would correctly match something like this: + + $text = ''; + +See also: C<"extract_quotelike"> and C<"extract_codeblock">. + + +=head2 C + +C extracts any valid Perl variable or +variable-involved expression, including scalars, arrays, hashes, array +accesses, hash look-ups, method calls through objects, subroutine calles +through subroutine references, etc. + +The subroutine takes up to two optional arguments: + +=over 4 + +=item 1. + +A string to be processed (C<$_> if the string is omitted or C) + +=item 2. + +A string specifying a pattern to be matched as a prefix (which is to be +skipped). If omitted, optional whitespace is skipped. + +=back + +On success in a list context, an array of 3 elements is returned. The +elements are: + +=over 4 + +=item [0] + +the extracted variable, or variablish expression + +=item [1] + +the remainder of the input text, + +=item [2] + +the prefix substring (if any), + +=back + +On failure, all of these values (except the remaining text) are C. + +In a scalar context, C returns just the complete +substring that matched a variablish expression. C is returned on +failure. In addition, the original input text has the returned substring +(and any prefix) removed from it. + +In a void context, the input text just has the matched substring (and +any specified prefix) removed. + + +=head2 C + +C extracts and segments text between (balanced) +specified tags. + +The subroutine takes up to five optional arguments: + +=over 4 + +=item 1. + +A string to be processed (C<$_> if the string is omitted or C) + +=item 2. + +A string specifying a pattern to be matched as the opening tag. +If the pattern string is omitted (or C) then a pattern +that matches any standard XML tag is used. + +=item 3. + +A string specifying a pattern to be matched at the closing tag. +If the pattern string is omitted (or C) then the closing +tag is constructed by inserting a C after any leading bracket +characters in the actual opening tag that was matched (I the pattern +that matched the tag). For example, if the opening tag pattern +is specified as C<'{{\w+}}'> and actually matched the opening tag +C<"{{DATA}}">, then the constructed closing tag would be C<"{{/DATA}}">. + +=item 4. + +A string specifying a pattern to be matched as a prefix (which is to be +skipped). If omitted, optional whitespace is skipped. + +=item 5. + +A hash reference containing various parsing options (see below) + +=back + +The various options that can be specified are: + +=over 4 + +=item C $listref> + +The list reference contains one or more strings specifying patterns +that must I appear within the tagged text. + +For example, to extract +an HTML link (which should not contain nested links) use: + + extract_tagged($text, '', '', undef, {reject => ['']} ); + +=item C $listref> + +The list reference contains one or more strings specifying patterns +that are I be be treated as nested tags within the tagged text +(even if they would match the start tag pattern). + +For example, to extract an arbitrary XML tag, but ignore "empty" elements: + + extract_tagged($text, undef, undef, undef, {ignore => ['<[^>]*/>']} ); + +(also see L<"gen_delimited_pat"> below). + + +=item C $str> + +The C option indicates the action to be taken if a matching end +tag is not encountered (i.e. before the end of the string or some +C pattern matches). By default, a failure to match a closing +tag causes C to immediately fail. + +However, if the string value associated with is "MAX", then +C returns the complete text up to the point of failure. +If the string is "PARA", C returns only the first paragraph +after the tag (up to the first line that is either empty or contains +only whitespace characters). +If the string is "", the the default behaviour (i.e. failure) is reinstated. + +For example, suppose the start tag "/para" introduces a paragraph, which then +continues until the next "/endpara" tag or until another "/para" tag is +encountered: + + $text = "/para line 1\n\nline 3\n/para line 4"; + + extract_tagged($text, '/para', '/endpara', undef, + {reject => '/para', fail => MAX ); + + # EXTRACTED: "/para line 1\n\nline 3\n" + +Suppose instead, that if no matching "/endpara" tag is found, the "/para" +tag refers only to the immediately following paragraph: + + $text = "/para line 1\n\nline 3\n/para line 4"; + + extract_tagged($text, '/para', '/endpara', undef, + {reject => '/para', fail => MAX ); + + # EXTRACTED: "/para line 1\n" + +Note that the specified C behaviour applies to nested tags as well. + +=back + +On success in a list context, an array of 6 elements is returned. The elements are: + +=over 4 + +=item [0] + +the extracted tagged substring (including the outermost tags), + +=item [1] + +the remainder of the input text, + +=item [2] + +the prefix substring (if any), + +=item [3] + +the opening tag + +=item [4] + +the text between the opening and closing tags + +=item [5] + +the closing tag (or "" if no closing tag was found) + +=back + +On failure, all of these values (except the remaining text) are C. + +In a scalar context, C returns just the complete +substring that matched a tagged text (including the start and end +tags). C is returned on failure. In addition, the original input +text has the returned substring (and any prefix) removed from it. + +In a void context, the input text just has the matched substring (and +any specified prefix) removed. + + +=head2 C + +(Note: This subroutine is only available under Perl5.005) + +C generates a new anonymous subroutine which +extracts text between (balanced) specified tags. In other words, +it generates a function identical in function to C. + +The difference between C and the anonymous +subroutines generated by +C, is that those generated subroutines: + +=over 4 + +=item * + +do not have to reparse tag specification or parsing options every time +they are called (whereas C has to effectively rebuild +its tag parser on every call); + +=item * + +make use of the new qr// construct to pre-compile the regexes they use +(whereas C uses standard string variable interpolation +to create tag-matching patterns). + +=back + +The subroutine takes up to four optional arguments (the same set as +C except for the string to be processed). It returns +a reference to a subroutine which in turn takes a single argument (the text to +be extracted from). + +In other words, the implementation of C is exactly +equivalent to: + + sub extract_tagged + { + my $text = shift; + $extractor = gen_extract_tagged(@_); + return $extractor->($text); + } + +(although C is not currently implemented that way, in order +to preserve pre-5.005 compatibility). + +Using C to create extraction functions for specific tags +is a good idea if those functions are going to be called more than once, since +their performance is typically twice as good as the more general-purpose +C. + + +=head2 C + +C attempts to recognize, extract, and segment any +one of the various Perl quotes and quotelike operators (see +L) Nested backslashed delimiters, embedded balanced bracket +delimiters (for the quotelike operators), and trailing modifiers are +all caught. For example, in: + + extract_quotelike 'q # an octothorpe: \# (not the end of the q!) #' + + extract_quotelike ' "You said, \"Use sed\"." ' + + extract_quotelike ' s{([A-Z]{1,8}\.[A-Z]{3})} /\L$1\E/; ' + + extract_quotelike ' tr/\\\/\\\\/\\\//ds; ' + +the full Perl quotelike operations are all extracted correctly. + +Note too that, when using the /x modifier on a regex, any comment +containing the current pattern delimiter will cause the regex to be +immediately terminated. In other words: + + 'm / + (?i) # CASE INSENSITIVE + [a-z_] # LEADING ALPHABETIC/UNDERSCORE + [a-z0-9]* # FOLLOWED BY ANY NUMBER OF ALPHANUMERICS + /x' + +will be extracted as if it were: + + 'm / + (?i) # CASE INSENSITIVE + [a-z_] # LEADING ALPHABETIC/' + +This behaviour is identical to that of the actual compiler. + +C takes two arguments: the text to be processed and +a prefix to be matched at the very beginning of the text. If no prefix +is specified, optional whitespace is the default. If no text is given, +C<$_> is used. + +In a list context, an array of 11 elements is returned. The elements are: + +=over 4 + +=item [0] + +the extracted quotelike substring (including trailing modifiers), + +=item [1] + +the remainder of the input text, + +=item [2] + +the prefix substring (if any), + +=item [3] + +the name of the quotelike operator (if any), + +=item [4] + +the left delimiter of the first block of the operation, + +=item [5] + +the text of the first block of the operation +(that is, the contents of +a quote, the regex of a match or substitution or the target list of a +translation), + +=item [6] + +the right delimiter of the first block of the operation, + +=item [7] + +the left delimiter of the second block of the operation +(that is, if it is a C, C, or C), + +=item [8] + +the text of the second block of the operation +(that is, the replacement of a substitution or the translation list +of a translation), + +=item [9] + +the right delimiter of the second block of the operation (if any), + +=item [10] + +the trailing modifiers on the operation (if any). + +=back + +For each of the fields marked "(if any)" the default value on success is +an empty string. +On failure, all of these values (except the remaining text) are C. + + +In a scalar context, C returns just the complete substring +that matched a quotelike operation (or C on failure). In a scalar or +void context, the input text has the same substring (and any specified +prefix) removed. + +Examples: + + # Remove the first quotelike literal that appears in text + + $quotelike = extract_quotelike($text,'.*?'); + + # Replace one or more leading whitespace-separated quotelike + # literals in $_ with "" + + do { $_ = join '', (extract_quotelike)[2,1] } until $@; + + + # Isolate the search pattern in a quotelike operation from $text + + ($op,$pat) = (extract_quotelike $text)[3,5]; + if ($op =~ /[ms]/) + { + print "search pattern: $pat\n"; + } + else + { + print "$op is not a pattern matching operation\n"; + } + + +=head2 C and "here documents" + +C can successfully extract "here documents" from an input +string, but with an important caveat in list contexts. + +Unlike other types of quote-like literals, a here document is rarely +a contiguous substring. For example, a typical piece of code using +here document might look like this: + + <<'EOMSG' || die; + This is the message. + EOMSG + exit; + +Given this as an input string in a scalar context, C +would correctly return the string "<<'EOMSG'\nThis is the message.\nEOMSG", +leaving the string " || die;\nexit;" in the original variable. In other words, +the two separate pieces of the here document are successfully extracted and +concatenated. + +In a list context, C would return the list + +=over 4 + +=item [0] + +"<<'EOMSG'\nThis is the message.\nEOMSG\n" (i.e. the full extracted here document, +including fore and aft delimiters), + +=item [1] + +" || die;\nexit;" (i.e. the remainder of the input text, concatenated), + +=item [2] + +"" (i.e. the prefix substring -- trivial in this case), + +=item [3] + +"<<" (i.e. the "name" of the quotelike operator) + +=item [4] + +"'EOMSG'" (i.e. the left delimiter of the here document, including any quotes), + +=item [5] + +"This is the message.\n" (i.e. the text of the here document), + +=item [6] + +"EOMSG" (i.e. the right delimiter of the here document), + +=item [7..10] + +"" (a here document has no second left delimiter, second text, second right +delimiter, or trailing modifiers). + +=back + +However, the matching position of the input variable would be set to +"exit;" (i.e. I the closing delimiter of the here document), +which would cause the earlier " || die;\nexit;" to be skipped in any +sequence of code fragment extractions. + +To avoid this problem, when it encounters a here document whilst +extracting from a modifiable string, C silently +rearranges the string to an equivalent piece of Perl: + + <<'EOMSG' + This is the message. + EOMSG + || die; + exit; + +in which the here document I contiguous. It still leaves the +matching position after the here document, but now the rest of the line +on which the here document starts is not skipped. + +To prevent from mucking about with the input in this way +(this is the only case where a list-context C does so), +you can pass the input variable as an interpolated literal: + + $quotelike = extract_quotelike("$var"); + + +=head2 C + +C attempts to recognize and extract a balanced +bracket delimited substring that may contain unbalanced brackets +inside Perl quotes or quotelike operations. That is, C +is like a combination of C<"extract_bracketed"> and +C<"extract_quotelike">. + +C takes the same initial three parameters as C: +a text to process, a set of delimiter brackets to look for, and a prefix to +match first. It also takes an optional fourth parameter, which allows the +outermost delimiter brackets to be specified separately (see below). + +Omitting the first argument (input text) means process C<$_> instead. +Omitting the second argument (delimiter brackets) indicates that only C<'{'> is to be used. +Omitting the third argument (prefix argument) implies optional whitespace at the start. +Omitting the fourth argument (outermost delimiter brackets) indicates that the +value of the second argument is to be used for the outermost delimiters. + +Once the prefix an dthe outermost opening delimiter bracket have been +recognized, code blocks are extracted by stepping through the input text and +trying the following alternatives in sequence: + +=over 4 + +=item 1. + +Try and match a closing delimiter bracket. If the bracket was the same +species as the last opening bracket, return the substring to that +point. If the bracket was mismatched, return an error. + +=item 2. + +Try to match a quote or quotelike operator. If found, call +C to eat it. If C fails, return +the error it returned. Otherwise go back to step 1. + +=item 3. + +Try to match an opening delimiter bracket. If found, call +C recursively to eat the embedded block. If the +recursive call fails, return an error. Otherwise, go back to step 1. + +=item 4. + +Unconditionally match a bareword or any other single character, and +then go back to step 1. + +=back + + +Examples: + + # Find a while loop in the text + + if ($text =~ s/.*?while\s*\{/{/) + { + $loop = "while " . extract_codeblock($text); + } + + # Remove the first round-bracketed list (which may include + # round- or curly-bracketed code blocks or quotelike operators) + + extract_codeblock $text, "(){}", '[^(]*'; + + +The ability to specify a different outermost delimiter bracket is useful +in some circumstances. For example, in the Parse::RecDescent module, +parser actions which are to be performed only on a successful parse +are specified using a Cdefer:...E> directive. For example: + + sentence: subject verb object + + +Parse::RecDescent uses CE')> to extract the code +within the Cdefer:...E> directive, but there's a problem. + +A deferred action like this: + + 10) {$count--}} > + +will be incorrectly parsed as: + + + +because the "less than" operator is interpreted as a closing delimiter. + +But, by extracting the directive using +SE')>> +the '>' character is only treated as a delimited at the outermost +level of the code block, so the directive is parsed correctly. + +=head2 C + +The C subroutine takes a string to be processed and a +list of extractors (subroutines or regular expressions) to apply to that string. + +In an array context C returns an array of substrings +of the original string, as extracted by the specified extractors. +In a scalar context, C returns the first +substring successfully extracted from the original string. In both +scalar and void contexts the original string has the first successfully +extracted substring removed from it. In all contexts +C starts at the current C of the string, and +sets that C appropriately after it matches. + +Hence, the aim of of a call to C in a list context +is to split the processed string into as many non-overlapping fields as +possible, by repeatedly applying each of the specified extractors +to the remainder of the string. Thus C is +a generalized form of Perl's C subroutine. + +The subroutine takes up to four optional arguments: + +=over 4 + +=item 1. + +A string to be processed (C<$_> if the string is omitted or C) + +=item 2. + +A reference to a list of subroutine references and/or qr// objects and/or +literal strings and/or hash references, specifying the extractors +to be used to split the string. If this argument is omitted (or +C) the list: + + [ + sub { extract_variable($_[0], '') }, + sub { extract_quotelike($_[0],'') }, + sub { extract_codeblock($_[0],'{}','') }, + ] + +is used. + + +=item 3. + +An number specifying the maximum number of fields to return. If this +argument is omitted (or C), split continues as long as possible. + +If the third argument is I, then extraction continues until I fields +have been successfully extracted, or until the string has been completely +processed. + +Note that in scalar and void contexts the value of this argument is +automatically reset to 1 (under C<-w>, a warning is issued if the argument +has to be reset). + +=item 4. + +A value indicating whether unmatched substrings (see below) within the +text should be skipped or returned as fields. If the value is true, +such substrings are skipped. Otherwise, they are returned. + +=back + +The extraction process works by applying each extractor in +sequence to the text string. + +If the extractor is a subroutine it is called in a list context and is +expected to return a list of a single element, namely the extracted +text. It may optionally also return two further arguments: a string +representing the text left after extraction (like $' for a pattern +match), and a string representing any prefix skipped before the +extraction (like $` in a pattern match). Note that this is designed +to facilitate the use of other Text::Balanced subroutines with +C. Note too that the value returned by an extractor +subroutine need not bear any relationship to the corresponding substring +of the original text (see examples below). + +If the extractor is a precompiled regular expression or a string, +it is matched against the text in a scalar context with a leading +'\G' and the gc modifiers enabled. The extracted value is either +$1 if that variable is defined after the match, or else the +complete match (i.e. $&). + +If the extractor is a hash reference, it must contain exactly one element. +The value of that element is one of the +above extractor types (subroutine reference, regular expression, or string). +The key of that element is the name of a class into which the successful +return value of the extractor will be blessed. + +If an extractor returns a defined value, that value is immediately +treated as the next extracted field and pushed onto the list of fields. +If the extractor was specified in a hash reference, the field is also +blessed into the appropriate class, + +If the extractor fails to match (in the case of a regex extractor), or returns an empty list or an undefined value (in the case of a subroutine extractor), it is +assumed to have failed to extract. +If none of the extractor subroutines succeeds, then one +character is extracted from the start of the text and the extraction +subroutines reapplied. Characters which are thus removed are accumulated and +eventually become the next field (unless the fourth argument is true, in which +case they are disgarded). + +For example, the following extracts substrings that are valid Perl variables: + + @fields = extract_multiple($text, + [ sub { extract_variable($_[0]) } ], + undef, 1); + +This example separates a text into fields which are quote delimited, +curly bracketed, and anything else. The delimited and bracketed +parts are also blessed to identify them (the "anything else" is unblessed): + + @fields = extract_multiple($text, + [ + { Delim => sub { extract_delimited($_[0],q{'"}) } }, + { Brack => sub { extract_bracketed($_[0],'{}') } }, + ]); + +This call extracts the next single substring that is a valid Perl quotelike +operator (and removes it from $text): + + $quotelike = extract_multiple($text, + [ + sub { extract_quotelike($_[0]) }, + ], undef, 1); + +Finally, here is yet another way to do comma-separated value parsing: + + @fields = extract_multiple($csv_text, + [ + sub { extract_delimited($_[0],q{'"}) }, + qr/([^,]+)(.*)/, + ], + undef,1); + +The list in the second argument means: +I<"Try and extract a ' or " delimited string, otherwise extract anything up to a comma...">. +The undef third argument means: +I<"...as many times as possible...">, +and the true value in the fourth argument means +I<"...discarding anything else that appears (i.e. the commas)">. + +If you wanted the commas preserved as separate fields (i.e. like split +does if your split pattern has capturing parentheses), you would +just make the last parameter undefined (or remove it). + + +=head2 C + +The C subroutine takes a single (string) argument and + > builds a Friedl-style optimized regex that matches a string delimited +by any one of the characters in the single argument. For example: + + gen_delimited_pat(q{'"}) + +returns the regex: + + (?:\"(?:\\\"|(?!\").)*\"|\'(?:\\\'|(?!\').)*\') + +Note that the specified delimiters are automatically quotemeta'd. + +A typical use of C would be to build special purpose tags +for C. For example, to properly ignore "empty" XML elements +(which might contain quoted strings): + + my $empty_tag = '<(' . gen_delimited_pat(q{'"}) . '|.)+/>'; + + extract_tagged($text, undef, undef, undef, {ignore => [$empty_tag]} ); + + +C may also be called with an optional second argument, +which specifies the "escape" character(s) to be used for each delimiter. +For example to match a Pascal-style string (where ' is the delimiter +and '' is a literal ' within the string): + + gen_delimited_pat(q{'},q{'}); + +Different escape characters can be specified for different delimiters. +For example, to specify that '/' is the escape for single quotes +and '%' is the escape for double quotes: + + gen_delimited_pat(q{'"},q{/%}); + +If more delimiters than escape chars are specified, the last escape char +is used for the remaining delimiters. +If no escape char is specified for a given specified delimiter, '\' is used. + +Note that +C was previously called +C. That name may still be used, but is now deprecated. + + +=head1 DIAGNOSTICS + +In a list context, all the functions return C<(undef,$original_text)> +on failure. In a scalar context, failure is indicated by returning C +(in this case the input text is not modified in any way). + +In addition, on failure in I context, the C<$@> variable is set. +Accessing C<$@-E{error}> returns one of the error diagnostics listed +below. +Accessing C<$@-E{pos}> returns the offset into the original string at +which the error was detected (although not necessarily where it occurred!) +Printing C<$@> directly produces the error message, with the offset appended. +On success, the C<$@> variable is guaranteed to be C. + +The available diagnostics are: + +=over 4 + +=item C + +The delimiter provided to C was not one of +C<'()[]EE{}'>. + +=item C + +A non-optional prefix was specified but wasn't found at the start of the text. + +=item C + +C or C was expecting a +particular kind of bracket at the start of the text, and didn't find it. + +=item C + +C didn't find one of the quotelike operators C, +C, C, C, C, C or C at the start of the substring +it was extracting. + +=item C + +C, C or C encountered +a closing bracket where none was expected. + +=item C + +C, C or C ran +out of characters in the text before closing one or more levels of nested +brackets. + +=item C + +C attempted to match an embedded quoted substring, but +failed to find a closing quote to match it. + +=item C + +C was unable to find a closing delimiter to match the +one that opened the quote-like operation. + +=item C + +C, C or C found +a valid bracket delimiter, but it was the wrong species. This usually +indicates a nesting error, but may indicate incorrect quoting or escaping. + +=item C + +C or C found one of the +quotelike operators C, C, C, C, C, C or C +without a suitable block after it. + +=item C + +C was expecting one of '$', '@', or '%' at the start of +a variable, but didn't find any of them. + +=item C + +C found a '$', '@', or '%' indicating a variable, but that +character was not followed by a legal Perl identifier. + +=item C + +C failed to find any of the outermost opening brackets +that were specified. + +=item C + +A nested code block was found that started with a delimiter that was specified +as being only to be used as an outermost bracket. + +=item C + +C or C found one of the +quotelike operators C, C or C followed by only one block. + +=item C + +C failed to find a closing bracket to match the outermost +opening bracket. + +=item C + +C did not find a suitable opening tag (after any specified +prefix was removed). + +=item C + +C matched the specified opening tag and tried to +modify the matched text to produce a matching closing tag (because +none was specified). It failed to generate the closing tag, almost +certainly because the opening tag did not start with a +bracket of some kind. + +=item C + +C found a nested tag that appeared in the "reject" list +(and the failure mode was not "MAX" or "PARA"). + +=item C + +C found a nested opening tag that was not matched by a +corresponding nested closing tag (and the failure mode was not "MAX" or "PARA"). + +=item C + +C reached the end of the text without finding a closing tag +to match the original opening tag (and the failure mode was not +"MAX" or "PARA"). + + + + +=back + + +=head1 AUTHOR + +Damian Conway (damian@conway.org) + + +=head1 BUGS AND IRRITATIONS + +There are undoubtedly serious bugs lurking somewhere in this code, if +only because parts of it give the impression of understanding a great deal +more about Perl than they really do. + +Bug reports and other feedback are most welcome. + + +=head1 COPYRIGHT + + Copyright (c) 1997-2001, Damian Conway. All Rights Reserved. + This module is free software. It may be used, redistributed + and/or modified under the same terms as Perl itself. diff --git a/template/Deutsch/at_new.html b/template/Deutsch/at_new.html new file mode 100644 index 0000000..4620454 --- /dev/null +++ b/template/Deutsch/at_new.html @@ -0,0 +1,155 @@ + + + + + + + + + + +
+ + + + + + + + + +
+

Neuen Auto Timer anlegenAuto Timer editieren

+ 		  + Hilfe +  
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  
Auto Timer Aktiv: + + ja + nein + + ja + nein + +
Suchbegriffe: + +
zu suchen in: + checked> Title + checked> Subtitle + checked> Beschreibung +
Sender: + +
Beginnt frühestens: + : + Uhr +
Endet spätestens: + : + Uhr +
Priorität: + +
Lifetime: + +
Serie: + checked> +
Done Aktiv: + + ja + nein + + ja + nein + +
Ordner: + +
  
+
+ +
+ + + diff --git a/template/Deutsch/at_timer_list.html b/template/Deutsch/at_timer_list.html new file mode 100644 index 0000000..2727420 --- /dev/null +++ b/template/Deutsch/at_timer_list.html @@ -0,0 +1,163 @@ + + + + + + + + + + + + + + + + + + + + + + + +
+

Auto Timer

+ 		  + + + + + + + +
+
+ Neuer Auto Timer
+
+ 		+ Hilfe +  
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

+ 		+

  Aktiv

+ 		+

  Sender

+ 		+

  Start

+ 		+

  Stop

+ 		+

  Name

+ 		   
  +

+   Ja Nein +

+ 		+

+ + + + - +

+ 		+

+ + + + - + +

+ 		+

+ + + + - + +

+ 		+

+ 		+

+ 		+

+ 		+

+ 		 
         
+ +
+ + + + + +
+ +
Manuelles Update
 + +

+ + + + + + +
+ +
Ausgewählte Auto Timer löschen
 + +
+
+ +
+ + + diff --git a/template/Deutsch/bilder/auge.jpg b/template/Deutsch/bilder/auge.jpg new file mode 100755 index 0000000..cd975b0 Binary files /dev/null and b/template/Deutsch/bilder/auge.jpg differ diff --git a/template/Deutsch/bilder/back.gif b/template/Deutsch/bilder/back.gif new file mode 100644 index 0000000..1b514e1 Binary files /dev/null and b/template/Deutsch/bilder/back.gif differ diff --git a/template/Deutsch/bilder/back.png b/template/Deutsch/bilder/back.png new file mode 100644 index 0000000..f2e072e Binary files /dev/null and b/template/Deutsch/bilder/back.png differ diff --git a/template/Deutsch/bilder/background.gif b/template/Deutsch/bilder/background.gif new file mode 100644 index 0000000..700c597 Binary files /dev/null and b/template/Deutsch/bilder/background.gif differ diff --git a/template/Deutsch/bilder/cback.png b/template/Deutsch/bilder/cback.png new file mode 100644 index 0000000..b2ffaf9 Binary files /dev/null and b/template/Deutsch/bilder/cback.png differ diff --git a/template/Deutsch/bilder/delete.gif b/template/Deutsch/bilder/delete.gif new file mode 100644 index 0000000..21b74a4 Binary files /dev/null and b/template/Deutsch/bilder/delete.gif differ diff --git a/template/Deutsch/bilder/edit.gif b/template/Deutsch/bilder/edit.gif new file mode 100644 index 0000000..88aa3d1 Binary files /dev/null and b/template/Deutsch/bilder/edit.gif differ diff --git a/template/Deutsch/bilder/favicon.ico b/template/Deutsch/bilder/favicon.ico new file mode 100644 index 0000000..a4fe6df Binary files /dev/null and b/template/Deutsch/bilder/favicon.ico differ diff --git a/template/Deutsch/bilder/fern_01.jpg b/template/Deutsch/bilder/fern_01.jpg new file mode 100644 index 0000000..112d9f6 Binary files /dev/null and b/template/Deutsch/bilder/fern_01.jpg differ diff --git a/template/Deutsch/bilder/fern_02.jpg b/template/Deutsch/bilder/fern_02.jpg new file mode 100644 index 0000000..aa8c973 Binary files /dev/null and b/template/Deutsch/bilder/fern_02.jpg differ diff --git a/template/Deutsch/bilder/fern_03.jpg b/template/Deutsch/bilder/fern_03.jpg new file mode 100644 index 0000000..dc898fd Binary files /dev/null and b/template/Deutsch/bilder/fern_03.jpg differ diff --git a/template/Deutsch/bilder/fern_04.jpg b/template/Deutsch/bilder/fern_04.jpg new file mode 100644 index 0000000..60466f6 Binary files /dev/null and b/template/Deutsch/bilder/fern_04.jpg differ diff --git a/template/Deutsch/bilder/fern_05.jpg b/template/Deutsch/bilder/fern_05.jpg new file mode 100644 index 0000000..de4fefe Binary files /dev/null and b/template/Deutsch/bilder/fern_05.jpg differ diff --git a/template/Deutsch/bilder/fern_06.jpg b/template/Deutsch/bilder/fern_06.jpg new file mode 100644 index 0000000..e2ec172 Binary files /dev/null and b/template/Deutsch/bilder/fern_06.jpg differ diff --git a/template/Deutsch/bilder/fern_07.jpg b/template/Deutsch/bilder/fern_07.jpg new file mode 100644 index 0000000..479dfc7 Binary files /dev/null and b/template/Deutsch/bilder/fern_07.jpg differ diff --git a/template/Deutsch/bilder/fern_08.jpg b/template/Deutsch/bilder/fern_08.jpg new file mode 100644 index 0000000..46edd48 Binary files /dev/null and b/template/Deutsch/bilder/fern_08.jpg differ diff --git a/template/Deutsch/bilder/fern_09.jpg b/template/Deutsch/bilder/fern_09.jpg new file mode 100644 index 0000000..144ab3f Binary files /dev/null and b/template/Deutsch/bilder/fern_09.jpg differ diff --git a/template/Deutsch/bilder/fern_10.jpg b/template/Deutsch/bilder/fern_10.jpg new file mode 100644 index 0000000..21a4612 Binary files /dev/null and b/template/Deutsch/bilder/fern_10.jpg differ diff --git a/template/Deutsch/bilder/fern_11.jpg b/template/Deutsch/bilder/fern_11.jpg new file mode 100644 index 0000000..d277804 Binary files /dev/null and b/template/Deutsch/bilder/fern_11.jpg differ diff --git a/template/Deutsch/bilder/fern_12.jpg b/template/Deutsch/bilder/fern_12.jpg new file mode 100644 index 0000000..2342bb1 Binary files /dev/null and b/template/Deutsch/bilder/fern_12.jpg differ diff --git a/template/Deutsch/bilder/fern_13.jpg b/template/Deutsch/bilder/fern_13.jpg new file mode 100644 index 0000000..ab2b3a4 Binary files /dev/null and b/template/Deutsch/bilder/fern_13.jpg differ diff --git a/template/Deutsch/bilder/fern_14.jpg b/template/Deutsch/bilder/fern_14.jpg new file mode 100644 index 0000000..7522563 Binary files /dev/null and b/template/Deutsch/bilder/fern_14.jpg differ diff --git a/template/Deutsch/bilder/fern_15.jpg b/template/Deutsch/bilder/fern_15.jpg new file mode 100644 index 0000000..58e7438 Binary files /dev/null and b/template/Deutsch/bilder/fern_15.jpg differ diff --git a/template/Deutsch/bilder/fern_16.jpg b/template/Deutsch/bilder/fern_16.jpg new file mode 100644 index 0000000..1a0a077 Binary files /dev/null and b/template/Deutsch/bilder/fern_16.jpg differ diff --git a/template/Deutsch/bilder/fern_17.jpg b/template/Deutsch/bilder/fern_17.jpg new file mode 100644 index 0000000..69db0f5 Binary files /dev/null and b/template/Deutsch/bilder/fern_17.jpg differ diff --git a/template/Deutsch/bilder/fern_18.jpg b/template/Deutsch/bilder/fern_18.jpg new file mode 100644 index 0000000..c1543d6 Binary files /dev/null and b/template/Deutsch/bilder/fern_18.jpg differ diff --git a/template/Deutsch/bilder/fern_19.jpg b/template/Deutsch/bilder/fern_19.jpg new file mode 100644 index 0000000..5f777a9 Binary files /dev/null and b/template/Deutsch/bilder/fern_19.jpg differ diff --git a/template/Deutsch/bilder/fern_20.jpg b/template/Deutsch/bilder/fern_20.jpg new file mode 100644 index 0000000..2bc0762 Binary files /dev/null and b/template/Deutsch/bilder/fern_20.jpg differ diff --git a/template/Deutsch/bilder/fern_21.jpg b/template/Deutsch/bilder/fern_21.jpg new file mode 100644 index 0000000..757c2b4 Binary files /dev/null and b/template/Deutsch/bilder/fern_21.jpg differ diff --git a/template/Deutsch/bilder/fern_22.jpg b/template/Deutsch/bilder/fern_22.jpg new file mode 100644 index 0000000..9537044 Binary files /dev/null and b/template/Deutsch/bilder/fern_22.jpg differ diff --git a/template/Deutsch/bilder/fern_23.jpg b/template/Deutsch/bilder/fern_23.jpg new file mode 100644 index 0000000..8a97144 Binary files /dev/null and b/template/Deutsch/bilder/fern_23.jpg differ diff --git a/template/Deutsch/bilder/fern_24.jpg b/template/Deutsch/bilder/fern_24.jpg new file mode 100644 index 0000000..831a23d Binary files /dev/null and b/template/Deutsch/bilder/fern_24.jpg differ diff --git a/template/Deutsch/bilder/fern_25.jpg b/template/Deutsch/bilder/fern_25.jpg new file mode 100644 index 0000000..92d08ec Binary files /dev/null and b/template/Deutsch/bilder/fern_25.jpg differ diff --git a/template/Deutsch/bilder/fern_26.jpg b/template/Deutsch/bilder/fern_26.jpg new file mode 100644 index 0000000..0e3afed Binary files /dev/null and b/template/Deutsch/bilder/fern_26.jpg differ diff --git a/template/Deutsch/bilder/fern_27.jpg b/template/Deutsch/bilder/fern_27.jpg new file mode 100644 index 0000000..d55b445 Binary files /dev/null and b/template/Deutsch/bilder/fern_27.jpg differ diff --git a/template/Deutsch/bilder/fern_28.jpg b/template/Deutsch/bilder/fern_28.jpg new file mode 100644 index 0000000..f72f876 Binary files /dev/null and b/template/Deutsch/bilder/fern_28.jpg differ diff --git a/template/Deutsch/bilder/fern_29.jpg b/template/Deutsch/bilder/fern_29.jpg new file mode 100644 index 0000000..5952b08 Binary files /dev/null and b/template/Deutsch/bilder/fern_29.jpg differ diff --git a/template/Deutsch/bilder/fern_30.jpg b/template/Deutsch/bilder/fern_30.jpg new file mode 100644 index 0000000..15fb695 Binary files /dev/null and b/template/Deutsch/bilder/fern_30.jpg differ diff --git a/template/Deutsch/bilder/fern_31.jpg b/template/Deutsch/bilder/fern_31.jpg new file mode 100644 index 0000000..0057f36 Binary files /dev/null and b/template/Deutsch/bilder/fern_31.jpg differ diff --git a/template/Deutsch/bilder/fern_32.jpg b/template/Deutsch/bilder/fern_32.jpg new file mode 100644 index 0000000..9551a4b Binary files /dev/null and b/template/Deutsch/bilder/fern_32.jpg differ diff --git a/template/Deutsch/bilder/fern_33.jpg b/template/Deutsch/bilder/fern_33.jpg new file mode 100644 index 0000000..8d44785 Binary files /dev/null and b/template/Deutsch/bilder/fern_33.jpg differ diff --git a/template/Deutsch/bilder/fern_34.jpg b/template/Deutsch/bilder/fern_34.jpg new file mode 100644 index 0000000..8db1ebc Binary files /dev/null and b/template/Deutsch/bilder/fern_34.jpg differ diff --git a/template/Deutsch/bilder/fern_35.jpg b/template/Deutsch/bilder/fern_35.jpg new file mode 100644 index 0000000..74e68a0 Binary files /dev/null and b/template/Deutsch/bilder/fern_35.jpg differ diff --git a/template/Deutsch/bilder/fern_36.jpg b/template/Deutsch/bilder/fern_36.jpg new file mode 100644 index 0000000..db7dc6e Binary files /dev/null and b/template/Deutsch/bilder/fern_36.jpg differ diff --git a/template/Deutsch/bilder/fern_37.jpg b/template/Deutsch/bilder/fern_37.jpg new file mode 100644 index 0000000..0ad6453 Binary files /dev/null and b/template/Deutsch/bilder/fern_37.jpg differ diff --git a/template/Deutsch/bilder/fern_38.jpg b/template/Deutsch/bilder/fern_38.jpg new file mode 100644 index 0000000..3b4e41e Binary files /dev/null and b/template/Deutsch/bilder/fern_38.jpg differ diff --git a/template/Deutsch/bilder/fern_39.jpg b/template/Deutsch/bilder/fern_39.jpg new file mode 100644 index 0000000..c68ba21 Binary files /dev/null and b/template/Deutsch/bilder/fern_39.jpg differ diff --git a/template/Deutsch/bilder/fern_40.jpg b/template/Deutsch/bilder/fern_40.jpg new file mode 100644 index 0000000..c7c01ed Binary files /dev/null and b/template/Deutsch/bilder/fern_40.jpg differ diff --git a/template/Deutsch/bilder/fern_41.jpg b/template/Deutsch/bilder/fern_41.jpg new file mode 100644 index 0000000..c9b8784 Binary files /dev/null and b/template/Deutsch/bilder/fern_41.jpg differ diff --git a/template/Deutsch/bilder/fern_42.jpg b/template/Deutsch/bilder/fern_42.jpg new file mode 100644 index 0000000..2f63a66 Binary files /dev/null and b/template/Deutsch/bilder/fern_42.jpg differ diff --git a/template/Deutsch/bilder/fern_back.jpg b/template/Deutsch/bilder/fern_back.jpg new file mode 100644 index 0000000..4b9eb7c Binary files /dev/null and b/template/Deutsch/bilder/fern_back.jpg differ diff --git a/template/Deutsch/bilder/fernseher_unten.gif b/template/Deutsch/bilder/fernseher_unten.gif new file mode 100644 index 0000000..43219e3 Binary files /dev/null and b/template/Deutsch/bilder/fernseher_unten.gif differ diff --git a/template/Deutsch/bilder/folder.gif b/template/Deutsch/bilder/folder.gif new file mode 100644 index 0000000..e3c45a5 Binary files /dev/null and b/template/Deutsch/bilder/folder.gif differ diff --git a/template/Deutsch/bilder/frame.png b/template/Deutsch/bilder/frame.png new file mode 100644 index 0000000..94485e2 Binary files /dev/null and b/template/Deutsch/bilder/frame.png differ diff --git a/template/Deutsch/bilder/framed.gif b/template/Deutsch/bilder/framed.gif new file mode 100644 index 0000000..0adecf2 Binary files /dev/null and b/template/Deutsch/bilder/framed.gif differ diff --git a/template/Deutsch/bilder/gbutton_left.gif b/template/Deutsch/bilder/gbutton_left.gif new file mode 100644 index 0000000..41672a3 Binary files /dev/null and b/template/Deutsch/bilder/gbutton_left.gif differ diff --git a/template/Deutsch/bilder/gbutton_middle.gif b/template/Deutsch/bilder/gbutton_middle.gif new file mode 100644 index 0000000..07192d9 Binary files /dev/null and b/template/Deutsch/bilder/gbutton_middle.gif differ diff --git a/template/Deutsch/bilder/gbutton_right.gif b/template/Deutsch/bilder/gbutton_right.gif new file mode 100644 index 0000000..d5a55e7 Binary files /dev/null and b/template/Deutsch/bilder/gbutton_right.gif differ diff --git a/template/Deutsch/bilder/help.gif b/template/Deutsch/bilder/help.gif new file mode 100644 index 0000000..095f28a Binary files /dev/null and b/template/Deutsch/bilder/help.gif differ diff --git a/template/Deutsch/bilder/hilfe.gif b/template/Deutsch/bilder/hilfe.gif new file mode 100644 index 0000000..8f14289 Binary files /dev/null and b/template/Deutsch/bilder/hilfe.gif differ diff --git a/template/Deutsch/bilder/info.jpg b/template/Deutsch/bilder/info.jpg new file mode 100755 index 0000000..de7cfc6 Binary files /dev/null and b/template/Deutsch/bilder/info.jpg differ diff --git a/template/Deutsch/bilder/info_button.gif b/template/Deutsch/bilder/info_button.gif new file mode 100644 index 0000000..3ae6142 Binary files /dev/null and b/template/Deutsch/bilder/info_button.gif differ diff --git a/template/Deutsch/bilder/info_button_disabled.gif b/template/Deutsch/bilder/info_button_disabled.gif new file mode 100644 index 0000000..33912a1 Binary files /dev/null and b/template/Deutsch/bilder/info_button_disabled.gif differ diff --git a/template/Deutsch/bilder/linvdr.gif b/template/Deutsch/bilder/linvdr.gif new file mode 100644 index 0000000..d9d0398 Binary files /dev/null and b/template/Deutsch/bilder/linvdr.gif differ diff --git a/template/Deutsch/bilder/logo.gif b/template/Deutsch/bilder/logo.gif new file mode 100644 index 0000000..dfbcd2e Binary files /dev/null and b/template/Deutsch/bilder/logo.gif differ diff --git a/template/Deutsch/bilder/luecke.gif b/template/Deutsch/bilder/luecke.gif new file mode 100755 index 0000000..a15ade9 Binary files /dev/null and b/template/Deutsch/bilder/luecke.gif differ diff --git a/template/Deutsch/bilder/lupe.jpg b/template/Deutsch/bilder/lupe.jpg new file mode 100755 index 0000000..cd2252c Binary files /dev/null and b/template/Deutsch/bilder/lupe.jpg differ diff --git a/template/Deutsch/bilder/mitte.gif b/template/Deutsch/bilder/mitte.gif new file mode 100644 index 0000000..92ec6ad Binary files /dev/null and b/template/Deutsch/bilder/mitte.gif differ diff --git a/template/Deutsch/bilder/nav_button_back.gif b/template/Deutsch/bilder/nav_button_back.gif new file mode 100644 index 0000000..9287c7e Binary files /dev/null and b/template/Deutsch/bilder/nav_button_back.gif differ diff --git a/template/Deutsch/bilder/nav_button_back_end.gif b/template/Deutsch/bilder/nav_button_back_end.gif new file mode 100644 index 0000000..b65f4ba Binary files /dev/null and b/template/Deutsch/bilder/nav_button_back_end.gif differ diff --git a/template/Deutsch/bilder/nav_button_back_mitte.gif b/template/Deutsch/bilder/nav_button_back_mitte.gif new file mode 100644 index 0000000..c6390f4 Binary files /dev/null and b/template/Deutsch/bilder/nav_button_back_mitte.gif differ diff --git a/template/Deutsch/bilder/new_auto_timer.gif b/template/Deutsch/bilder/new_auto_timer.gif new file mode 100644 index 0000000..576a062 Binary files /dev/null and b/template/Deutsch/bilder/new_auto_timer.gif differ diff --git a/template/Deutsch/bilder/new_timer.gif b/template/Deutsch/bilder/new_timer.gif new file mode 100644 index 0000000..5658326 Binary files /dev/null and b/template/Deutsch/bilder/new_timer.gif differ diff --git a/template/Deutsch/bilder/pfeile_nachlinks.gif b/template/Deutsch/bilder/pfeile_nachlinks.gif new file mode 100644 index 0000000..867fc2c Binary files /dev/null and b/template/Deutsch/bilder/pfeile_nachlinks.gif differ diff --git a/template/Deutsch/bilder/pfeile_nachlinks_soft.gif b/template/Deutsch/bilder/pfeile_nachlinks_soft.gif new file mode 100644 index 0000000..854d380 Binary files /dev/null and b/template/Deutsch/bilder/pfeile_nachlinks_soft.gif differ diff --git a/template/Deutsch/bilder/pfeile_nachrechts.gif b/template/Deutsch/bilder/pfeile_nachrechts.gif new file mode 100644 index 0000000..011511e Binary files /dev/null and b/template/Deutsch/bilder/pfeile_nachrechts.gif differ diff --git a/template/Deutsch/bilder/pfeile_nachrechts_soft.gif b/template/Deutsch/bilder/pfeile_nachrechts_soft.gif new file mode 100644 index 0000000..34fb06e Binary files /dev/null and b/template/Deutsch/bilder/pfeile_nachrechts_soft.gif differ diff --git a/template/Deutsch/bilder/poempl_gelb.gif b/template/Deutsch/bilder/poempl_gelb.gif new file mode 100644 index 0000000..f79a28a Binary files /dev/null and b/template/Deutsch/bilder/poempl_gelb.gif differ diff --git a/template/Deutsch/bilder/poempl_grau.gif b/template/Deutsch/bilder/poempl_grau.gif new file mode 100755 index 0000000..c397bbc Binary files /dev/null and b/template/Deutsch/bilder/poempl_grau.gif differ diff --git a/template/Deutsch/bilder/poempl_grau2.gif b/template/Deutsch/bilder/poempl_grau2.gif new file mode 100755 index 0000000..db90eae Binary files /dev/null and b/template/Deutsch/bilder/poempl_grau2.gif differ diff --git a/template/Deutsch/bilder/poempl_gruen.gif b/template/Deutsch/bilder/poempl_gruen.gif new file mode 100644 index 0000000..541be87 Binary files /dev/null and b/template/Deutsch/bilder/poempl_gruen.gif differ diff --git a/template/Deutsch/bilder/poempl_rot.gif b/template/Deutsch/bilder/poempl_rot.gif new file mode 100644 index 0000000..ef2daac Binary files /dev/null and b/template/Deutsch/bilder/poempl_rot.gif differ diff --git a/template/Deutsch/bilder/rec.gif b/template/Deutsch/bilder/rec.gif new file mode 100644 index 0000000..afb3199 Binary files /dev/null and b/template/Deutsch/bilder/rec.gif differ diff --git a/template/Deutsch/bilder/rec.jpg b/template/Deutsch/bilder/rec.jpg new file mode 100755 index 0000000..187626b Binary files /dev/null and b/template/Deutsch/bilder/rec.jpg differ diff --git a/template/Deutsch/bilder/rec_button.gif b/template/Deutsch/bilder/rec_button.gif new file mode 100644 index 0000000..4487ff5 Binary files /dev/null and b/template/Deutsch/bilder/rec_button.gif differ diff --git a/template/Deutsch/bilder/rec_mitback.gif b/template/Deutsch/bilder/rec_mitback.gif new file mode 100644 index 0000000..54e9989 Binary files /dev/null and b/template/Deutsch/bilder/rec_mitback.gif differ diff --git a/template/Deutsch/bilder/rec_mitback2.jpg b/template/Deutsch/bilder/rec_mitback2.jpg new file mode 100644 index 0000000..5a70637 Binary files /dev/null and b/template/Deutsch/bilder/rec_mitback2.jpg differ diff --git a/template/Deutsch/bilder/remote.swf b/template/Deutsch/bilder/remote.swf new file mode 100644 index 0000000..c868907 Binary files /dev/null and b/template/Deutsch/bilder/remote.swf differ diff --git a/template/Deutsch/bilder/sauerei.gif b/template/Deutsch/bilder/sauerei.gif new file mode 100644 index 0000000..24962b8 Binary files /dev/null and b/template/Deutsch/bilder/sauerei.gif differ diff --git a/template/Deutsch/bilder/separator.png b/template/Deutsch/bilder/separator.png new file mode 100644 index 0000000..1719049 Binary files /dev/null and b/template/Deutsch/bilder/separator.png differ diff --git a/template/Deutsch/bilder/sortiert_asc.gif b/template/Deutsch/bilder/sortiert_asc.gif new file mode 100644 index 0000000..0839e0f Binary files /dev/null and b/template/Deutsch/bilder/sortiert_asc.gif differ diff --git a/template/Deutsch/bilder/sortiert_desc.gif b/template/Deutsch/bilder/sortiert_desc.gif new file mode 100644 index 0000000..a0c689a Binary files /dev/null and b/template/Deutsch/bilder/sortiert_desc.gif differ diff --git a/template/Deutsch/bilder/spacer.gif b/template/Deutsch/bilder/spacer.gif new file mode 100644 index 0000000..5bfd67a Binary files /dev/null and b/template/Deutsch/bilder/spacer.gif differ diff --git a/template/Deutsch/bilder/stream.jpg b/template/Deutsch/bilder/stream.jpg new file mode 100644 index 0000000..0244664 Binary files /dev/null and b/template/Deutsch/bilder/stream.jpg differ diff --git a/template/Deutsch/bilder/stream_mitback2.jpg b/template/Deutsch/bilder/stream_mitback2.jpg new file mode 100644 index 0000000..f3ff7f9 Binary files /dev/null and b/template/Deutsch/bilder/stream_mitback2.jpg differ diff --git a/template/Deutsch/bilder/top.gif b/template/Deutsch/bilder/top.gif new file mode 100644 index 0000000..6cf906d Binary files /dev/null and b/template/Deutsch/bilder/top.gif differ diff --git a/template/Deutsch/bilder/top_nav_aufnahmen.gif b/template/Deutsch/bilder/top_nav_aufnahmen.gif new file mode 100644 index 0000000..e6ceda9 Binary files /dev/null and b/template/Deutsch/bilder/top_nav_aufnahmen.gif differ diff --git a/template/Deutsch/bilder/top_nav_fernbedienung.gif b/template/Deutsch/bilder/top_nav_fernbedienung.gif new file mode 100644 index 0000000..423c3c2 Binary files /dev/null and b/template/Deutsch/bilder/top_nav_fernbedienung.gif differ diff --git a/template/Deutsch/bilder/top_nav_konf.gif b/template/Deutsch/bilder/top_nav_konf.gif new file mode 100644 index 0000000..7185a15 Binary files /dev/null and b/template/Deutsch/bilder/top_nav_konf.gif differ diff --git a/template/Deutsch/bilder/top_nav_prguebersicht.gif b/template/Deutsch/bilder/top_nav_prguebersicht.gif new file mode 100644 index 0000000..dae2f18 Binary files /dev/null and b/template/Deutsch/bilder/top_nav_prguebersicht.gif differ diff --git a/template/Deutsch/bilder/top_nav_timer.gif b/template/Deutsch/bilder/top_nav_timer.gif new file mode 100644 index 0000000..d491576 Binary files /dev/null and b/template/Deutsch/bilder/top_nav_timer.gif differ diff --git a/template/Deutsch/bilder/top_nav_wasjetzt.gif b/template/Deutsch/bilder/top_nav_wasjetzt.gif new file mode 100644 index 0000000..cff65ba Binary files /dev/null and b/template/Deutsch/bilder/top_nav_wasjetzt.gif differ diff --git a/template/Deutsch/bilder/tv_bottom.gif b/template/Deutsch/bilder/tv_bottom.gif new file mode 100644 index 0000000..43219e3 Binary files /dev/null and b/template/Deutsch/bilder/tv_bottom.gif differ diff --git a/template/Deutsch/bilder/tv_umschalten_mitback.gif b/template/Deutsch/bilder/tv_umschalten_mitback.gif new file mode 100644 index 0000000..a4dca70 Binary files /dev/null and b/template/Deutsch/bilder/tv_umschalten_mitback.gif differ diff --git a/template/Deutsch/bilder/tv_umschalten_mitback2.jpg b/template/Deutsch/bilder/tv_umschalten_mitback2.jpg new file mode 100644 index 0000000..dfb2728 Binary files /dev/null and b/template/Deutsch/bilder/tv_umschalten_mitback2.jpg differ diff --git a/template/Deutsch/bilder/uebersicht_links.gif b/template/Deutsch/bilder/uebersicht_links.gif new file mode 100644 index 0000000..f000a20 Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_links.gif differ diff --git a/template/Deutsch/bilder/uebersicht_links_dark.gif b/template/Deutsch/bilder/uebersicht_links_dark.gif new file mode 100644 index 0000000..ae7b95c Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_links_dark.gif differ diff --git a/template/Deutsch/bilder/uebersicht_mitte.gif b/template/Deutsch/bilder/uebersicht_mitte.gif new file mode 100644 index 0000000..1ddae15 Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_mitte.gif differ diff --git a/template/Deutsch/bilder/uebersicht_mitte_dark.gif b/template/Deutsch/bilder/uebersicht_mitte_dark.gif new file mode 100644 index 0000000..ed6da4d Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_mitte_dark.gif differ diff --git a/template/Deutsch/bilder/uebersicht_mitte_dark_selected.gif b/template/Deutsch/bilder/uebersicht_mitte_dark_selected.gif new file mode 100644 index 0000000..51dcf0e Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_mitte_dark_selected.gif differ diff --git a/template/Deutsch/bilder/uebersicht_mitte_selected.gif b/template/Deutsch/bilder/uebersicht_mitte_selected.gif new file mode 100644 index 0000000..73cb309 Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_mitte_selected.gif differ diff --git a/template/Deutsch/bilder/uebersicht_oben.gif b/template/Deutsch/bilder/uebersicht_oben.gif new file mode 100644 index 0000000..aee9a61 Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_oben.gif differ diff --git a/template/Deutsch/bilder/uebersicht_oben_links.gif b/template/Deutsch/bilder/uebersicht_oben_links.gif new file mode 100644 index 0000000..6cdadcc Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_oben_links.gif differ diff --git a/template/Deutsch/bilder/uebersicht_oben_links_selected.gif b/template/Deutsch/bilder/uebersicht_oben_links_selected.gif new file mode 100644 index 0000000..801b384 Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_oben_links_selected.gif differ diff --git a/template/Deutsch/bilder/uebersicht_oben_rechts.gif b/template/Deutsch/bilder/uebersicht_oben_rechts.gif new file mode 100644 index 0000000..9cff0fe Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_oben_rechts.gif differ diff --git a/template/Deutsch/bilder/uebersicht_oben_rechts_sele.gif b/template/Deutsch/bilder/uebersicht_oben_rechts_sele.gif new file mode 100644 index 0000000..7ef540f Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_oben_rechts_sele.gif differ diff --git a/template/Deutsch/bilder/uebersicht_oben_selected.gif b/template/Deutsch/bilder/uebersicht_oben_selected.gif new file mode 100644 index 0000000..38538fc Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_oben_selected.gif differ diff --git a/template/Deutsch/bilder/uebersicht_rechts.gif b/template/Deutsch/bilder/uebersicht_rechts.gif new file mode 100644 index 0000000..e53b69c Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_rechts.gif differ diff --git a/template/Deutsch/bilder/uebersicht_rechts_dark.gif b/template/Deutsch/bilder/uebersicht_rechts_dark.gif new file mode 100644 index 0000000..43d4c87 Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_rechts_dark.gif differ diff --git a/template/Deutsch/bilder/uebersicht_spacer.gif b/template/Deutsch/bilder/uebersicht_spacer.gif new file mode 100644 index 0000000..5bfd67a Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_spacer.gif differ diff --git a/template/Deutsch/bilder/uebersicht_unten.gif b/template/Deutsch/bilder/uebersicht_unten.gif new file mode 100644 index 0000000..6854d20 Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_unten.gif differ diff --git a/template/Deutsch/bilder/uebersicht_unten_links.gif b/template/Deutsch/bilder/uebersicht_unten_links.gif new file mode 100644 index 0000000..55d82db Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_unten_links.gif differ diff --git a/template/Deutsch/bilder/uebersicht_unten_rechts.gif b/template/Deutsch/bilder/uebersicht_unten_rechts.gif new file mode 100644 index 0000000..c836b47 Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_unten_rechts.gif differ diff --git a/template/Deutsch/bilder/uebersicht_unten_selected.gif b/template/Deutsch/bilder/uebersicht_unten_selected.gif new file mode 100644 index 0000000..6d0fe5f Binary files /dev/null and b/template/Deutsch/bilder/uebersicht_unten_selected.gif differ diff --git a/template/Deutsch/config.html b/template/Deutsch/config.html new file mode 100644 index 0000000..c1f7605 --- /dev/null +++ b/template/Deutsch/config.html @@ -0,0 +1,445 @@ + + + + + + + <tmpl_var titel> + + + + + +
+ + + + + + + +
+

Konfiguration

+ 		 Hilfe 
+
+ + + + + + + + + + + + + + +
+ + + + + + + + + + + + + + + + + +
Allgemeine Einstellungen:
+ + + + + + + + + + + + + + + + + + + +
Sprache / Template:
Startseite:
Anzahl der DVB Karten:
+ + + + + + + +
Skin:
 
+
+ + + + + + + + + + + + + + +
Identifikation:             
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Benutzername:
Passwort:
Gast Zugang: + ja nein + + ja nein +
Gast Benutzername:
Gast Passwort:
+
 
+
+ + + + + + + + + + + + + + +
Zeitleiste:              
+ + + + + + + + + + + + + +
Stunden:
Zeiten:
+
 
+ 		+ + + + + + + + + + + + + + +
Einstellungen für Auto Timer:
+ + + + + + + + + + + + + + + + + + + + + + + + + + +
 Auto Timer: + an aus + + an aus +
Timeout für Auto Timer: minuten
Lebenszeit für neuen Auto Timer:
Priorität für neuen Auto Timer:
 
+
+ + + + + + + + + + + + + + +
Einstellungen für Timer:
+ + + + + + + + + + + + + + + + + + + + + + + + + +
Lebenszeit für neuen Timer:
Priorität für neuen Timer:
Zeitpuffer Anfang: minuten
Zeitpuffer Ende: minuten
 
+
+ + + + + + + + + + + + + + + + + + + + +
Einstellungen für Streaming:
+ + + + + + + +
HTTP Port von StreamDev: (auch möglich 3000/ts)
+ + + + + + + +
Bandbreite des Streams:
+ + + + + + + +
Pfad der Aufnahmen:
 
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+
+ Selektive Kanalauswahl:
+ 		  +
+
in der Programmübersicht: + + ja nein + + ja nein + +
in "Was läuft jetzt?": + + ja nein + + ja nein + +
in "Auto Timer?": + + ja nein + + ja nein + +
+
+


+ + Alle Sender
+

+
+ 		+
+


+

+

+

+

+
+ 		+
+


+ + Angezeigte Sender
+

+
+
+
+ +
+ + + diff --git a/template/Deutsch/config.html.orig b/template/Deutsch/config.html.orig new file mode 100644 index 0000000..753f045 --- /dev/null +++ b/template/Deutsch/config.html.orig @@ -0,0 +1,335 @@ + + + + + + + <tmpl_var titel> + + + + + +
+ + + + + + + +
+

Konfiguration

+ 		 Hilfe 
+
+ + + + + + + + + + + + + + +
+ + + + + + + + + + + + + + +
Allgemeine Einstellungen:
+ + + + + + + + + + + + + + + + + + + +
Sprache / Template:
Startseite:
Anzahl der DVB Karten:
 
+
+ + + + + + + + + + + + + + +
Identifikation:             
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Benutzername:
Passwort:
Gast Zugang: + ja nein + + ja nein +
Gast Benutzername:
Gast Passwort:
+
 
+ 		+ + + + + + + + + + + + + + +
Einstellungen für Auto Timer:
+ + + + + + + + + + + + + + + + + + + + + + + + + + +
 Auto Timer: + an aus + + an aus +
Timeout für Auto Timer: minuten
Lebenszeit für neuen Auto Timer:
Priorität für neuen Auto Timer:
 
+
+ + + + + + + + + + + + + + +
Einstellungen für Timer:
+ + + + + + + + + + + + + + + + + + + + + + + + + +
Lebenszeit für neuen Timer:
Priorität für neuen Timer:
Zeitpuffer Anfang: minuten
Zeitpuffer Ende: minuten
 
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+
+ Selektive Kanalauswahl:
+ 		  +
+
in der Programmübersicht: + + ja nein + + ja nein + +
in "Was läuft jetzt?": + + ja nein + + ja nein + +
+
+


+ + Alle Sender
+

+
+ 		+
+


+

+

+

+

+
+ 		+
+


+ + Angezeigte Sender
+

+
+
+
+ +
+ + + diff --git a/template/Deutsch/copper/auge.jpg b/template/Deutsch/copper/auge.jpg new file mode 100755 index 0000000..d672cb5 Binary files /dev/null and b/template/Deutsch/copper/auge.jpg differ diff --git a/template/Deutsch/copper/back.gif b/template/Deutsch/copper/back.gif new file mode 100644 index 0000000..d0aaaef Binary files /dev/null and b/template/Deutsch/copper/back.gif differ diff --git a/template/Deutsch/copper/background.gif b/template/Deutsch/copper/background.gif new file mode 100644 index 0000000..39de587 Binary files /dev/null and b/template/Deutsch/copper/background.gif differ diff --git a/template/Deutsch/copper/cback.gif b/template/Deutsch/copper/cback.gif new file mode 100644 index 0000000..37d6a24 Binary files /dev/null and b/template/Deutsch/copper/cback.gif differ diff --git a/template/Deutsch/copper/cback.png b/template/Deutsch/copper/cback.png new file mode 100644 index 0000000..e5e274d Binary files /dev/null and b/template/Deutsch/copper/cback.png differ diff --git a/template/Deutsch/copper/delete.gif b/template/Deutsch/copper/delete.gif new file mode 100644 index 0000000..95df675 Binary files /dev/null and b/template/Deutsch/copper/delete.gif differ diff --git a/template/Deutsch/copper/edit.gif b/template/Deutsch/copper/edit.gif new file mode 100644 index 0000000..6b2f16f Binary files /dev/null and b/template/Deutsch/copper/edit.gif differ diff --git a/template/Deutsch/copper/fern_01.jpg b/template/Deutsch/copper/fern_01.jpg new file mode 100644 index 0000000..ac28f0e Binary files /dev/null and b/template/Deutsch/copper/fern_01.jpg differ diff --git a/template/Deutsch/copper/fern_02.jpg b/template/Deutsch/copper/fern_02.jpg new file mode 100644 index 0000000..80af1e7 Binary files /dev/null and b/template/Deutsch/copper/fern_02.jpg differ diff --git a/template/Deutsch/copper/fern_03.jpg b/template/Deutsch/copper/fern_03.jpg new file mode 100644 index 0000000..6f74128 Binary files /dev/null and b/template/Deutsch/copper/fern_03.jpg differ diff --git a/template/Deutsch/copper/fern_04.jpg b/template/Deutsch/copper/fern_04.jpg new file mode 100644 index 0000000..641fd1c Binary files /dev/null and b/template/Deutsch/copper/fern_04.jpg differ diff --git a/template/Deutsch/copper/fern_05.jpg b/template/Deutsch/copper/fern_05.jpg new file mode 100644 index 0000000..5366085 Binary files /dev/null and b/template/Deutsch/copper/fern_05.jpg differ diff --git a/template/Deutsch/copper/fern_06.jpg b/template/Deutsch/copper/fern_06.jpg new file mode 100644 index 0000000..0cd54f4 Binary files /dev/null and b/template/Deutsch/copper/fern_06.jpg differ diff --git a/template/Deutsch/copper/fern_07.jpg b/template/Deutsch/copper/fern_07.jpg new file mode 100644 index 0000000..96d586b Binary files /dev/null and b/template/Deutsch/copper/fern_07.jpg differ diff --git a/template/Deutsch/copper/fern_08.jpg b/template/Deutsch/copper/fern_08.jpg new file mode 100644 index 0000000..58d5cff Binary files /dev/null and b/template/Deutsch/copper/fern_08.jpg differ diff --git a/template/Deutsch/copper/fern_09.jpg b/template/Deutsch/copper/fern_09.jpg new file mode 100644 index 0000000..7042405 Binary files /dev/null and b/template/Deutsch/copper/fern_09.jpg differ diff --git a/template/Deutsch/copper/fern_10.jpg b/template/Deutsch/copper/fern_10.jpg new file mode 100644 index 0000000..07a881b Binary files /dev/null and b/template/Deutsch/copper/fern_10.jpg differ diff --git a/template/Deutsch/copper/fern_11.jpg b/template/Deutsch/copper/fern_11.jpg new file mode 100644 index 0000000..3cf54d3 Binary files /dev/null and b/template/Deutsch/copper/fern_11.jpg differ diff --git a/template/Deutsch/copper/fern_12.jpg b/template/Deutsch/copper/fern_12.jpg new file mode 100644 index 0000000..087e069 Binary files /dev/null and b/template/Deutsch/copper/fern_12.jpg differ diff --git a/template/Deutsch/copper/fern_13.jpg b/template/Deutsch/copper/fern_13.jpg new file mode 100644 index 0000000..3c8408f Binary files /dev/null and b/template/Deutsch/copper/fern_13.jpg differ diff --git a/template/Deutsch/copper/fern_14.jpg b/template/Deutsch/copper/fern_14.jpg new file mode 100644 index 0000000..9950ed0 Binary files /dev/null and b/template/Deutsch/copper/fern_14.jpg differ diff --git a/template/Deutsch/copper/fern_15.jpg b/template/Deutsch/copper/fern_15.jpg new file mode 100644 index 0000000..faf025b Binary files /dev/null and b/template/Deutsch/copper/fern_15.jpg differ diff --git a/template/Deutsch/copper/fern_16.jpg b/template/Deutsch/copper/fern_16.jpg new file mode 100644 index 0000000..1d366e8 Binary files /dev/null and b/template/Deutsch/copper/fern_16.jpg differ diff --git a/template/Deutsch/copper/fern_17.jpg b/template/Deutsch/copper/fern_17.jpg new file mode 100644 index 0000000..08030a8 Binary files /dev/null and b/template/Deutsch/copper/fern_17.jpg differ diff --git a/template/Deutsch/copper/fern_18.jpg b/template/Deutsch/copper/fern_18.jpg new file mode 100644 index 0000000..562d6ca Binary files /dev/null and b/template/Deutsch/copper/fern_18.jpg differ diff --git a/template/Deutsch/copper/fern_19.jpg b/template/Deutsch/copper/fern_19.jpg new file mode 100644 index 0000000..f7cc47e Binary files /dev/null and b/template/Deutsch/copper/fern_19.jpg differ diff --git a/template/Deutsch/copper/fern_20.jpg b/template/Deutsch/copper/fern_20.jpg new file mode 100644 index 0000000..6385d08 Binary files /dev/null and b/template/Deutsch/copper/fern_20.jpg differ diff --git a/template/Deutsch/copper/fern_21.jpg b/template/Deutsch/copper/fern_21.jpg new file mode 100644 index 0000000..89a2d18 Binary files /dev/null and b/template/Deutsch/copper/fern_21.jpg differ diff --git a/template/Deutsch/copper/fern_22.jpg b/template/Deutsch/copper/fern_22.jpg new file mode 100644 index 0000000..64f1bbb Binary files /dev/null and b/template/Deutsch/copper/fern_22.jpg differ diff --git a/template/Deutsch/copper/fern_23.jpg b/template/Deutsch/copper/fern_23.jpg new file mode 100644 index 0000000..71a8067 Binary files /dev/null and b/template/Deutsch/copper/fern_23.jpg differ diff --git a/template/Deutsch/copper/fern_24.jpg b/template/Deutsch/copper/fern_24.jpg new file mode 100644 index 0000000..4ee5fe6 Binary files /dev/null and b/template/Deutsch/copper/fern_24.jpg differ diff --git a/template/Deutsch/copper/fern_25.jpg b/template/Deutsch/copper/fern_25.jpg new file mode 100644 index 0000000..a7b740d Binary files /dev/null and b/template/Deutsch/copper/fern_25.jpg differ diff --git a/template/Deutsch/copper/fern_26.jpg b/template/Deutsch/copper/fern_26.jpg new file mode 100644 index 0000000..1ca6fd6 Binary files /dev/null and b/template/Deutsch/copper/fern_26.jpg differ diff --git a/template/Deutsch/copper/fern_27.jpg b/template/Deutsch/copper/fern_27.jpg new file mode 100644 index 0000000..0c297f9 Binary files /dev/null and b/template/Deutsch/copper/fern_27.jpg differ diff --git a/template/Deutsch/copper/fern_28.jpg b/template/Deutsch/copper/fern_28.jpg new file mode 100644 index 0000000..f5e9634 Binary files /dev/null and b/template/Deutsch/copper/fern_28.jpg differ diff --git a/template/Deutsch/copper/fern_29.jpg b/template/Deutsch/copper/fern_29.jpg new file mode 100644 index 0000000..06a59c5 Binary files /dev/null and b/template/Deutsch/copper/fern_29.jpg differ diff --git a/template/Deutsch/copper/fern_30.jpg b/template/Deutsch/copper/fern_30.jpg new file mode 100644 index 0000000..c71ebc5 Binary files /dev/null and b/template/Deutsch/copper/fern_30.jpg differ diff --git a/template/Deutsch/copper/fern_31.jpg b/template/Deutsch/copper/fern_31.jpg new file mode 100644 index 0000000..8e803bf Binary files /dev/null and b/template/Deutsch/copper/fern_31.jpg differ diff --git a/template/Deutsch/copper/fern_32.jpg b/template/Deutsch/copper/fern_32.jpg new file mode 100644 index 0000000..6e7bd4b Binary files /dev/null and b/template/Deutsch/copper/fern_32.jpg differ diff --git a/template/Deutsch/copper/fern_33.jpg b/template/Deutsch/copper/fern_33.jpg new file mode 100644 index 0000000..6a81652 Binary files /dev/null and b/template/Deutsch/copper/fern_33.jpg differ diff --git a/template/Deutsch/copper/fern_34.jpg b/template/Deutsch/copper/fern_34.jpg new file mode 100644 index 0000000..f9f9253 Binary files /dev/null and b/template/Deutsch/copper/fern_34.jpg differ diff --git a/template/Deutsch/copper/fern_35.jpg b/template/Deutsch/copper/fern_35.jpg new file mode 100644 index 0000000..f7038ff Binary files /dev/null and b/template/Deutsch/copper/fern_35.jpg differ diff --git a/template/Deutsch/copper/fern_36.jpg b/template/Deutsch/copper/fern_36.jpg new file mode 100644 index 0000000..f6aea92 Binary files /dev/null and b/template/Deutsch/copper/fern_36.jpg differ diff --git a/template/Deutsch/copper/fern_37.jpg b/template/Deutsch/copper/fern_37.jpg new file mode 100644 index 0000000..614c86a Binary files /dev/null and b/template/Deutsch/copper/fern_37.jpg differ diff --git a/template/Deutsch/copper/fern_38.jpg b/template/Deutsch/copper/fern_38.jpg new file mode 100644 index 0000000..120773e Binary files /dev/null and b/template/Deutsch/copper/fern_38.jpg differ diff --git a/template/Deutsch/copper/fern_39.jpg b/template/Deutsch/copper/fern_39.jpg new file mode 100644 index 0000000..75eac13 Binary files /dev/null and b/template/Deutsch/copper/fern_39.jpg differ diff --git a/template/Deutsch/copper/fern_40.jpg b/template/Deutsch/copper/fern_40.jpg new file mode 100644 index 0000000..ddc57db Binary files /dev/null and b/template/Deutsch/copper/fern_40.jpg differ diff --git a/template/Deutsch/copper/fern_41.jpg b/template/Deutsch/copper/fern_41.jpg new file mode 100644 index 0000000..4e4002e Binary files /dev/null and b/template/Deutsch/copper/fern_41.jpg differ diff --git a/template/Deutsch/copper/fern_42.jpg b/template/Deutsch/copper/fern_42.jpg new file mode 100644 index 0000000..9cd5047 Binary files /dev/null and b/template/Deutsch/copper/fern_42.jpg differ diff --git a/template/Deutsch/copper/fern_back.jpg b/template/Deutsch/copper/fern_back.jpg new file mode 100755 index 0000000..a9d0287 Binary files /dev/null and b/template/Deutsch/copper/fern_back.jpg differ diff --git a/template/Deutsch/copper/fernseher_unten.gif b/template/Deutsch/copper/fernseher_unten.gif new file mode 100644 index 0000000..9c25460 Binary files /dev/null and b/template/Deutsch/copper/fernseher_unten.gif differ diff --git a/template/Deutsch/copper/folder.gif b/template/Deutsch/copper/folder.gif new file mode 100644 index 0000000..768d8c9 Binary files /dev/null and b/template/Deutsch/copper/folder.gif differ diff --git a/template/Deutsch/copper/frame.gif b/template/Deutsch/copper/frame.gif new file mode 100644 index 0000000..4616aac Binary files /dev/null and b/template/Deutsch/copper/frame.gif differ diff --git a/template/Deutsch/copper/framed.gif b/template/Deutsch/copper/framed.gif new file mode 100644 index 0000000..de2bae9 Binary files /dev/null and b/template/Deutsch/copper/framed.gif differ diff --git a/template/Deutsch/copper/gbutton_left.gif b/template/Deutsch/copper/gbutton_left.gif new file mode 100644 index 0000000..3517596 Binary files /dev/null and b/template/Deutsch/copper/gbutton_left.gif differ diff --git a/template/Deutsch/copper/gbutton_middle.gif b/template/Deutsch/copper/gbutton_middle.gif new file mode 100644 index 0000000..e1e83f9 Binary files /dev/null and b/template/Deutsch/copper/gbutton_middle.gif differ diff --git a/template/Deutsch/copper/gbutton_right.gif b/template/Deutsch/copper/gbutton_right.gif new file mode 100644 index 0000000..fc9bbf1 Binary files /dev/null and b/template/Deutsch/copper/gbutton_right.gif differ diff --git a/template/Deutsch/copper/help.gif b/template/Deutsch/copper/help.gif new file mode 100644 index 0000000..d4fed67 Binary files /dev/null and b/template/Deutsch/copper/help.gif differ diff --git a/template/Deutsch/copper/hilfe.gif b/template/Deutsch/copper/hilfe.gif new file mode 100644 index 0000000..efdf704 Binary files /dev/null and b/template/Deutsch/copper/hilfe.gif differ diff --git a/template/Deutsch/copper/info.jpg b/template/Deutsch/copper/info.jpg new file mode 100755 index 0000000..b58efb8 Binary files /dev/null and b/template/Deutsch/copper/info.jpg differ diff --git a/template/Deutsch/copper/info_button.gif b/template/Deutsch/copper/info_button.gif new file mode 100644 index 0000000..bf81669 Binary files /dev/null and b/template/Deutsch/copper/info_button.gif differ diff --git a/template/Deutsch/copper/info_button_disabled.gif b/template/Deutsch/copper/info_button_disabled.gif new file mode 100644 index 0000000..f8029b7 Binary files /dev/null and b/template/Deutsch/copper/info_button_disabled.gif differ diff --git a/template/Deutsch/copper/linvdr.gif b/template/Deutsch/copper/linvdr.gif new file mode 100644 index 0000000..2196a8f Binary files /dev/null and b/template/Deutsch/copper/linvdr.gif differ diff --git a/template/Deutsch/copper/logo.gif b/template/Deutsch/copper/logo.gif new file mode 100644 index 0000000..1a3969a Binary files /dev/null and b/template/Deutsch/copper/logo.gif differ diff --git a/template/Deutsch/copper/luecke.gif b/template/Deutsch/copper/luecke.gif new file mode 100755 index 0000000..44bbac7 Binary files /dev/null and b/template/Deutsch/copper/luecke.gif differ diff --git a/template/Deutsch/copper/lupe.jpg b/template/Deutsch/copper/lupe.jpg new file mode 100755 index 0000000..2d84a81 Binary files /dev/null and b/template/Deutsch/copper/lupe.jpg differ diff --git a/template/Deutsch/copper/mitte.gif b/template/Deutsch/copper/mitte.gif new file mode 100644 index 0000000..8f01e3b Binary files /dev/null and b/template/Deutsch/copper/mitte.gif differ diff --git a/template/Deutsch/copper/nav_button_back.gif b/template/Deutsch/copper/nav_button_back.gif new file mode 100644 index 0000000..1f92ea2 Binary files /dev/null and b/template/Deutsch/copper/nav_button_back.gif differ diff --git a/template/Deutsch/copper/nav_button_back_end.gif b/template/Deutsch/copper/nav_button_back_end.gif new file mode 100644 index 0000000..d34de82 Binary files /dev/null and b/template/Deutsch/copper/nav_button_back_end.gif differ diff --git a/template/Deutsch/copper/nav_button_back_mitte.gif b/template/Deutsch/copper/nav_button_back_mitte.gif new file mode 100644 index 0000000..c071b14 Binary files /dev/null and b/template/Deutsch/copper/nav_button_back_mitte.gif differ diff --git a/template/Deutsch/copper/navi.css b/template/Deutsch/copper/navi.css new file mode 100644 index 0000000..16ca547 --- /dev/null +++ b/template/Deutsch/copper/navi.css @@ -0,0 +1,11 @@ +textarea { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, Geneva } +input { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, Geneva } +select { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, Geneva } +td { color: black; font-size: 11px; font-family: Verdana, Arial, Helvetica, Geneva } +p { color: black; font-size: 11px; font-family: Verdana, Arial, Helvetica, Geneva } +h1,h2,h3,h4,h5,h6 { color: black; font-family: Verdana, Arial, Helvetica, Geneva } +a { color: #000000; font-weight: bold; text-decoration : none } +.klein { font-size: 10px; font-family: Verdana, Arial, Helvetica, Geneva } +.small { font-size: 8px; font-family: Verdana, Arial, Helvetica, Geneva } +.navi { font-size: 10px; font-family: Verdana, Arial, Helvetica, Geneva } +a:hover { font-size: 13px; color: #ff0000 } diff --git a/template/Deutsch/copper/new_auto_timer.gif b/template/Deutsch/copper/new_auto_timer.gif new file mode 100644 index 0000000..2faae73 Binary files /dev/null and b/template/Deutsch/copper/new_auto_timer.gif differ diff --git a/template/Deutsch/copper/new_timer.gif b/template/Deutsch/copper/new_timer.gif new file mode 100644 index 0000000..3cd51c2 Binary files /dev/null and b/template/Deutsch/copper/new_timer.gif differ diff --git a/template/Deutsch/copper/pfeile_nachlinks.gif b/template/Deutsch/copper/pfeile_nachlinks.gif new file mode 100644 index 0000000..29c641a Binary files /dev/null and b/template/Deutsch/copper/pfeile_nachlinks.gif differ diff --git a/template/Deutsch/copper/pfeile_nachlinks_soft.gif b/template/Deutsch/copper/pfeile_nachlinks_soft.gif new file mode 100644 index 0000000..5474861 Binary files /dev/null and b/template/Deutsch/copper/pfeile_nachlinks_soft.gif differ diff --git a/template/Deutsch/copper/pfeile_nachrechts.gif b/template/Deutsch/copper/pfeile_nachrechts.gif new file mode 100644 index 0000000..6a936bb Binary files /dev/null and b/template/Deutsch/copper/pfeile_nachrechts.gif differ diff --git a/template/Deutsch/copper/pfeile_nachrechts_soft.gif b/template/Deutsch/copper/pfeile_nachrechts_soft.gif new file mode 100644 index 0000000..7ccf4f1 Binary files /dev/null and b/template/Deutsch/copper/pfeile_nachrechts_soft.gif differ diff --git a/template/Deutsch/copper/poempl_gelb.gif b/template/Deutsch/copper/poempl_gelb.gif new file mode 100644 index 0000000..37931ed Binary files /dev/null and b/template/Deutsch/copper/poempl_gelb.gif differ diff --git a/template/Deutsch/copper/poempl_gruen.gif b/template/Deutsch/copper/poempl_gruen.gif new file mode 100644 index 0000000..efd2998 Binary files /dev/null and b/template/Deutsch/copper/poempl_gruen.gif differ diff --git a/template/Deutsch/copper/poempl_rot.gif b/template/Deutsch/copper/poempl_rot.gif new file mode 100644 index 0000000..01eb502 Binary files /dev/null and b/template/Deutsch/copper/poempl_rot.gif differ diff --git a/template/Deutsch/copper/rec.gif b/template/Deutsch/copper/rec.gif new file mode 100644 index 0000000..12aa737 Binary files /dev/null and b/template/Deutsch/copper/rec.gif differ diff --git a/template/Deutsch/copper/rec.jpg b/template/Deutsch/copper/rec.jpg new file mode 100755 index 0000000..140e45b Binary files /dev/null and b/template/Deutsch/copper/rec.jpg differ diff --git a/template/Deutsch/copper/rec_button.gif b/template/Deutsch/copper/rec_button.gif new file mode 100644 index 0000000..57057be Binary files /dev/null and b/template/Deutsch/copper/rec_button.gif differ diff --git a/template/Deutsch/copper/rec_mitback.gif b/template/Deutsch/copper/rec_mitback.gif new file mode 100644 index 0000000..eaff79a Binary files /dev/null and b/template/Deutsch/copper/rec_mitback.gif differ diff --git a/template/Deutsch/copper/sauerei.gif b/template/Deutsch/copper/sauerei.gif new file mode 100644 index 0000000..1f9cfff Binary files /dev/null and b/template/Deutsch/copper/sauerei.gif differ diff --git a/template/Deutsch/copper/separator.gif b/template/Deutsch/copper/separator.gif new file mode 100644 index 0000000..2e76fda Binary files /dev/null and b/template/Deutsch/copper/separator.gif differ diff --git a/template/Deutsch/copper/sortiert_asc.gif b/template/Deutsch/copper/sortiert_asc.gif new file mode 100644 index 0000000..635929b Binary files /dev/null and b/template/Deutsch/copper/sortiert_asc.gif differ diff --git a/template/Deutsch/copper/sortiert_desc.gif b/template/Deutsch/copper/sortiert_desc.gif new file mode 100644 index 0000000..dd753f9 Binary files /dev/null and b/template/Deutsch/copper/sortiert_desc.gif differ diff --git a/template/Deutsch/copper/spacer.gif b/template/Deutsch/copper/spacer.gif new file mode 100644 index 0000000..5bfd67a Binary files /dev/null and b/template/Deutsch/copper/spacer.gif differ diff --git a/template/Deutsch/copper/style.css b/template/Deutsch/copper/style.css new file mode 100644 index 0000000..7b6cf9c --- /dev/null +++ b/template/Deutsch/copper/style.css @@ -0,0 +1,28 @@ +body { background: #c4cdd7 url(bilder/background.gif) } +td { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +.rec { font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +div { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +input { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +textarea { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +select { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +b { font-weight: bold } +i { font-style: italic } +a { color: #039; text-decoration: none } +a:visited { color: #039; text-decoration: none } +a:hover { color: #cc0000; text-decoration: underline } +a:active { color: #000; text-decoration: underline } +a.rec:link { color: #c00; text-decoration: none } +a.rec:visited { color: #000; text-decoration: none } +a.rec:hover { color: #cc0000; text-decoration: underline } +a.rec:active { color: #000; text-decoration: underline } +.headline { font-weight: bold; font-size: 14px; margin-top: 20px; margin-bottom: 20px } +.subheadline { color: #039; font-weight: bold } +.kleine { font-size: 10px } +.mini { font-size: 9px } +.rechts { text-align: right} +.einzug { margin: 10px 12px } +.einzug_ohnetop { margin-right: 12px; margin-left: 12px } +.einzug_liste { margin: 3px 5px 0px 5px } +.einzug_liste_headlines { margin-right: 5px; margin-left: 6px } +.einzugklein { color: #000; font-weight: normal; font-size: 10px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif; margin-right: 7px; margin-left: 7px } +.gbutton { color: black; font-weight: bold } diff --git a/template/Deutsch/copper/top.gif b/template/Deutsch/copper/top.gif new file mode 100644 index 0000000..58f2eff Binary files /dev/null and b/template/Deutsch/copper/top.gif differ diff --git a/template/Deutsch/copper/top_nav_aufnahmen.gif b/template/Deutsch/copper/top_nav_aufnahmen.gif new file mode 100644 index 0000000..b2d9db8 Binary files /dev/null and b/template/Deutsch/copper/top_nav_aufnahmen.gif differ diff --git a/template/Deutsch/copper/top_nav_fernbedienung.gif b/template/Deutsch/copper/top_nav_fernbedienung.gif new file mode 100644 index 0000000..e517c73 Binary files /dev/null and b/template/Deutsch/copper/top_nav_fernbedienung.gif differ diff --git a/template/Deutsch/copper/top_nav_konf.gif b/template/Deutsch/copper/top_nav_konf.gif new file mode 100644 index 0000000..7aa2b2a Binary files /dev/null and b/template/Deutsch/copper/top_nav_konf.gif differ diff --git a/template/Deutsch/copper/top_nav_prguebersicht.gif b/template/Deutsch/copper/top_nav_prguebersicht.gif new file mode 100644 index 0000000..05e14c7 Binary files /dev/null and b/template/Deutsch/copper/top_nav_prguebersicht.gif differ diff --git a/template/Deutsch/copper/top_nav_timer.gif b/template/Deutsch/copper/top_nav_timer.gif new file mode 100644 index 0000000..2ce2b16 Binary files /dev/null and b/template/Deutsch/copper/top_nav_timer.gif differ diff --git a/template/Deutsch/copper/top_nav_wasjetzt.gif b/template/Deutsch/copper/top_nav_wasjetzt.gif new file mode 100644 index 0000000..f206c4a Binary files /dev/null and b/template/Deutsch/copper/top_nav_wasjetzt.gif differ diff --git a/template/Deutsch/copper/tv_bottom.gif b/template/Deutsch/copper/tv_bottom.gif new file mode 100644 index 0000000..9c25460 Binary files /dev/null and b/template/Deutsch/copper/tv_bottom.gif differ diff --git a/template/Deutsch/copper/tv_umschalten_mitback.gif b/template/Deutsch/copper/tv_umschalten_mitback.gif new file mode 100644 index 0000000..89886e8 Binary files /dev/null and b/template/Deutsch/copper/tv_umschalten_mitback.gif differ diff --git a/template/Deutsch/copper/uebersicht_links.gif b/template/Deutsch/copper/uebersicht_links.gif new file mode 100644 index 0000000..ceca6b8 Binary files /dev/null and b/template/Deutsch/copper/uebersicht_links.gif differ diff --git a/template/Deutsch/copper/uebersicht_links_dark.gif b/template/Deutsch/copper/uebersicht_links_dark.gif new file mode 100644 index 0000000..55f0acb Binary files /dev/null and b/template/Deutsch/copper/uebersicht_links_dark.gif differ diff --git a/template/Deutsch/copper/uebersicht_mitte.gif b/template/Deutsch/copper/uebersicht_mitte.gif new file mode 100644 index 0000000..38151c9 Binary files /dev/null and b/template/Deutsch/copper/uebersicht_mitte.gif differ diff --git a/template/Deutsch/copper/uebersicht_mitte_dark.gif b/template/Deutsch/copper/uebersicht_mitte_dark.gif new file mode 100644 index 0000000..6a9b8ca Binary files /dev/null and b/template/Deutsch/copper/uebersicht_mitte_dark.gif differ diff --git a/template/Deutsch/copper/uebersicht_mitte_dark_selec.gif b/template/Deutsch/copper/uebersicht_mitte_dark_selec.gif new file mode 100644 index 0000000..6ee41aa Binary files /dev/null and b/template/Deutsch/copper/uebersicht_mitte_dark_selec.gif differ diff --git a/template/Deutsch/copper/uebersicht_mitte_selected.gif b/template/Deutsch/copper/uebersicht_mitte_selected.gif new file mode 100644 index 0000000..d7dc43f Binary files /dev/null and b/template/Deutsch/copper/uebersicht_mitte_selected.gif differ diff --git a/template/Deutsch/copper/uebersicht_oben.gif b/template/Deutsch/copper/uebersicht_oben.gif new file mode 100644 index 0000000..f083798 Binary files /dev/null and b/template/Deutsch/copper/uebersicht_oben.gif differ diff --git a/template/Deutsch/copper/uebersicht_oben_links.gif b/template/Deutsch/copper/uebersicht_oben_links.gif new file mode 100644 index 0000000..6a0f6fe Binary files /dev/null and b/template/Deutsch/copper/uebersicht_oben_links.gif differ diff --git a/template/Deutsch/copper/uebersicht_oben_links_selec.gif b/template/Deutsch/copper/uebersicht_oben_links_selec.gif new file mode 100644 index 0000000..e3182af Binary files /dev/null and b/template/Deutsch/copper/uebersicht_oben_links_selec.gif differ diff --git a/template/Deutsch/copper/uebersicht_oben_rechts.gif b/template/Deutsch/copper/uebersicht_oben_rechts.gif new file mode 100644 index 0000000..da51120 Binary files /dev/null and b/template/Deutsch/copper/uebersicht_oben_rechts.gif differ diff --git a/template/Deutsch/copper/uebersicht_oben_rechts_sele.gif b/template/Deutsch/copper/uebersicht_oben_rechts_sele.gif new file mode 100644 index 0000000..2a17d0f Binary files /dev/null and b/template/Deutsch/copper/uebersicht_oben_rechts_sele.gif differ diff --git a/template/Deutsch/copper/uebersicht_oben_selected.gif b/template/Deutsch/copper/uebersicht_oben_selected.gif new file mode 100644 index 0000000..24f3582 Binary files /dev/null and b/template/Deutsch/copper/uebersicht_oben_selected.gif differ diff --git a/template/Deutsch/copper/uebersicht_rechts.gif b/template/Deutsch/copper/uebersicht_rechts.gif new file mode 100644 index 0000000..613ad3a Binary files /dev/null and b/template/Deutsch/copper/uebersicht_rechts.gif differ diff --git a/template/Deutsch/copper/uebersicht_rechts_dark.gif b/template/Deutsch/copper/uebersicht_rechts_dark.gif new file mode 100644 index 0000000..a3044a7 Binary files /dev/null and b/template/Deutsch/copper/uebersicht_rechts_dark.gif differ diff --git a/template/Deutsch/copper/uebersicht_spacer.gif b/template/Deutsch/copper/uebersicht_spacer.gif new file mode 100644 index 0000000..5bfd67a Binary files /dev/null and b/template/Deutsch/copper/uebersicht_spacer.gif differ diff --git a/template/Deutsch/copper/uebersicht_unten.gif b/template/Deutsch/copper/uebersicht_unten.gif new file mode 100644 index 0000000..4558219 Binary files /dev/null and b/template/Deutsch/copper/uebersicht_unten.gif differ diff --git a/template/Deutsch/copper/uebersicht_unten_links.gif b/template/Deutsch/copper/uebersicht_unten_links.gif new file mode 100644 index 0000000..30c5451 Binary files /dev/null and b/template/Deutsch/copper/uebersicht_unten_links.gif differ diff --git a/template/Deutsch/copper/uebersicht_unten_rechts.gif b/template/Deutsch/copper/uebersicht_unten_rechts.gif new file mode 100644 index 0000000..3e7df25 Binary files /dev/null and b/template/Deutsch/copper/uebersicht_unten_rechts.gif differ diff --git a/template/Deutsch/copper/uebersicht_unten_selected.gif b/template/Deutsch/copper/uebersicht_unten_selected.gif new file mode 100644 index 0000000..e34901e Binary files /dev/null and b/template/Deutsch/copper/uebersicht_unten_selected.gif differ diff --git a/template/Deutsch/error.html b/template/Deutsch/error.html new file mode 100644 index 0000000..081e956 --- /dev/null +++ b/template/Deutsch/error.html @@ -0,0 +1,18 @@ + + + + + Error! + + + +
+
+ + +
+
+

+ + + diff --git a/template/Deutsch/favicon.ico b/template/Deutsch/favicon.ico new file mode 100644 index 0000000..4f30dbc Binary files /dev/null and b/template/Deutsch/favicon.ico differ diff --git a/template/Deutsch/i18n.pl b/template/Deutsch/i18n.pl new file mode 100644 index 0000000..b8af6c8 --- /dev/null +++ b/template/Deutsch/i18n.pl @@ -0,0 +1,67 @@ +## +# Deutsch +## +@I18N_Days = ( + "Sonntag", + "Montag", + "Dienstag", + "Mittwoch", + "Donnerstag", + "Freitag", + "Samstag" +); + +@I18N_Month = ( + "Januar", + "Februar", + "März", + "April", + "Mai", + "Juni", + "Juli", + "August", + "September", + "Oktober", + "November", + "Dezember" +); + +@LOGINPAGES_DESCRIPTION = ( + "Programmübersicht", + "Was läuft heute?", + "Was läuft jetzt?", + "Zeitleiste", + "Timer", + "Aufnahmen" +); + +%ERRORMESSAGE = ( + CONNECT_FAILED => "Konnte Verbindung zu %s nicht aufbauen!", + SEND_COMMAND => "Fehler beim Senden eines Kommandos zu %s", +); + +%COMMONMESSAGE = ( + OVERVIEW => "Übersicht", +); + +%HELP = ( + at_timer_list => +"Auto Timer:
+

Eine Übersicht aller Auto-Timer-Einträge.

+

Klicken Sie auf Ja oder Nein in der Spalte Aktiv, um den jeweiligen Eintrag an oder aus zu schalten.

+

Um einen Eintrag zu bearbeiten, klicken Sie auf das Symbol \"Stift\", zum Löschen auf \"Radiergummi\". Wenn Sie mehrere Auto-Timer-Einträge auf einmal löschen möchten, Aktivieren Sie die Kästchen () rechts neben den gewünschten Einträgen und klicken Sie abschließend auf Ausgewählte Auto Timer löschen am Ende der Liste.

", + at_timer_new => +"Neuen Auto Timer anlegen/bearbeiten:
+

Der Auto Timer ist eine der zentralen Funktionen VDR Admins. Ein Auto-Timer-Eintrag besteht hauptsächlich aus einem oder mehreren Suchbegriffen, nach denen in regelmäßigen Abständen der elektronische Programmführer (EPG) durchsucht wird. Bei Übereinstimmung der Suchbegriffe (und übrigen Parameter wie Uhrzeit und Kanal) programmiert Auto Timer selbständig eine Aufnahme (Timer) für die gefundene Sendung – das ist besonders für (un)regelmäßig gesendete Serien interessant, oder aber für Filme, die Sie keinesfalls verpassen wollen.

+

In dieser Maske können Sie einen neuen Auto-Timer-Eintrag anlegen. Sie müssen in jedem Fall einen oder mehrere Suchbegriffe angeben, damit es überhaupt zu Übereinstimmungen kommen kann. Details, welche Suchbegriffe Sie wählen sollten und wie Sie unsinnige Aufnahmen vermeiden, finden Sie in der Hilfe zu Suchbegriffe.

+Auto Timer Aktiv:
+

Mit ja schalten Sie den Auto Timer scharf, der elektronische Programmführer (EPG) wird dann regelmäßig nach Suchbegriffe durchsucht und ein neuer Timer-Eintrag programmiert, wenn es eine Übereinstimmung mit Suchbegriffe sowie den übrigen Parametern gibt.

+

Mit nein schalten Sie den Auto-Timer-Eintrag ab, ohne ihn zu löschen. Dies lässt bereits automatisch programmierte Aufnahmen (Timer) jedoch unangetastet – sie müssen gegebenenfalls von Hand im Timer-Menü gelöscht werden.

+Suchbegriffe:
+

Die Wahl der Suchbegriffe hat entscheidenden Einfluss darauf, ob nur die gewünschte Sendung, alle mit ähnlichem Namen oder gar nichts programmiert wird.

+

Zunächst einmal spielt Groß-Kleinschreibung keine Rolle, die Suchbegriffe \"Akte X\" liefern genau die selben Treffer wie \"akte x\". Mehrere Suchbegriffe werden mit Leerzeichen getrennt, und es müssen stets alle angegebenen Suchbegriffe bei der gleichen Sendung gefunden werden.

+

So finden die Suchbegriffe \"Akte X\" die Sendungen \"Akte X - Die unheimlichen Fälle des FBI\" genauso wie \"Aktenzeichen XY ungelöst\" und \"Extrem Aktiv\", jedoch nicht die Sendung \"Die Akte Jane\" (dort ist kein \"X\" enthalten).

+

Sie sollten möglichst nur Buchstaben und Zahlen als Suchbegriffe verwenden, erfahrungsgemäß fehlen im elektronischen Programmführer (EPG) gerne mal ein Punkt, Klammern oder sonstige Zeichen.

+

Es ist auch möglich, reguläre Ausdrücke zu verwenden – Experten mögen doch bitte die nötigen Infos dem Quelltext entnehmen (undocumented feature).

", + ENOHELPMSG => "Bisher keine Hilfe vorhanden. Zum Hinzufügen oder Ändern eines Textes bitte an linvdr\@linvdr.org wenden." +); diff --git a/template/Deutsch/index.html b/template/Deutsch/index.html new file mode 100644 index 0000000..394c273 --- /dev/null +++ b/template/Deutsch/index.html @@ -0,0 +1,23 @@ + + + + + + + VDR Admin <tmpl_var version> (<tmpl_var host>) + + + + + + + + + <body bgcolor="#ffffff"> + <p></p> + </body> + + + + + diff --git a/template/Deutsch/left.html b/template/Deutsch/left.html new file mode 100644 index 0000000..16f9e42 --- /dev/null +++ b/template/Deutsch/left.html @@ -0,0 +1,143 @@ + + + + + + + + + + + + +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

+
 
 Was läuft jetzt?
 Was läuft heute?
 Zeitleiste
 Programmübersicht
 Timer
 Auto Timer
 Aufnahmen
 Konfiguration
 Fernbedienung
 Fernseher
+  Suche nach:
 
+  
+
+ + + diff --git a/template/Deutsch/library.js b/template/Deutsch/library.js new file mode 100644 index 0000000..fdf4a0b --- /dev/null +++ b/template/Deutsch/library.js @@ -0,0 +1,26 @@ +// +// this is part of VDR Admin +// +function open_help(url) { + window.open(url, "_blank", "width=500, height=460, resizable=yes, scrollbars=yes, status=no, toolbar=no"); +} +function del(suffix) { + check=confirm("Timer löschen?"); + if(check) window.location.href=suffix; +} +function change(suffix) { + check=confirm("Timerstatus ändern?"); + if(check) window.location.href=suffix; +} +function mdel() { + check=confirm("Ausgewählte Timer wirklich löschen?"); + if(check) document.FormName.submit(); +} +function callurl( url ) { + image = new Image(); + image.src = url; +} +function popup(URL) { + window.open(URL, '_new', 'width=450, height=250, scrollbars=auto, resizable=yes'); +} + diff --git a/template/Deutsch/navi.css b/template/Deutsch/navi.css new file mode 100644 index 0000000..2700538 --- /dev/null +++ b/template/Deutsch/navi.css @@ -0,0 +1,11 @@ +textarea { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, Geneva } +input { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, Geneva } +select { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, Geneva } +td { color: black; font-size: 11px; font-family: Verdana, Arial, Helvetica, Geneva } +p { color: black; font-size: 11px; font-family: Verdana, Arial, Helvetica, Geneva } +h1,h2,h3,h4,h5,h6 { color: black; font-family: Verdana, Arial, Helvetica, Geneva } +a { color: #000000; font-weight: bold; text-decoration: none } +.klein { font-size: 10px; font-family: Verdana, Arial, Helvetica, Geneva } +.small { font-size: 8px; font-family: Verdana, Arial, Helvetica, Geneva } +.navi { font-size: 12px; font-family: Verdana, Arial, Helvetica, Geneva } +a:hover { font-weight: bold; text-decoration: underline } diff --git a/template/Deutsch/noauth.html b/template/Deutsch/noauth.html new file mode 100644 index 0000000..10eff18 --- /dev/null +++ b/template/Deutsch/noauth.html @@ -0,0 +1,13 @@ + + + Authorization Required + + + +

Authorization Required

+ +

This server could not verify that you are authorized to access the document requested. Either you supplied the wrong credentials (e.g., bad password), or your browser doesn't understand how to supply the credentials required.

+ + + + diff --git a/template/Deutsch/noperm.html b/template/Deutsch/noperm.html new file mode 100644 index 0000000..a0e4e49 --- /dev/null +++ b/template/Deutsch/noperm.html @@ -0,0 +1,12 @@ + + + <tmpl_var title> + + + +

+ +

+ + + diff --git a/template/Deutsch/prog_detail.html b/template/Deutsch/prog_detail.html new file mode 100644 index 0000000..a097629 --- /dev/null +++ b/template/Deutsch/prog_detail.html @@ -0,0 +1,40 @@ + + + + + + + <tmpl_var title> + + + + + + + + + + + + + + + + + + + + + +
| -
 

 +
+  [schließen] + +  [umschalten] +  [aufnehmen] +  [wiederholungen] + + 		 
+ + + diff --git a/template/Deutsch/prog_list.html b/template/Deutsch/prog_list.html new file mode 100644 index 0000000..35f6681 --- /dev/null +++ b/template/Deutsch/prog_list.html @@ -0,0 +1,95 @@ + + + + + + + + + + + + +
+ + + + + + +
+

+    + +

+ 		Programmauswahl:  +   + +  
+ +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

+ 		+

+
      
  +

- Uhr

+ 		+



+ 		+

+ 		+

+ 		 
    
+
+ + + + + diff --git a/template/Deutsch/prog_list2.html b/template/Deutsch/prog_list2.html new file mode 100644 index 0000000..d22ae10 --- /dev/null +++ b/template/Deutsch/prog_list2.html @@ -0,0 +1,108 @@ + + + + + + + + + + + + +
+ + + + + + +
+

+ 		Programmauswahl:  +   + +  
+ +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

+ 		+

+
      
  +

- Uhr

+ 		+



+ 		+

+ 		+

+ 		 
    
+
+ + + + + diff --git a/template/Deutsch/prog_summary.html b/template/Deutsch/prog_summary.html new file mode 100644 index 0000000..60405b6 --- /dev/null +++ b/template/Deutsch/prog_summary.html @@ -0,0 +1,118 @@ + + + + + + + + VDRAdmin - Was läuft jetzt? + + + + + +
+ + + + + + + +
+

+ 		Was läuft: jetzt | um:  + + +  
+
+ + + + + + + + + + + + + + + + + + + + + + +
+ + + + + +
+ +

+

+

-

+
+
+
+
+ mehr +
+
+
+ 		+
+ + + + + + + + + + + + + + + + +
+ + TV - umschalten + + + + Nach wiederholungen suchen + + + mehr Infos + + + + + + Sendung aufnehmen +
+ 		+
+
+ + diff --git a/template/Deutsch/prog_timeline.html b/template/Deutsch/prog_timeline.html new file mode 100755 index 0000000..836c992 --- /dev/null +++ b/template/Deutsch/prog_timeline.html @@ -0,0 +1,229 @@ + + + + + + + VDRAdmin - Was läuft jetzt? + + + + + + + + +
+ + + + + + + +
+

+ 		Was läuft:  + + | um: + + + +  
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

+ 		Timeline: bis
      
  + + + + + + + + + + + + + + + + +

 +
+ + +

+ + + + + +
+ + + + + + + + + +
+
+ + 		bis_minute; stop_minute = bis_minute; END; + + laenge = stop_minute - start_minute; + laenge_pix = laenge * einheit; + laenge_chars = ((laenge_pix / 10) + 0.5) | format('%i'); + NEXT IF start_minute >= bis_minute; + IF start_minute >= old_stop_minute; + start_minute = start_minute + 1 IF start_minute == old_stop_minute; + %?> + + akt_minute && ! z %?> + + + +
+ +
+ + + + + + + show.start && date.now < show.stop ? "#f7fffA" : "#e6eee9"; + bg_color = show.timer ? "#ffeee9" : bg_color %?> + "> +
+
+ + + 2 %?> + + + + + +
+ +
+ + + 		 
    
+
+ + + diff --git a/template/Deutsch/rc.html b/template/Deutsch/rc.html new file mode 100644 index 0000000..9aad289 --- /dev/null +++ b/template/Deutsch/rc.html @@ -0,0 +1,110 @@ + + + + + + + <tmpl_var host> - Fernbedienung + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + diff --git a/template/Deutsch/rec_edit.html b/template/Deutsch/rec_edit.html new file mode 100644 index 0000000..2449506 --- /dev/null +++ b/template/Deutsch/rec_edit.html @@ -0,0 +1,65 @@ + + + + VDRAdmin - Aufnahme Umbenennen + + + + +
+ + + + + + + +

Aufnahme Umbenennen

  
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    
    
 Alter Titel der Aufnahme 
 Neuer Titel der Aufnahme 
    
+
+
+
+ + + + + + +
+
+ + + diff --git a/template/Deutsch/rec_list.html b/template/Deutsch/rec_list.html new file mode 100644 index 0000000..86638c1 --- /dev/null +++ b/template/Deutsch/rec_list.html @@ -0,0 +1,132 @@ + + + + + + + + + + + + + + + + + + + +
+

Aufnahmen

+ 		  + + Total: + + ( + + ) | Frei: + + ( + + ) +   + Hilfe 
+
+ + + + +
  >>
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

+

  Datum

  Uhrzeit

  Name

+ 		    
  +

+ 		+

Gesamt

+ 		+

+ 		+

Neu Neu

+ 		+

 

+ 		+

+ 		+

+ 		+

+ 		+

+ 		 
            
     
+ + + + + + +
+ +
Ausgewählte Aufnahmen löschen
 + +
+ 		 
+ +
+
+ + + diff --git a/template/Deutsch/style.css b/template/Deutsch/style.css new file mode 100644 index 0000000..96cf065 --- /dev/null +++ b/template/Deutsch/style.css @@ -0,0 +1,28 @@ +body { background: #c4cdd7 url(bilder/background.gif) repeat-x } +td { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +.rec { font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +div { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +input { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +textarea { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +select { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +b { font-weight: bold } +i { font-style: italic } +a { color: #039; text-decoration: none } +a:visited { color: #039; text-decoration: none } +a:hover { color: #cc0000; text-decoration: underline } +a:active { color: #000; text-decoration: underline } +a.rec:link { color: #c00; text-decoration: none } +a.rec:visited { color: #000; text-decoration: none } +a.rec:hover { color: #cc0000; text-decoration: underline } +a.rec:active { color: #000; text-decoration: underline } +.headline { font-weight: bold; font-size: 14px; margin-top: 20px; margin-bottom: 20px } +.subheadline { color: #039; font-weight: bold } +.kleine { font-size: 10px } +.mini { font-size: 9px } +.rechts { text-align: right} +.einzug { margin: 10px 12px } +.einzug_ohnetop { margin-right: 12px; margin-left: 12px } +.einzug_liste { margin: 3px 5px 0px 5px } +.einzug_liste_headlines { margin-right: 5px; margin-left: 6px } +.einzugklein { color: #000; font-weight: normal; font-size: 10px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif; margin-right: 7px; margin-left: 7px } +.gbutton { color: black; font-weight: bold } diff --git a/template/Deutsch/timer_list.html b/template/Deutsch/timer_list.html new file mode 100644 index 0000000..dfea3fb --- /dev/null +++ b/template/Deutsch/timer_list.html @@ -0,0 +1,304 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +
+

Timer

+ 		  + + + + + + +
+ +
Neuer Timer
 + +
+ 		+ Hilfe 
+ +
+
+ + + + + + + + + + + + + + + + + +
+

+ 		+

+ 		+ +
  +
+ + + + + + + +

 
+= current; + bgfarbe=((programm % 2) == 0) ? farbenix1 : farbenix2; + sender=timer.cdesc; +%?> +
+ + + += current; + IF sendung.active == 0 || sendung.active == 32768; + progfarbe=farbeinaktiv; + ELSE; + IF sendung.critical == 1; + progfarbe=farbekonflikt; + ELSE; + progfarbe=farbesendung; + END; + END; + IF sendung.starttime < current; + start=0; + ELSE; + start=((sendung.startlong / faktor) + 0.5 ) | format('%i'); + END; + IF sendung.stoptime > current; + ende=tablaenge; + ELSE; + ende=(((sendung.stoplong + 1) / faktor) + 0.5 ) | format('%i'); + END; + NEXT IF ende <= start; + + IF start>pos; +%?> + + + + + + + + + +



+ +
+ 		 
 
+ +
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

+ 		+

  Aktiv

+ 		+

  Sender

+ 		+

  Tag

+ 		+

  Start

+ 		+

  Stop

+ 		+

  Name

+ 		   
  +

+ + Diese Aufnahme ist deaktiviert + + + Diese Aufnahme ist nicht möglich! + + + Keine weitere Aufnahme möglich! + + + Aufnahme möglich! + + + + + +  +Ja +Nein +VPS +Auto + +

+ 		+

+ 		+

+ 		+

+ 		+

+ 		+

+ 		+

+ 		+

+ 		+

+ 		 
          

+ + + + + + +
+ +
Ausgewählte Timer löschen
 + +
+
+ + diff --git a/template/Deutsch/timer_new.html b/template/Deutsch/timer_new.html new file mode 100644 index 0000000..05edd42 --- /dev/null +++ b/template/Deutsch/timer_new.html @@ -0,0 +1,181 @@ + + + + + VDRAdmin - <tmpl_if newtimer>Neuen Timer anlegen<tmpl_else>Timer editieren</tmpl_if> + + + + + + +
+ + + + + + + +
+

Neuen Timer anlegenTimer editieren

+ 		  + + Hilfe + +  
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  
Timer Aktiv + + ja + nein + + ja + nein + +
Automatische Timer-Überwachung + + Sendungs-Kennung + + checked>Uhrzeit + checked>nicht verwenden +
Sender + +
Tag der Aufnahme + +
+ Montag + Dienstag + Mittwoch + Donnerstag + Freitag + Samstag + Sonntag +
Startzeit + + : + +
Endzeit + + : + +
Priorität
Lifetime
Titel der Aufnahme
Zusammenfassung
+
+
+
+
+ + + + + + + +
+ + + diff --git a/template/Deutsch/toolbar.html b/template/Deutsch/toolbar.html new file mode 100644 index 0000000..596874f --- /dev/null +++ b/template/Deutsch/toolbar.html @@ -0,0 +1,40 @@ + + + + + + + Toolbar + + + +
+ + + + + + + + + + + + + +
+   +
+

+
+ + + diff --git a/template/Deutsch/tv.html b/template/Deutsch/tv.html new file mode 100644 index 0000000..795bfd3 --- /dev/null +++ b/template/Deutsch/tv.html @@ -0,0 +1,153 @@ + + + Fernseher (<tmpl_var host>) + + + + + + +
+ + + + + + +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  
+ + + + +
  
  
+ + +
 
 
Intervall:
+
Größe:
+
+
+
+ + diff --git a/template/Deutsch/tv.html.bak b/template/Deutsch/tv.html.bak new file mode 100644 index 0000000..e5609c1 --- /dev/null +++ b/template/Deutsch/tv.html.bak @@ -0,0 +1,139 @@ + + + Fernseher (<tmpl_var host>) + + + + + + +
+ + + + + + +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  
+ + + + +
  
  
+ + +
 
 
Intervall:
+
+
+
+ + diff --git a/template/Deutsch/tv_flash.html b/template/Deutsch/tv_flash.html new file mode 100644 index 0000000..49ed7c8 --- /dev/null +++ b/template/Deutsch/tv_flash.html @@ -0,0 +1,14 @@ + + + Fernseher (<tmpl_var host>) + + + + + + + + + + + diff --git a/template/English/at_new.html b/template/English/at_new.html new file mode 100644 index 0000000..87e3482 --- /dev/null +++ b/template/English/at_new.html @@ -0,0 +1,158 @@ + + + + + + + + + +
+ + + + + + + +
+

New Auto TimerEdit Auto Timer

+ 		   
+
+ + + + + + + + + + + + + + +
 
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
 Auto Timer Active: + + yes no + + + yes no + + +
 Search Pattern:
 Search in: + + + + + + + + + Title + + + + + + + + + + Subtitle + + + + + + + + + + Description
 Channel:
 Starts After:: Uhr
 Ends Before:: Uhr
 Priority:
 Lifetime:
 Episode: + + + + + + + +
 Directory:
+
 
+
+ +
+ + + diff --git a/template/English/at_timer_list.html b/template/English/at_timer_list.html new file mode 100644 index 0000000..ece4513 --- /dev/null +++ b/template/English/at_timer_list.html @@ -0,0 +1,173 @@ + + + + + + + + + + + + + + + + + + + + +
+

Auto Timer

+ 		  + + + + + + +
+ +
New Auto Timer
 + +
+ 		 
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

+ 		+

  Active

+ 		+

  Channel

+ 		+

  Start

+ 		+

  Stop

+ 		+

  Name

+ 		   
  +

+   Yes No +

+ 		+

+ + + + - +

+ 		+

+ + + + - + +

+ 		+

+ + + + - + +

+ 		+

+ 		+

+ 		+

+ 		+

+ 		 
         
+ +
+ + + + + +
+ +
Force Update
 + +

+ + + + + + +
+ +
Delete selected Auto Timers
 + +
+
+ +
+ + + diff --git a/template/English/bilder/back.gif b/template/English/bilder/back.gif new file mode 100644 index 0000000..1b514e1 Binary files /dev/null and b/template/English/bilder/back.gif differ diff --git a/template/English/bilder/back.png b/template/English/bilder/back.png new file mode 100644 index 0000000..f2e072e Binary files /dev/null and b/template/English/bilder/back.png differ diff --git a/template/English/bilder/background.gif b/template/English/bilder/background.gif new file mode 100644 index 0000000..700c597 Binary files /dev/null and b/template/English/bilder/background.gif differ diff --git a/template/English/bilder/cback.png b/template/English/bilder/cback.png new file mode 100644 index 0000000..b2ffaf9 Binary files /dev/null and b/template/English/bilder/cback.png differ diff --git a/template/English/bilder/delete.gif b/template/English/bilder/delete.gif new file mode 100644 index 0000000..21b74a4 Binary files /dev/null and b/template/English/bilder/delete.gif differ diff --git a/template/English/bilder/edit.gif b/template/English/bilder/edit.gif new file mode 100644 index 0000000..88aa3d1 Binary files /dev/null and b/template/English/bilder/edit.gif differ diff --git a/template/English/bilder/favicon.ico b/template/English/bilder/favicon.ico new file mode 100644 index 0000000..a4fe6df Binary files /dev/null and b/template/English/bilder/favicon.ico differ diff --git a/template/English/bilder/fern_01.jpg b/template/English/bilder/fern_01.jpg new file mode 100644 index 0000000..112d9f6 Binary files /dev/null and b/template/English/bilder/fern_01.jpg differ diff --git a/template/English/bilder/fern_02.jpg b/template/English/bilder/fern_02.jpg new file mode 100644 index 0000000..aa8c973 Binary files /dev/null and b/template/English/bilder/fern_02.jpg differ diff --git a/template/English/bilder/fern_03.jpg b/template/English/bilder/fern_03.jpg new file mode 100644 index 0000000..dc898fd Binary files /dev/null and b/template/English/bilder/fern_03.jpg differ diff --git a/template/English/bilder/fern_04.jpg b/template/English/bilder/fern_04.jpg new file mode 100644 index 0000000..60466f6 Binary files /dev/null and b/template/English/bilder/fern_04.jpg differ diff --git a/template/English/bilder/fern_05.jpg b/template/English/bilder/fern_05.jpg new file mode 100644 index 0000000..de4fefe Binary files /dev/null and b/template/English/bilder/fern_05.jpg differ diff --git a/template/English/bilder/fern_06.jpg b/template/English/bilder/fern_06.jpg new file mode 100644 index 0000000..e2ec172 Binary files /dev/null and b/template/English/bilder/fern_06.jpg differ diff --git a/template/English/bilder/fern_07.jpg b/template/English/bilder/fern_07.jpg new file mode 100644 index 0000000..479dfc7 Binary files /dev/null and b/template/English/bilder/fern_07.jpg differ diff --git a/template/English/bilder/fern_08.jpg b/template/English/bilder/fern_08.jpg new file mode 100644 index 0000000..46edd48 Binary files /dev/null and b/template/English/bilder/fern_08.jpg differ diff --git a/template/English/bilder/fern_09.jpg b/template/English/bilder/fern_09.jpg new file mode 100644 index 0000000..144ab3f Binary files /dev/null and b/template/English/bilder/fern_09.jpg differ diff --git a/template/English/bilder/fern_10.jpg b/template/English/bilder/fern_10.jpg new file mode 100644 index 0000000..21a4612 Binary files /dev/null and b/template/English/bilder/fern_10.jpg differ diff --git a/template/English/bilder/fern_11.jpg b/template/English/bilder/fern_11.jpg new file mode 100644 index 0000000..d277804 Binary files /dev/null and b/template/English/bilder/fern_11.jpg differ diff --git a/template/English/bilder/fern_12.jpg b/template/English/bilder/fern_12.jpg new file mode 100644 index 0000000..2342bb1 Binary files /dev/null and b/template/English/bilder/fern_12.jpg differ diff --git a/template/English/bilder/fern_13.jpg b/template/English/bilder/fern_13.jpg new file mode 100644 index 0000000..ab2b3a4 Binary files /dev/null and b/template/English/bilder/fern_13.jpg differ diff --git a/template/English/bilder/fern_14.jpg b/template/English/bilder/fern_14.jpg new file mode 100644 index 0000000..7522563 Binary files /dev/null and b/template/English/bilder/fern_14.jpg differ diff --git a/template/English/bilder/fern_15.jpg b/template/English/bilder/fern_15.jpg new file mode 100644 index 0000000..58e7438 Binary files /dev/null and b/template/English/bilder/fern_15.jpg differ diff --git a/template/English/bilder/fern_16.jpg b/template/English/bilder/fern_16.jpg new file mode 100644 index 0000000..1a0a077 Binary files /dev/null and b/template/English/bilder/fern_16.jpg differ diff --git a/template/English/bilder/fern_17.jpg b/template/English/bilder/fern_17.jpg new file mode 100644 index 0000000..69db0f5 Binary files /dev/null and b/template/English/bilder/fern_17.jpg differ diff --git a/template/English/bilder/fern_18.jpg b/template/English/bilder/fern_18.jpg new file mode 100644 index 0000000..c1543d6 Binary files /dev/null and b/template/English/bilder/fern_18.jpg differ diff --git a/template/English/bilder/fern_19.jpg b/template/English/bilder/fern_19.jpg new file mode 100644 index 0000000..5f777a9 Binary files /dev/null and b/template/English/bilder/fern_19.jpg differ diff --git a/template/English/bilder/fern_20.jpg b/template/English/bilder/fern_20.jpg new file mode 100644 index 0000000..2bc0762 Binary files /dev/null and b/template/English/bilder/fern_20.jpg differ diff --git a/template/English/bilder/fern_21.jpg b/template/English/bilder/fern_21.jpg new file mode 100644 index 0000000..757c2b4 Binary files /dev/null and b/template/English/bilder/fern_21.jpg differ diff --git a/template/English/bilder/fern_22.jpg b/template/English/bilder/fern_22.jpg new file mode 100644 index 0000000..9537044 Binary files /dev/null and b/template/English/bilder/fern_22.jpg differ diff --git a/template/English/bilder/fern_23.jpg b/template/English/bilder/fern_23.jpg new file mode 100644 index 0000000..8a97144 Binary files /dev/null and b/template/English/bilder/fern_23.jpg differ diff --git a/template/English/bilder/fern_24.jpg b/template/English/bilder/fern_24.jpg new file mode 100644 index 0000000..831a23d Binary files /dev/null and b/template/English/bilder/fern_24.jpg differ diff --git a/template/English/bilder/fern_25.jpg b/template/English/bilder/fern_25.jpg new file mode 100644 index 0000000..92d08ec Binary files /dev/null and b/template/English/bilder/fern_25.jpg differ diff --git a/template/English/bilder/fern_26.jpg b/template/English/bilder/fern_26.jpg new file mode 100644 index 0000000..0e3afed Binary files /dev/null and b/template/English/bilder/fern_26.jpg differ diff --git a/template/English/bilder/fern_27.jpg b/template/English/bilder/fern_27.jpg new file mode 100644 index 0000000..d55b445 Binary files /dev/null and b/template/English/bilder/fern_27.jpg differ diff --git a/template/English/bilder/fern_28.jpg b/template/English/bilder/fern_28.jpg new file mode 100644 index 0000000..f72f876 Binary files /dev/null and b/template/English/bilder/fern_28.jpg differ diff --git a/template/English/bilder/fern_29.jpg b/template/English/bilder/fern_29.jpg new file mode 100644 index 0000000..5952b08 Binary files /dev/null and b/template/English/bilder/fern_29.jpg differ diff --git a/template/English/bilder/fern_30.jpg b/template/English/bilder/fern_30.jpg new file mode 100644 index 0000000..15fb695 Binary files /dev/null and b/template/English/bilder/fern_30.jpg differ diff --git a/template/English/bilder/fern_31.jpg b/template/English/bilder/fern_31.jpg new file mode 100644 index 0000000..0057f36 Binary files /dev/null and b/template/English/bilder/fern_31.jpg differ diff --git a/template/English/bilder/fern_32.jpg b/template/English/bilder/fern_32.jpg new file mode 100644 index 0000000..9551a4b Binary files /dev/null and b/template/English/bilder/fern_32.jpg differ diff --git a/template/English/bilder/fern_33.jpg b/template/English/bilder/fern_33.jpg new file mode 100644 index 0000000..8d44785 Binary files /dev/null and b/template/English/bilder/fern_33.jpg differ diff --git a/template/English/bilder/fern_34.jpg b/template/English/bilder/fern_34.jpg new file mode 100644 index 0000000..8db1ebc Binary files /dev/null and b/template/English/bilder/fern_34.jpg differ diff --git a/template/English/bilder/fern_35.jpg b/template/English/bilder/fern_35.jpg new file mode 100644 index 0000000..74e68a0 Binary files /dev/null and b/template/English/bilder/fern_35.jpg differ diff --git a/template/English/bilder/fern_36.jpg b/template/English/bilder/fern_36.jpg new file mode 100644 index 0000000..db7dc6e Binary files /dev/null and b/template/English/bilder/fern_36.jpg differ diff --git a/template/English/bilder/fern_37.jpg b/template/English/bilder/fern_37.jpg new file mode 100644 index 0000000..0ad6453 Binary files /dev/null and b/template/English/bilder/fern_37.jpg differ diff --git a/template/English/bilder/fern_38.jpg b/template/English/bilder/fern_38.jpg new file mode 100644 index 0000000..3b4e41e Binary files /dev/null and b/template/English/bilder/fern_38.jpg differ diff --git a/template/English/bilder/fern_39.jpg b/template/English/bilder/fern_39.jpg new file mode 100644 index 0000000..c68ba21 Binary files /dev/null and b/template/English/bilder/fern_39.jpg differ diff --git a/template/English/bilder/fern_40.jpg b/template/English/bilder/fern_40.jpg new file mode 100644 index 0000000..c7c01ed Binary files /dev/null and b/template/English/bilder/fern_40.jpg differ diff --git a/template/English/bilder/fern_41.jpg b/template/English/bilder/fern_41.jpg new file mode 100644 index 0000000..c9b8784 Binary files /dev/null and b/template/English/bilder/fern_41.jpg differ diff --git a/template/English/bilder/fern_42.jpg b/template/English/bilder/fern_42.jpg new file mode 100644 index 0000000..2f63a66 Binary files /dev/null and b/template/English/bilder/fern_42.jpg differ diff --git a/template/English/bilder/fern_back.jpg b/template/English/bilder/fern_back.jpg new file mode 100644 index 0000000..4b9eb7c Binary files /dev/null and b/template/English/bilder/fern_back.jpg differ diff --git a/template/English/bilder/fernseher_unten.gif b/template/English/bilder/fernseher_unten.gif new file mode 100644 index 0000000..43219e3 Binary files /dev/null and b/template/English/bilder/fernseher_unten.gif differ diff --git a/template/English/bilder/folder.gif b/template/English/bilder/folder.gif new file mode 100644 index 0000000..e3c45a5 Binary files /dev/null and b/template/English/bilder/folder.gif differ diff --git a/template/English/bilder/frame.png b/template/English/bilder/frame.png new file mode 100644 index 0000000..94485e2 Binary files /dev/null and b/template/English/bilder/frame.png differ diff --git a/template/English/bilder/framed.gif b/template/English/bilder/framed.gif new file mode 100644 index 0000000..0adecf2 Binary files /dev/null and b/template/English/bilder/framed.gif differ diff --git a/template/English/bilder/gbutton_left.gif b/template/English/bilder/gbutton_left.gif new file mode 100644 index 0000000..41672a3 Binary files /dev/null and b/template/English/bilder/gbutton_left.gif differ diff --git a/template/English/bilder/gbutton_middle.gif b/template/English/bilder/gbutton_middle.gif new file mode 100644 index 0000000..07192d9 Binary files /dev/null and b/template/English/bilder/gbutton_middle.gif differ diff --git a/template/English/bilder/gbutton_right.gif b/template/English/bilder/gbutton_right.gif new file mode 100644 index 0000000..d5a55e7 Binary files /dev/null and b/template/English/bilder/gbutton_right.gif differ diff --git a/template/English/bilder/help.gif b/template/English/bilder/help.gif new file mode 100644 index 0000000..095f28a Binary files /dev/null and b/template/English/bilder/help.gif differ diff --git a/template/English/bilder/hilfe.gif b/template/English/bilder/hilfe.gif new file mode 100644 index 0000000..8f14289 Binary files /dev/null and b/template/English/bilder/hilfe.gif differ diff --git a/template/English/bilder/info_button.gif b/template/English/bilder/info_button.gif new file mode 100644 index 0000000..3ae6142 Binary files /dev/null and b/template/English/bilder/info_button.gif differ diff --git a/template/English/bilder/info_button_disabled.gif b/template/English/bilder/info_button_disabled.gif new file mode 100644 index 0000000..33912a1 Binary files /dev/null and b/template/English/bilder/info_button_disabled.gif differ diff --git a/template/English/bilder/linvdr.gif b/template/English/bilder/linvdr.gif new file mode 100644 index 0000000..d9d0398 Binary files /dev/null and b/template/English/bilder/linvdr.gif differ diff --git a/template/English/bilder/logo.gif b/template/English/bilder/logo.gif new file mode 100644 index 0000000..dfbcd2e Binary files /dev/null and b/template/English/bilder/logo.gif differ diff --git a/template/English/bilder/mitte.gif b/template/English/bilder/mitte.gif new file mode 100644 index 0000000..92ec6ad Binary files /dev/null and b/template/English/bilder/mitte.gif differ diff --git a/template/English/bilder/nav_button_back.gif b/template/English/bilder/nav_button_back.gif new file mode 100644 index 0000000..9287c7e Binary files /dev/null and b/template/English/bilder/nav_button_back.gif differ diff --git a/template/English/bilder/nav_button_back_end.gif b/template/English/bilder/nav_button_back_end.gif new file mode 100644 index 0000000..b65f4ba Binary files /dev/null and b/template/English/bilder/nav_button_back_end.gif differ diff --git a/template/English/bilder/nav_button_back_mitte.gif b/template/English/bilder/nav_button_back_mitte.gif new file mode 100644 index 0000000..c6390f4 Binary files /dev/null and b/template/English/bilder/nav_button_back_mitte.gif differ diff --git a/template/English/bilder/new_auto_timer.gif b/template/English/bilder/new_auto_timer.gif new file mode 100644 index 0000000..576a062 Binary files /dev/null and b/template/English/bilder/new_auto_timer.gif differ diff --git a/template/English/bilder/new_timer.gif b/template/English/bilder/new_timer.gif new file mode 100644 index 0000000..5658326 Binary files /dev/null and b/template/English/bilder/new_timer.gif differ diff --git a/template/English/bilder/pfeile_nachlinks.gif b/template/English/bilder/pfeile_nachlinks.gif new file mode 100644 index 0000000..867fc2c Binary files /dev/null and b/template/English/bilder/pfeile_nachlinks.gif differ diff --git a/template/English/bilder/pfeile_nachlinks_soft.gif b/template/English/bilder/pfeile_nachlinks_soft.gif new file mode 100644 index 0000000..854d380 Binary files /dev/null and b/template/English/bilder/pfeile_nachlinks_soft.gif differ diff --git a/template/English/bilder/pfeile_nachrechts.gif b/template/English/bilder/pfeile_nachrechts.gif new file mode 100644 index 0000000..011511e Binary files /dev/null and b/template/English/bilder/pfeile_nachrechts.gif differ diff --git a/template/English/bilder/pfeile_nachrechts_soft.gif b/template/English/bilder/pfeile_nachrechts_soft.gif new file mode 100644 index 0000000..34fb06e Binary files /dev/null and b/template/English/bilder/pfeile_nachrechts_soft.gif differ diff --git a/template/English/bilder/poempl_gelb.gif b/template/English/bilder/poempl_gelb.gif new file mode 100644 index 0000000..f79a28a Binary files /dev/null and b/template/English/bilder/poempl_gelb.gif differ diff --git a/template/English/bilder/poempl_gruen.gif b/template/English/bilder/poempl_gruen.gif new file mode 100644 index 0000000..541be87 Binary files /dev/null and b/template/English/bilder/poempl_gruen.gif differ diff --git a/template/English/bilder/poempl_rot.gif b/template/English/bilder/poempl_rot.gif new file mode 100644 index 0000000..ef2daac Binary files /dev/null and b/template/English/bilder/poempl_rot.gif differ diff --git a/template/English/bilder/rec.gif b/template/English/bilder/rec.gif new file mode 100644 index 0000000..afb3199 Binary files /dev/null and b/template/English/bilder/rec.gif differ diff --git a/template/English/bilder/rec_button.gif b/template/English/bilder/rec_button.gif new file mode 100644 index 0000000..4487ff5 Binary files /dev/null and b/template/English/bilder/rec_button.gif differ diff --git a/template/English/bilder/rec_mitback.gif b/template/English/bilder/rec_mitback.gif new file mode 100644 index 0000000..54e9989 Binary files /dev/null and b/template/English/bilder/rec_mitback.gif differ diff --git a/template/English/bilder/remote.swf b/template/English/bilder/remote.swf new file mode 100644 index 0000000..c868907 Binary files /dev/null and b/template/English/bilder/remote.swf differ diff --git a/template/English/bilder/sauerei.gif b/template/English/bilder/sauerei.gif new file mode 100644 index 0000000..24962b8 Binary files /dev/null and b/template/English/bilder/sauerei.gif differ diff --git a/template/English/bilder/separator.png b/template/English/bilder/separator.png new file mode 100644 index 0000000..1719049 Binary files /dev/null and b/template/English/bilder/separator.png differ diff --git a/template/English/bilder/sortiert_asc.gif b/template/English/bilder/sortiert_asc.gif new file mode 100644 index 0000000..0839e0f Binary files /dev/null and b/template/English/bilder/sortiert_asc.gif differ diff --git a/template/English/bilder/sortiert_desc.gif b/template/English/bilder/sortiert_desc.gif new file mode 100644 index 0000000..a0c689a Binary files /dev/null and b/template/English/bilder/sortiert_desc.gif differ diff --git a/template/English/bilder/spacer.gif b/template/English/bilder/spacer.gif new file mode 100644 index 0000000..5bfd67a Binary files /dev/null and b/template/English/bilder/spacer.gif differ diff --git a/template/English/bilder/top.gif b/template/English/bilder/top.gif new file mode 100644 index 0000000..6cf906d Binary files /dev/null and b/template/English/bilder/top.gif differ diff --git a/template/English/bilder/top_nav_aufnahmen.gif b/template/English/bilder/top_nav_aufnahmen.gif new file mode 100644 index 0000000..e6ceda9 Binary files /dev/null and b/template/English/bilder/top_nav_aufnahmen.gif differ diff --git a/template/English/bilder/top_nav_fernbedienung.gif b/template/English/bilder/top_nav_fernbedienung.gif new file mode 100644 index 0000000..423c3c2 Binary files /dev/null and b/template/English/bilder/top_nav_fernbedienung.gif differ diff --git a/template/English/bilder/top_nav_konf.gif b/template/English/bilder/top_nav_konf.gif new file mode 100644 index 0000000..7185a15 Binary files /dev/null and b/template/English/bilder/top_nav_konf.gif differ diff --git a/template/English/bilder/top_nav_prguebersicht.gif b/template/English/bilder/top_nav_prguebersicht.gif new file mode 100644 index 0000000..dae2f18 Binary files /dev/null and b/template/English/bilder/top_nav_prguebersicht.gif differ diff --git a/template/English/bilder/top_nav_timer.gif b/template/English/bilder/top_nav_timer.gif new file mode 100644 index 0000000..d491576 Binary files /dev/null and b/template/English/bilder/top_nav_timer.gif differ diff --git a/template/English/bilder/top_nav_wasjetzt.gif b/template/English/bilder/top_nav_wasjetzt.gif new file mode 100644 index 0000000..cff65ba Binary files /dev/null and b/template/English/bilder/top_nav_wasjetzt.gif differ diff --git a/template/English/bilder/tv_bottom.gif b/template/English/bilder/tv_bottom.gif new file mode 100644 index 0000000..43219e3 Binary files /dev/null and b/template/English/bilder/tv_bottom.gif differ diff --git a/template/English/bilder/tv_umschalten_mitback.gif b/template/English/bilder/tv_umschalten_mitback.gif new file mode 100644 index 0000000..a4dca70 Binary files /dev/null and b/template/English/bilder/tv_umschalten_mitback.gif differ diff --git a/template/English/bilder/uebersicht_links.gif b/template/English/bilder/uebersicht_links.gif new file mode 100644 index 0000000..f000a20 Binary files /dev/null and b/template/English/bilder/uebersicht_links.gif differ diff --git a/template/English/bilder/uebersicht_links_dark.gif b/template/English/bilder/uebersicht_links_dark.gif new file mode 100644 index 0000000..ae7b95c Binary files /dev/null and b/template/English/bilder/uebersicht_links_dark.gif differ diff --git a/template/English/bilder/uebersicht_mitte.gif b/template/English/bilder/uebersicht_mitte.gif new file mode 100644 index 0000000..1ddae15 Binary files /dev/null and b/template/English/bilder/uebersicht_mitte.gif differ diff --git a/template/English/bilder/uebersicht_mitte_dark.gif b/template/English/bilder/uebersicht_mitte_dark.gif new file mode 100644 index 0000000..ed6da4d Binary files /dev/null and b/template/English/bilder/uebersicht_mitte_dark.gif differ diff --git a/template/English/bilder/uebersicht_mitte_dark_selected.gif b/template/English/bilder/uebersicht_mitte_dark_selected.gif new file mode 100644 index 0000000..51dcf0e Binary files /dev/null and b/template/English/bilder/uebersicht_mitte_dark_selected.gif differ diff --git a/template/English/bilder/uebersicht_mitte_selected.gif b/template/English/bilder/uebersicht_mitte_selected.gif new file mode 100644 index 0000000..73cb309 Binary files /dev/null and b/template/English/bilder/uebersicht_mitte_selected.gif differ diff --git a/template/English/bilder/uebersicht_oben.gif b/template/English/bilder/uebersicht_oben.gif new file mode 100644 index 0000000..aee9a61 Binary files /dev/null and b/template/English/bilder/uebersicht_oben.gif differ diff --git a/template/English/bilder/uebersicht_oben_links.gif b/template/English/bilder/uebersicht_oben_links.gif new file mode 100644 index 0000000..6cdadcc Binary files /dev/null and b/template/English/bilder/uebersicht_oben_links.gif differ diff --git a/template/English/bilder/uebersicht_oben_links_selected.gif b/template/English/bilder/uebersicht_oben_links_selected.gif new file mode 100644 index 0000000..801b384 Binary files /dev/null and b/template/English/bilder/uebersicht_oben_links_selected.gif differ diff --git a/template/English/bilder/uebersicht_oben_rechts.gif b/template/English/bilder/uebersicht_oben_rechts.gif new file mode 100644 index 0000000..9cff0fe Binary files /dev/null and b/template/English/bilder/uebersicht_oben_rechts.gif differ diff --git a/template/English/bilder/uebersicht_oben_rechts_sele.gif b/template/English/bilder/uebersicht_oben_rechts_sele.gif new file mode 100644 index 0000000..7ef540f Binary files /dev/null and b/template/English/bilder/uebersicht_oben_rechts_sele.gif differ diff --git a/template/English/bilder/uebersicht_oben_selected.gif b/template/English/bilder/uebersicht_oben_selected.gif new file mode 100644 index 0000000..38538fc Binary files /dev/null and b/template/English/bilder/uebersicht_oben_selected.gif differ diff --git a/template/English/bilder/uebersicht_rechts.gif b/template/English/bilder/uebersicht_rechts.gif new file mode 100644 index 0000000..e53b69c Binary files /dev/null and b/template/English/bilder/uebersicht_rechts.gif differ diff --git a/template/English/bilder/uebersicht_rechts_dark.gif b/template/English/bilder/uebersicht_rechts_dark.gif new file mode 100644 index 0000000..43d4c87 Binary files /dev/null and b/template/English/bilder/uebersicht_rechts_dark.gif differ diff --git a/template/English/bilder/uebersicht_spacer.gif b/template/English/bilder/uebersicht_spacer.gif new file mode 100644 index 0000000..5bfd67a Binary files /dev/null and b/template/English/bilder/uebersicht_spacer.gif differ diff --git a/template/English/bilder/uebersicht_unten.gif b/template/English/bilder/uebersicht_unten.gif new file mode 100644 index 0000000..6854d20 Binary files /dev/null and b/template/English/bilder/uebersicht_unten.gif differ diff --git a/template/English/bilder/uebersicht_unten_links.gif b/template/English/bilder/uebersicht_unten_links.gif new file mode 100644 index 0000000..55d82db Binary files /dev/null and b/template/English/bilder/uebersicht_unten_links.gif differ diff --git a/template/English/bilder/uebersicht_unten_rechts.gif b/template/English/bilder/uebersicht_unten_rechts.gif new file mode 100644 index 0000000..c836b47 Binary files /dev/null and b/template/English/bilder/uebersicht_unten_rechts.gif differ diff --git a/template/English/bilder/uebersicht_unten_selected.gif b/template/English/bilder/uebersicht_unten_selected.gif new file mode 100644 index 0000000..6d0fe5f Binary files /dev/null and b/template/English/bilder/uebersicht_unten_selected.gif differ diff --git a/template/English/config.html b/template/English/config.html new file mode 100644 index 0000000..28e8790 --- /dev/null +++ b/template/English/config.html @@ -0,0 +1,320 @@ + + + + + + + <tmpl_var titel> + + + + +
+ + + + + + + +
+

Configuration

+ 		   
+
+ + + + + + + + + + + + + + +
+ + + + + + + + + + + + + + +
General settings:
+ + + + + + + + + + + + + + + + + + + +
Language:
Start page:
Number of DVB cards:
 
+
+ + + + + + + + + + + + + + +
Identifikation:             
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Username:
Password:
Guest Account: + yes no + + yes no +
Guest Username:
Guest Password:
+
 
+ 		+ + + + + + + + + + + + + + +
Auto Timer settings:
+ + + + + + + + + + + + + + + + + + + + + + + + + +
 Auto Timer: + on off + + on off +
Autotimer EPG query interval: minutes
Lifetime for new Auto Timer:
Priority for new Auto Timer:
 
+
+ + + + + + + + + + + + + + +
Timer settings:
+ + + + + + + + + + + + + + + + + + + + + + + + + +
Lifetime for new Timer:
Priority for new Timer:
Margin begin: minutes
Margin end: minutes
 
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+
+ Channel selections:
+ 		  +
+
on "Channels": + + yes no + + yes no + +
on "Whats on?": + + yes no + + yes no + +
+
+


+ + All Channels
+

+
+ 		+
+


+

+

+

+

+
+ 		+
+


+ + Display these Channels
+

+
+
+
+ +
+ + + diff --git a/template/English/error.html b/template/English/error.html new file mode 100644 index 0000000..081e956 --- /dev/null +++ b/template/English/error.html @@ -0,0 +1,18 @@ + + + + + Error! + + + +
+
+ + +
+
+

+ + + diff --git a/template/English/i18n.pl b/template/English/i18n.pl new file mode 100644 index 0000000..ce556c2 --- /dev/null +++ b/template/English/i18n.pl @@ -0,0 +1,43 @@ +## +# English +## +@I18N_Days = ( + "Sunday", + "Monday", + "Tuesday", + "Wednesday", + "Thursday", + "Friday", + "Saturday" +); + +@I18N_Month = ( + "January", + "February", + "March", + "April", + "May", + "June", + "July", + "August", + "September", + "October", + "November", + "December" +); + +@LOGINPAGES_DESCRIPTION = ( + "Whats on?", + "Channels", + "Timers", + "Recordings" +); + +%ERRORMESSAGE = ( + CONNECT_FAILED => "Can't connect to %s!", + SEND_COMMAND => "Error while sending command to %s", +); + +%COMMONMESSAGE = ( + OVERVIEW => "Overview", +); diff --git a/template/English/index.html b/template/English/index.html new file mode 100644 index 0000000..0b9dbdd --- /dev/null +++ b/template/English/index.html @@ -0,0 +1,22 @@ + + + + + + + VDR Admin <tmpl_var version> (<tmpl_var host>) + + + + + + + + <body bgcolor="#ffffff"> + <p></p> + </body> + + + + + diff --git a/template/English/left.html b/template/English/left.html new file mode 100644 index 0000000..fef46b1 --- /dev/null +++ b/template/English/left.html @@ -0,0 +1,131 @@ + + + + + + + + + + + + +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

+
 
 What's on?
 Channels
 Timers
 Auto Timers
 Recordings
 Configuration
 Remote Control
 TV
+  Search:
 
+  
+
+ + + diff --git a/template/English/navi.css b/template/English/navi.css new file mode 100644 index 0000000..2700538 --- /dev/null +++ b/template/English/navi.css @@ -0,0 +1,11 @@ +textarea { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, Geneva } +input { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, Geneva } +select { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, Geneva } +td { color: black; font-size: 11px; font-family: Verdana, Arial, Helvetica, Geneva } +p { color: black; font-size: 11px; font-family: Verdana, Arial, Helvetica, Geneva } +h1,h2,h3,h4,h5,h6 { color: black; font-family: Verdana, Arial, Helvetica, Geneva } +a { color: #000000; font-weight: bold; text-decoration: none } +.klein { font-size: 10px; font-family: Verdana, Arial, Helvetica, Geneva } +.small { font-size: 8px; font-family: Verdana, Arial, Helvetica, Geneva } +.navi { font-size: 12px; font-family: Verdana, Arial, Helvetica, Geneva } +a:hover { font-weight: bold; text-decoration: underline } diff --git a/template/English/noauth.html b/template/English/noauth.html new file mode 100644 index 0000000..10eff18 --- /dev/null +++ b/template/English/noauth.html @@ -0,0 +1,13 @@ + + + Authorization Required + + + +

Authorization Required

+ +

This server could not verify that you are authorized to access the document requested. Either you supplied the wrong credentials (e.g., bad password), or your browser doesn't understand how to supply the credentials required.

+ + + + diff --git a/template/English/noperm.html b/template/English/noperm.html new file mode 100644 index 0000000..a0e4e49 --- /dev/null +++ b/template/English/noperm.html @@ -0,0 +1,12 @@ + + + <tmpl_var title> + + + +

+ +

+ + + diff --git a/template/English/prog_detail.html b/template/English/prog_detail.html new file mode 100644 index 0000000..c0178a1 --- /dev/null +++ b/template/English/prog_detail.html @@ -0,0 +1,33 @@ + + + + + + + <tmpl_var title> + + + + + + + + + + + + + + + + + + + + +
| -
 

 +  [close] + 		 
+ + + diff --git a/template/English/prog_list.html b/template/English/prog_list.html new file mode 100644 index 0000000..f8a2218 --- /dev/null +++ b/template/English/prog_list.html @@ -0,0 +1,108 @@ + + + + + + + + + + + + +
+ + + + + + +
+

+ 		Select channel:  +   + +  
+ +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

+ 		+

+
      
  +

-

+ 		+



+ 		+

+ 		+

+ 		 
    
+
+ + + + + diff --git a/template/English/prog_summary.html b/template/English/prog_summary.html new file mode 100644 index 0000000..25c1260 --- /dev/null +++ b/template/English/prog_summary.html @@ -0,0 +1,85 @@ + + + + + + + VDRAdmin - Was läuft jetzt? + + + + + +
+ + + + + + + +
+

+ 		What's on: now | at:  + + +  
+
+ + + + + + + + + + + + + + + + + + + + + +
+ + + + + +
+ +

+

+

-

+
+
+
+
+ more +
+
+
+ 		+
+
+
+ + diff --git a/template/English/rc.html b/template/English/rc.html new file mode 100644 index 0000000..05e9809 --- /dev/null +++ b/template/English/rc.html @@ -0,0 +1,110 @@ + + + + + + + <tmpl_var host> - Remote Control + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + diff --git a/template/English/rec_list.html b/template/English/rec_list.html new file mode 100644 index 0000000..a89554d --- /dev/null +++ b/template/English/rec_list.html @@ -0,0 +1,123 @@ + + + + + + + + + + + + + + + + + + +
+

Recordings

+ 		  + + Total: + + ( + + ) | Free: + + ( + + ) +   
+
+ + + + +
  >>
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

+

  Date

  Time

  Name

+ 		  
  +

Total

+ 		+

Neu new

+ 		+

 

+ 		+

+ 		+

+ 		 
      

+ + + + + + +
+ +
Delete selected recordings
 + +
+
+ +
+
+ + + diff --git a/template/English/style.css b/template/English/style.css new file mode 100644 index 0000000..96cf065 --- /dev/null +++ b/template/English/style.css @@ -0,0 +1,28 @@ +body { background: #c4cdd7 url(bilder/background.gif) repeat-x } +td { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +.rec { font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +div { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +input { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +textarea { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +select { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +b { font-weight: bold } +i { font-style: italic } +a { color: #039; text-decoration: none } +a:visited { color: #039; text-decoration: none } +a:hover { color: #cc0000; text-decoration: underline } +a:active { color: #000; text-decoration: underline } +a.rec:link { color: #c00; text-decoration: none } +a.rec:visited { color: #000; text-decoration: none } +a.rec:hover { color: #cc0000; text-decoration: underline } +a.rec:active { color: #000; text-decoration: underline } +.headline { font-weight: bold; font-size: 14px; margin-top: 20px; margin-bottom: 20px } +.subheadline { color: #039; font-weight: bold } +.kleine { font-size: 10px } +.mini { font-size: 9px } +.rechts { text-align: right} +.einzug { margin: 10px 12px } +.einzug_ohnetop { margin-right: 12px; margin-left: 12px } +.einzug_liste { margin: 3px 5px 0px 5px } +.einzug_liste_headlines { margin-right: 5px; margin-left: 6px } +.einzugklein { color: #000; font-weight: normal; font-size: 10px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif; margin-right: 7px; margin-left: 7px } +.gbutton { color: black; font-weight: bold } diff --git a/template/English/timer_list.html b/template/English/timer_list.html new file mode 100644 index 0000000..28ccd99 --- /dev/null +++ b/template/English/timer_list.html @@ -0,0 +1,161 @@ + + + + + + + + + + + + + + + + + + + + +
+

Timer

+ 		  + + + + + + +
+ +
New Timer
 + +
+ 		 
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

+ 		+

  Active

+ 		+

  Channel

+ 		+

  Day

+ 		+

  Start

+ 		+

  Stop

+ 		+

  Name

+ 		   
  +

+ + + + + + + + + + + +  YesNoVPSAuto + +

+ 		+

+ 		+

+ 		+

+ 		+

+ 		+

+ 		+

+ 		+

+ 		+

+ 		 
          

+ + + + + + +
+ +
Delete selected timers
 + +
+
+ + diff --git a/template/English/timer_new.html b/template/English/timer_new.html new file mode 100644 index 0000000..7d71fb3 --- /dev/null +++ b/template/English/timer_new.html @@ -0,0 +1,172 @@ + + + + + VDRAdmin - <tmpl_if newtimer>New Timer<tmpl_else>Edit Timer</tmpl_if> + + + + + +
+ + + + + + + +
+

New TimerEdit timer

+ 		   
+
+
+ + + + + + + + + + + + + + +
   
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
 Timer Active + + yes + no + + yes + no + +
 Automatic Timer Checking + + program ID + recording time + disabled + + + recording time + disabled + + + recording time + disabled + +
 Channel
 Day of recording
+ Monday Tuesday Wednesday Thursday Friday Saturday Sunday
 Starts :
 Stops :
 Priority
 Lifetime
 Title
 Summary
+
+
+
+
+
+ + + + + + + + + +
+ + + diff --git a/template/English/toolbar.html b/template/English/toolbar.html new file mode 100644 index 0000000..596874f --- /dev/null +++ b/template/English/toolbar.html @@ -0,0 +1,40 @@ + + + + + + + Toolbar + + + +
+ + + + + + + + + + + + + +
+   +
+

+
+ + + diff --git a/template/English/tv.html b/template/English/tv.html new file mode 100644 index 0000000..c20f6d5 --- /dev/null +++ b/template/English/tv.html @@ -0,0 +1,75 @@ + + + + TV (<tmpl_var host>) + + + + + + +
+ + + + + + + +
+ +
+
+ + Grab + Interval +
+
+ + diff --git a/template/French/at_new.html b/template/French/at_new.html new file mode 100644 index 0000000..2766b89 --- /dev/null +++ b/template/French/at_new.html @@ -0,0 +1,158 @@ + + + + + + + + + +
+ + + + + + + +
+

Nouveau programme automatiqueEdition programme automatique

+ 		   
+
+ + + + + + + + + + + + + + +
 
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
 Prog auto actif: + + oui non + + + oui non + + +
 Chercher un mot clef:
 Chercher dans + + + + + + + + + Titre + + + + + + + + + + Sous-titre + + + + + + + + + + Description
 Chaîne:
 Démarre après:: heure
 Termine avant::heure
 Priorité:
 Durée de vie:
 Episode: + + + + + + + +
 Directory (XXX: Translation):
+
 
+
+ +
+ + + diff --git a/template/French/at_timer_list.html b/template/French/at_timer_list.html new file mode 100644 index 0000000..7a54a97 --- /dev/null +++ b/template/French/at_timer_list.html @@ -0,0 +1,173 @@ + + + + + + + + + + + + + + + + + + + + +
+

Programme automatique

+ 		  + + + + + + +
+ +
Nouveau prog auto
 + +
+ 		 
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

+ 		+

  Actif

+ 		+

  Chaîne

+ 		+

  Début

+ 		+

  Fin

+ 		+

  Nom

+ 		   
  +

+   Oui Non +

+ 		+

+ + + + - +

+ 		+

+ + + + - + +

+ 		+

+ + + + - + +

+ 		+

+ 		+

+ 		+

+ 		+

+ 		 
         
+ +
+ + + + + +
+ +
Forcer la MAJ
 + +

+ + + + + + +
+ +
Suppr les prog auto sélectionnés
 + +
+
+ +
+ + + diff --git a/template/French/bilder/back.gif b/template/French/bilder/back.gif new file mode 100644 index 0000000..1b514e1 Binary files /dev/null and b/template/French/bilder/back.gif differ diff --git a/template/French/bilder/back.png b/template/French/bilder/back.png new file mode 100644 index 0000000..f2e072e Binary files /dev/null and b/template/French/bilder/back.png differ diff --git a/template/French/bilder/background.gif b/template/French/bilder/background.gif new file mode 100644 index 0000000..700c597 Binary files /dev/null and b/template/French/bilder/background.gif differ diff --git a/template/French/bilder/cback.png b/template/French/bilder/cback.png new file mode 100644 index 0000000..b2ffaf9 Binary files /dev/null and b/template/French/bilder/cback.png differ diff --git a/template/French/bilder/delete.gif b/template/French/bilder/delete.gif new file mode 100644 index 0000000..21b74a4 Binary files /dev/null and b/template/French/bilder/delete.gif differ diff --git a/template/French/bilder/edit.gif b/template/French/bilder/edit.gif new file mode 100644 index 0000000..88aa3d1 Binary files /dev/null and b/template/French/bilder/edit.gif differ diff --git a/template/French/bilder/favicon.ico b/template/French/bilder/favicon.ico new file mode 100644 index 0000000..a4fe6df Binary files /dev/null and b/template/French/bilder/favicon.ico differ diff --git a/template/French/bilder/fern_01.jpg b/template/French/bilder/fern_01.jpg new file mode 100644 index 0000000..112d9f6 Binary files /dev/null and b/template/French/bilder/fern_01.jpg differ diff --git a/template/French/bilder/fern_02.jpg b/template/French/bilder/fern_02.jpg new file mode 100644 index 0000000..aa8c973 Binary files /dev/null and b/template/French/bilder/fern_02.jpg differ diff --git a/template/French/bilder/fern_03.jpg b/template/French/bilder/fern_03.jpg new file mode 100644 index 0000000..dc898fd Binary files /dev/null and b/template/French/bilder/fern_03.jpg differ diff --git a/template/French/bilder/fern_04.jpg b/template/French/bilder/fern_04.jpg new file mode 100644 index 0000000..60466f6 Binary files /dev/null and b/template/French/bilder/fern_04.jpg differ diff --git a/template/French/bilder/fern_05.jpg b/template/French/bilder/fern_05.jpg new file mode 100644 index 0000000..de4fefe Binary files /dev/null and b/template/French/bilder/fern_05.jpg differ diff --git a/template/French/bilder/fern_06.jpg b/template/French/bilder/fern_06.jpg new file mode 100644 index 0000000..e2ec172 Binary files /dev/null and b/template/French/bilder/fern_06.jpg differ diff --git a/template/French/bilder/fern_07.jpg b/template/French/bilder/fern_07.jpg new file mode 100644 index 0000000..479dfc7 Binary files /dev/null and b/template/French/bilder/fern_07.jpg differ diff --git a/template/French/bilder/fern_08.jpg b/template/French/bilder/fern_08.jpg new file mode 100644 index 0000000..46edd48 Binary files /dev/null and b/template/French/bilder/fern_08.jpg differ diff --git a/template/French/bilder/fern_09.jpg b/template/French/bilder/fern_09.jpg new file mode 100644 index 0000000..144ab3f Binary files /dev/null and b/template/French/bilder/fern_09.jpg differ diff --git a/template/French/bilder/fern_10.jpg b/template/French/bilder/fern_10.jpg new file mode 100644 index 0000000..21a4612 Binary files /dev/null and b/template/French/bilder/fern_10.jpg differ diff --git a/template/French/bilder/fern_11.jpg b/template/French/bilder/fern_11.jpg new file mode 100644 index 0000000..d277804 Binary files /dev/null and b/template/French/bilder/fern_11.jpg differ diff --git a/template/French/bilder/fern_12.jpg b/template/French/bilder/fern_12.jpg new file mode 100644 index 0000000..2342bb1 Binary files /dev/null and b/template/French/bilder/fern_12.jpg differ diff --git a/template/French/bilder/fern_13.jpg b/template/French/bilder/fern_13.jpg new file mode 100644 index 0000000..ab2b3a4 Binary files /dev/null and b/template/French/bilder/fern_13.jpg differ diff --git a/template/French/bilder/fern_14.jpg b/template/French/bilder/fern_14.jpg new file mode 100644 index 0000000..7522563 Binary files /dev/null and b/template/French/bilder/fern_14.jpg differ diff --git a/template/French/bilder/fern_15.jpg b/template/French/bilder/fern_15.jpg new file mode 100644 index 0000000..58e7438 Binary files /dev/null and b/template/French/bilder/fern_15.jpg differ diff --git a/template/French/bilder/fern_16.jpg b/template/French/bilder/fern_16.jpg new file mode 100644 index 0000000..1a0a077 Binary files /dev/null and b/template/French/bilder/fern_16.jpg differ diff --git a/template/French/bilder/fern_17.jpg b/template/French/bilder/fern_17.jpg new file mode 100644 index 0000000..69db0f5 Binary files /dev/null and b/template/French/bilder/fern_17.jpg differ diff --git a/template/French/bilder/fern_18.jpg b/template/French/bilder/fern_18.jpg new file mode 100644 index 0000000..c1543d6 Binary files /dev/null and b/template/French/bilder/fern_18.jpg differ diff --git a/template/French/bilder/fern_19.jpg b/template/French/bilder/fern_19.jpg new file mode 100644 index 0000000..5f777a9 Binary files /dev/null and b/template/French/bilder/fern_19.jpg differ diff --git a/template/French/bilder/fern_20.jpg b/template/French/bilder/fern_20.jpg new file mode 100644 index 0000000..2bc0762 Binary files /dev/null and b/template/French/bilder/fern_20.jpg differ diff --git a/template/French/bilder/fern_21.jpg b/template/French/bilder/fern_21.jpg new file mode 100644 index 0000000..757c2b4 Binary files /dev/null and b/template/French/bilder/fern_21.jpg differ diff --git a/template/French/bilder/fern_22.jpg b/template/French/bilder/fern_22.jpg new file mode 100644 index 0000000..9537044 Binary files /dev/null and b/template/French/bilder/fern_22.jpg differ diff --git a/template/French/bilder/fern_23.jpg b/template/French/bilder/fern_23.jpg new file mode 100644 index 0000000..8a97144 Binary files /dev/null and b/template/French/bilder/fern_23.jpg differ diff --git a/template/French/bilder/fern_24.jpg b/template/French/bilder/fern_24.jpg new file mode 100644 index 0000000..831a23d Binary files /dev/null and b/template/French/bilder/fern_24.jpg differ diff --git a/template/French/bilder/fern_25.jpg b/template/French/bilder/fern_25.jpg new file mode 100644 index 0000000..92d08ec Binary files /dev/null and b/template/French/bilder/fern_25.jpg differ diff --git a/template/French/bilder/fern_26.jpg b/template/French/bilder/fern_26.jpg new file mode 100644 index 0000000..0e3afed Binary files /dev/null and b/template/French/bilder/fern_26.jpg differ diff --git a/template/French/bilder/fern_27.jpg b/template/French/bilder/fern_27.jpg new file mode 100644 index 0000000..d55b445 Binary files /dev/null and b/template/French/bilder/fern_27.jpg differ diff --git a/template/French/bilder/fern_28.jpg b/template/French/bilder/fern_28.jpg new file mode 100644 index 0000000..f72f876 Binary files /dev/null and b/template/French/bilder/fern_28.jpg differ diff --git a/template/French/bilder/fern_29.jpg b/template/French/bilder/fern_29.jpg new file mode 100644 index 0000000..5952b08 Binary files /dev/null and b/template/French/bilder/fern_29.jpg differ diff --git a/template/French/bilder/fern_30.jpg b/template/French/bilder/fern_30.jpg new file mode 100644 index 0000000..15fb695 Binary files /dev/null and b/template/French/bilder/fern_30.jpg differ diff --git a/template/French/bilder/fern_31.jpg b/template/French/bilder/fern_31.jpg new file mode 100644 index 0000000..0057f36 Binary files /dev/null and b/template/French/bilder/fern_31.jpg differ diff --git a/template/French/bilder/fern_32.jpg b/template/French/bilder/fern_32.jpg new file mode 100644 index 0000000..9551a4b Binary files /dev/null and b/template/French/bilder/fern_32.jpg differ diff --git a/template/French/bilder/fern_33.jpg b/template/French/bilder/fern_33.jpg new file mode 100644 index 0000000..8d44785 Binary files /dev/null and b/template/French/bilder/fern_33.jpg differ diff --git a/template/French/bilder/fern_34.jpg b/template/French/bilder/fern_34.jpg new file mode 100644 index 0000000..8db1ebc Binary files /dev/null and b/template/French/bilder/fern_34.jpg differ diff --git a/template/French/bilder/fern_35.jpg b/template/French/bilder/fern_35.jpg new file mode 100644 index 0000000..74e68a0 Binary files /dev/null and b/template/French/bilder/fern_35.jpg differ diff --git a/template/French/bilder/fern_36.jpg b/template/French/bilder/fern_36.jpg new file mode 100644 index 0000000..db7dc6e Binary files /dev/null and b/template/French/bilder/fern_36.jpg differ diff --git a/template/French/bilder/fern_37.jpg b/template/French/bilder/fern_37.jpg new file mode 100644 index 0000000..0ad6453 Binary files /dev/null and b/template/French/bilder/fern_37.jpg differ diff --git a/template/French/bilder/fern_38.jpg b/template/French/bilder/fern_38.jpg new file mode 100644 index 0000000..3b4e41e Binary files /dev/null and b/template/French/bilder/fern_38.jpg differ diff --git a/template/French/bilder/fern_39.jpg b/template/French/bilder/fern_39.jpg new file mode 100644 index 0000000..c68ba21 Binary files /dev/null and b/template/French/bilder/fern_39.jpg differ diff --git a/template/French/bilder/fern_40.jpg b/template/French/bilder/fern_40.jpg new file mode 100644 index 0000000..c7c01ed Binary files /dev/null and b/template/French/bilder/fern_40.jpg differ diff --git a/template/French/bilder/fern_41.jpg b/template/French/bilder/fern_41.jpg new file mode 100644 index 0000000..c9b8784 Binary files /dev/null and b/template/French/bilder/fern_41.jpg differ diff --git a/template/French/bilder/fern_42.jpg b/template/French/bilder/fern_42.jpg new file mode 100644 index 0000000..2f63a66 Binary files /dev/null and b/template/French/bilder/fern_42.jpg differ diff --git a/template/French/bilder/fern_back.jpg b/template/French/bilder/fern_back.jpg new file mode 100644 index 0000000..4b9eb7c Binary files /dev/null and b/template/French/bilder/fern_back.jpg differ diff --git a/template/French/bilder/fernseher_unten.gif b/template/French/bilder/fernseher_unten.gif new file mode 100644 index 0000000..43219e3 Binary files /dev/null and b/template/French/bilder/fernseher_unten.gif differ diff --git a/template/French/bilder/folder.gif b/template/French/bilder/folder.gif new file mode 100644 index 0000000..e3c45a5 Binary files /dev/null and b/template/French/bilder/folder.gif differ diff --git a/template/French/bilder/frame.png b/template/French/bilder/frame.png new file mode 100644 index 0000000..94485e2 Binary files /dev/null and b/template/French/bilder/frame.png differ diff --git a/template/French/bilder/framed.gif b/template/French/bilder/framed.gif new file mode 100644 index 0000000..0adecf2 Binary files /dev/null and b/template/French/bilder/framed.gif differ diff --git a/template/French/bilder/gbutton_left.gif b/template/French/bilder/gbutton_left.gif new file mode 100644 index 0000000..41672a3 Binary files /dev/null and b/template/French/bilder/gbutton_left.gif differ diff --git a/template/French/bilder/gbutton_middle.gif b/template/French/bilder/gbutton_middle.gif new file mode 100644 index 0000000..07192d9 Binary files /dev/null and b/template/French/bilder/gbutton_middle.gif differ diff --git a/template/French/bilder/gbutton_right.gif b/template/French/bilder/gbutton_right.gif new file mode 100644 index 0000000..d5a55e7 Binary files /dev/null and b/template/French/bilder/gbutton_right.gif differ diff --git a/template/French/bilder/help.gif b/template/French/bilder/help.gif new file mode 100644 index 0000000..095f28a Binary files /dev/null and b/template/French/bilder/help.gif differ diff --git a/template/French/bilder/hilfe.gif b/template/French/bilder/hilfe.gif new file mode 100644 index 0000000..8f14289 Binary files /dev/null and b/template/French/bilder/hilfe.gif differ diff --git a/template/French/bilder/info_button.gif b/template/French/bilder/info_button.gif new file mode 100644 index 0000000..3ae6142 Binary files /dev/null and b/template/French/bilder/info_button.gif differ diff --git a/template/French/bilder/info_button_disabled.gif b/template/French/bilder/info_button_disabled.gif new file mode 100644 index 0000000..33912a1 Binary files /dev/null and b/template/French/bilder/info_button_disabled.gif differ diff --git a/template/French/bilder/linvdr.gif b/template/French/bilder/linvdr.gif new file mode 100644 index 0000000..d9d0398 Binary files /dev/null and b/template/French/bilder/linvdr.gif differ diff --git a/template/French/bilder/logo.gif b/template/French/bilder/logo.gif new file mode 100644 index 0000000..dfbcd2e Binary files /dev/null and b/template/French/bilder/logo.gif differ diff --git a/template/French/bilder/mitte.gif b/template/French/bilder/mitte.gif new file mode 100644 index 0000000..92ec6ad Binary files /dev/null and b/template/French/bilder/mitte.gif differ diff --git a/template/French/bilder/nav_button_back.gif b/template/French/bilder/nav_button_back.gif new file mode 100644 index 0000000..9287c7e Binary files /dev/null and b/template/French/bilder/nav_button_back.gif differ diff --git a/template/French/bilder/nav_button_back_end.gif b/template/French/bilder/nav_button_back_end.gif new file mode 100644 index 0000000..b65f4ba Binary files /dev/null and b/template/French/bilder/nav_button_back_end.gif differ diff --git a/template/French/bilder/nav_button_back_mitte.gif b/template/French/bilder/nav_button_back_mitte.gif new file mode 100644 index 0000000..c6390f4 Binary files /dev/null and b/template/French/bilder/nav_button_back_mitte.gif differ diff --git a/template/French/bilder/new_auto_timer.gif b/template/French/bilder/new_auto_timer.gif new file mode 100644 index 0000000..576a062 Binary files /dev/null and b/template/French/bilder/new_auto_timer.gif differ diff --git a/template/French/bilder/new_timer.gif b/template/French/bilder/new_timer.gif new file mode 100644 index 0000000..5658326 Binary files /dev/null and b/template/French/bilder/new_timer.gif differ diff --git a/template/French/bilder/pfeile_nachlinks.gif b/template/French/bilder/pfeile_nachlinks.gif new file mode 100644 index 0000000..867fc2c Binary files /dev/null and b/template/French/bilder/pfeile_nachlinks.gif differ diff --git a/template/French/bilder/pfeile_nachlinks_soft.gif b/template/French/bilder/pfeile_nachlinks_soft.gif new file mode 100644 index 0000000..854d380 Binary files /dev/null and b/template/French/bilder/pfeile_nachlinks_soft.gif differ diff --git a/template/French/bilder/pfeile_nachrechts.gif b/template/French/bilder/pfeile_nachrechts.gif new file mode 100644 index 0000000..011511e Binary files /dev/null and b/template/French/bilder/pfeile_nachrechts.gif differ diff --git a/template/French/bilder/pfeile_nachrechts_soft.gif b/template/French/bilder/pfeile_nachrechts_soft.gif new file mode 100644 index 0000000..34fb06e Binary files /dev/null and b/template/French/bilder/pfeile_nachrechts_soft.gif differ diff --git a/template/French/bilder/poempl_gelb.gif b/template/French/bilder/poempl_gelb.gif new file mode 100644 index 0000000..f79a28a Binary files /dev/null and b/template/French/bilder/poempl_gelb.gif differ diff --git a/template/French/bilder/poempl_gruen.gif b/template/French/bilder/poempl_gruen.gif new file mode 100644 index 0000000..541be87 Binary files /dev/null and b/template/French/bilder/poempl_gruen.gif differ diff --git a/template/French/bilder/poempl_rot.gif b/template/French/bilder/poempl_rot.gif new file mode 100644 index 0000000..ef2daac Binary files /dev/null and b/template/French/bilder/poempl_rot.gif differ diff --git a/template/French/bilder/rec.gif b/template/French/bilder/rec.gif new file mode 100644 index 0000000..afb3199 Binary files /dev/null and b/template/French/bilder/rec.gif differ diff --git a/template/French/bilder/rec_button.gif b/template/French/bilder/rec_button.gif new file mode 100644 index 0000000..4487ff5 Binary files /dev/null and b/template/French/bilder/rec_button.gif differ diff --git a/template/French/bilder/rec_mitback.gif b/template/French/bilder/rec_mitback.gif new file mode 100644 index 0000000..54e9989 Binary files /dev/null and b/template/French/bilder/rec_mitback.gif differ diff --git a/template/French/bilder/remote.swf b/template/French/bilder/remote.swf new file mode 100644 index 0000000..c868907 Binary files /dev/null and b/template/French/bilder/remote.swf differ diff --git a/template/French/bilder/sauerei.gif b/template/French/bilder/sauerei.gif new file mode 100644 index 0000000..24962b8 Binary files /dev/null and b/template/French/bilder/sauerei.gif differ diff --git a/template/French/bilder/separator.png b/template/French/bilder/separator.png new file mode 100644 index 0000000..1719049 Binary files /dev/null and b/template/French/bilder/separator.png differ diff --git a/template/French/bilder/sortiert_asc.gif b/template/French/bilder/sortiert_asc.gif new file mode 100644 index 0000000..0839e0f Binary files /dev/null and b/template/French/bilder/sortiert_asc.gif differ diff --git a/template/French/bilder/sortiert_desc.gif b/template/French/bilder/sortiert_desc.gif new file mode 100644 index 0000000..a0c689a Binary files /dev/null and b/template/French/bilder/sortiert_desc.gif differ diff --git a/template/French/bilder/spacer.gif b/template/French/bilder/spacer.gif new file mode 100644 index 0000000..5bfd67a Binary files /dev/null and b/template/French/bilder/spacer.gif differ diff --git a/template/French/bilder/top.gif b/template/French/bilder/top.gif new file mode 100644 index 0000000..6cf906d Binary files /dev/null and b/template/French/bilder/top.gif differ diff --git a/template/French/bilder/top_nav_aufnahmen.gif b/template/French/bilder/top_nav_aufnahmen.gif new file mode 100644 index 0000000..e6ceda9 Binary files /dev/null and b/template/French/bilder/top_nav_aufnahmen.gif differ diff --git a/template/French/bilder/top_nav_fernbedienung.gif b/template/French/bilder/top_nav_fernbedienung.gif new file mode 100644 index 0000000..423c3c2 Binary files /dev/null and b/template/French/bilder/top_nav_fernbedienung.gif differ diff --git a/template/French/bilder/top_nav_konf.gif b/template/French/bilder/top_nav_konf.gif new file mode 100644 index 0000000..7185a15 Binary files /dev/null and b/template/French/bilder/top_nav_konf.gif differ diff --git a/template/French/bilder/top_nav_prguebersicht.gif b/template/French/bilder/top_nav_prguebersicht.gif new file mode 100644 index 0000000..dae2f18 Binary files /dev/null and b/template/French/bilder/top_nav_prguebersicht.gif differ diff --git a/template/French/bilder/top_nav_timer.gif b/template/French/bilder/top_nav_timer.gif new file mode 100644 index 0000000..d491576 Binary files /dev/null and b/template/French/bilder/top_nav_timer.gif differ diff --git a/template/French/bilder/top_nav_wasjetzt.gif b/template/French/bilder/top_nav_wasjetzt.gif new file mode 100644 index 0000000..cff65ba Binary files /dev/null and b/template/French/bilder/top_nav_wasjetzt.gif differ diff --git a/template/French/bilder/tv_bottom.gif b/template/French/bilder/tv_bottom.gif new file mode 100644 index 0000000..43219e3 Binary files /dev/null and b/template/French/bilder/tv_bottom.gif differ diff --git a/template/French/bilder/tv_umschalten_mitback.gif b/template/French/bilder/tv_umschalten_mitback.gif new file mode 100644 index 0000000..a4dca70 Binary files /dev/null and b/template/French/bilder/tv_umschalten_mitback.gif differ diff --git a/template/French/bilder/uebersicht_links.gif b/template/French/bilder/uebersicht_links.gif new file mode 100644 index 0000000..f000a20 Binary files /dev/null and b/template/French/bilder/uebersicht_links.gif differ diff --git a/template/French/bilder/uebersicht_links_dark.gif b/template/French/bilder/uebersicht_links_dark.gif new file mode 100644 index 0000000..ae7b95c Binary files /dev/null and b/template/French/bilder/uebersicht_links_dark.gif differ diff --git a/template/French/bilder/uebersicht_mitte.gif b/template/French/bilder/uebersicht_mitte.gif new file mode 100644 index 0000000..1ddae15 Binary files /dev/null and b/template/French/bilder/uebersicht_mitte.gif differ diff --git a/template/French/bilder/uebersicht_mitte_dark.gif b/template/French/bilder/uebersicht_mitte_dark.gif new file mode 100644 index 0000000..ed6da4d Binary files /dev/null and b/template/French/bilder/uebersicht_mitte_dark.gif differ diff --git a/template/French/bilder/uebersicht_mitte_dark_selected.gif b/template/French/bilder/uebersicht_mitte_dark_selected.gif new file mode 100644 index 0000000..51dcf0e Binary files /dev/null and b/template/French/bilder/uebersicht_mitte_dark_selected.gif differ diff --git a/template/French/bilder/uebersicht_mitte_selected.gif b/template/French/bilder/uebersicht_mitte_selected.gif new file mode 100644 index 0000000..73cb309 Binary files /dev/null and b/template/French/bilder/uebersicht_mitte_selected.gif differ diff --git a/template/French/bilder/uebersicht_oben.gif b/template/French/bilder/uebersicht_oben.gif new file mode 100644 index 0000000..aee9a61 Binary files /dev/null and b/template/French/bilder/uebersicht_oben.gif differ diff --git a/template/French/bilder/uebersicht_oben_links.gif b/template/French/bilder/uebersicht_oben_links.gif new file mode 100644 index 0000000..6cdadcc Binary files /dev/null and b/template/French/bilder/uebersicht_oben_links.gif differ diff --git a/template/French/bilder/uebersicht_oben_links_selected.gif b/template/French/bilder/uebersicht_oben_links_selected.gif new file mode 100644 index 0000000..801b384 Binary files /dev/null and b/template/French/bilder/uebersicht_oben_links_selected.gif differ diff --git a/template/French/bilder/uebersicht_oben_rechts.gif b/template/French/bilder/uebersicht_oben_rechts.gif new file mode 100644 index 0000000..9cff0fe Binary files /dev/null and b/template/French/bilder/uebersicht_oben_rechts.gif differ diff --git a/template/French/bilder/uebersicht_oben_rechts_sele.gif b/template/French/bilder/uebersicht_oben_rechts_sele.gif new file mode 100644 index 0000000..7ef540f Binary files /dev/null and b/template/French/bilder/uebersicht_oben_rechts_sele.gif differ diff --git a/template/French/bilder/uebersicht_oben_selected.gif b/template/French/bilder/uebersicht_oben_selected.gif new file mode 100644 index 0000000..38538fc Binary files /dev/null and b/template/French/bilder/uebersicht_oben_selected.gif differ diff --git a/template/French/bilder/uebersicht_rechts.gif b/template/French/bilder/uebersicht_rechts.gif new file mode 100644 index 0000000..e53b69c Binary files /dev/null and b/template/French/bilder/uebersicht_rechts.gif differ diff --git a/template/French/bilder/uebersicht_rechts_dark.gif b/template/French/bilder/uebersicht_rechts_dark.gif new file mode 100644 index 0000000..43d4c87 Binary files /dev/null and b/template/French/bilder/uebersicht_rechts_dark.gif differ diff --git a/template/French/bilder/uebersicht_spacer.gif b/template/French/bilder/uebersicht_spacer.gif new file mode 100644 index 0000000..5bfd67a Binary files /dev/null and b/template/French/bilder/uebersicht_spacer.gif differ diff --git a/template/French/bilder/uebersicht_unten.gif b/template/French/bilder/uebersicht_unten.gif new file mode 100644 index 0000000..6854d20 Binary files /dev/null and b/template/French/bilder/uebersicht_unten.gif differ diff --git a/template/French/bilder/uebersicht_unten_links.gif b/template/French/bilder/uebersicht_unten_links.gif new file mode 100644 index 0000000..55d82db Binary files /dev/null and b/template/French/bilder/uebersicht_unten_links.gif differ diff --git a/template/French/bilder/uebersicht_unten_rechts.gif b/template/French/bilder/uebersicht_unten_rechts.gif new file mode 100644 index 0000000..c836b47 Binary files /dev/null and b/template/French/bilder/uebersicht_unten_rechts.gif differ diff --git a/template/French/bilder/uebersicht_unten_selected.gif b/template/French/bilder/uebersicht_unten_selected.gif new file mode 100644 index 0000000..6d0fe5f Binary files /dev/null and b/template/French/bilder/uebersicht_unten_selected.gif differ diff --git a/template/French/config.html b/template/French/config.html new file mode 100644 index 0000000..fc9b090 --- /dev/null +++ b/template/French/config.html @@ -0,0 +1,320 @@ + + + + + + + <tmpl_var titel> + + + + +
+ + + + + + + +
+

Configuration

+ 		   
+
+ + + + + + + + + + + + + + +
+ + + + + + + + + + + + + + +
Paramètres généraux:
+ + + + + + + + + + + + + + + + + + + +
Langage:
Page d'accueil:
Nombre de cartes DVB:
 
+
+ + + + + + + + + + + + + + +
Identification:             
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Utilisateur:
Mot de passe:
Compte invité: + oui non + + oui non +
Utilisateur invité:
Mot de passe invité:
+
 
+ 		+ + + + + + + + + + + + + + +
Paramètres Programmes Auto:
+ + + + + + + + + + + + + + + + + + + + + + + + + +
 Programme auto: + marche arrêt + + marche arrêt +
Timeout pour programme auto: minutes
Durée de vie d'un nouveau prog auto:
Priorité d'un nouveau prog auto:
 
+
+ + + + + + + + + + + + + + +
Paramètres des programmes:
+ + + + + + + + + + + + + + + + + + + + + + + + + +
Durée de vie d'un nouveau programme:
Priorité d'un nouveau programme:
Marge de début: minutes
Marge de fin: minutes
 
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+
+ Sélection de chaînes:
+ 		  +
+
Dans "Chaînes": + + oui non + + oui non + +
Dans "En ce moment": + + oui non + + oui non + +
+
+


+ + Toutes les chaînes
+

+
+ 		+
+


+

+

+

+

+
+ 		+
+


+ + Montrer les chaînes suivantes
+

+
+
+
+ +
+ + + diff --git a/template/French/error.html b/template/French/error.html new file mode 100644 index 0000000..081e956 --- /dev/null +++ b/template/French/error.html @@ -0,0 +1,18 @@ + + + + + Error! + + + +
+
+ + +
+
+

+ + + diff --git a/template/French/i18n.pl b/template/French/i18n.pl new file mode 100644 index 0000000..b329d80 --- /dev/null +++ b/template/French/i18n.pl @@ -0,0 +1,43 @@ +## +# French +## +@I18N_Days = ( + "Dimanche", + "Lundi", + "Mardi", + "Mercredi", + "Jeudi", + "Vendredi", + "Samedi" +); + +@I18N_Month = ( + "Janvier", + "Février", + "Mars", + "Avril", + "Mai", + "Juin", + "Juillet", + "Août", + "Septembre", + "Octobre", + "Novembre", + "Décembre" +); + +@LOGINPAGES_DESCRIPTION = ( + "En ce moment", + "Chaînes", + "Programmes", + "Enregistrements" +); + +%ERRORMESSAGE = ( + CONNECT_FAILED => "Impossible de se connecter à %s!", + SEND_COMMAND => "Erreur lors de l'envoi de la commande à %s", +); + +%COMMONMESSAGE = ( + OVERVIEW => "Vue d'ensemble", +); diff --git a/template/French/index.html b/template/French/index.html new file mode 100644 index 0000000..0b9dbdd --- /dev/null +++ b/template/French/index.html @@ -0,0 +1,22 @@ + + + + + + + VDR Admin <tmpl_var version> (<tmpl_var host>) + + + + + + + + <body bgcolor="#ffffff"> + <p></p> + </body> + + + + + diff --git a/template/French/left.html b/template/French/left.html new file mode 100644 index 0000000..2f9a8e5 --- /dev/null +++ b/template/French/left.html @@ -0,0 +1,131 @@ + + + + + + + + + + + + +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

+
 
 En ce moment
 Chaînes
 Programmes
 Programmes auto
 Enregistrements
 Configuration
 Télécommande
 TV
+  Recherche:
 
+  
+
+ + + diff --git a/template/French/navi.css b/template/French/navi.css new file mode 100644 index 0000000..2700538 --- /dev/null +++ b/template/French/navi.css @@ -0,0 +1,11 @@ +textarea { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, Geneva } +input { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, Geneva } +select { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, Geneva } +td { color: black; font-size: 11px; font-family: Verdana, Arial, Helvetica, Geneva } +p { color: black; font-size: 11px; font-family: Verdana, Arial, Helvetica, Geneva } +h1,h2,h3,h4,h5,h6 { color: black; font-family: Verdana, Arial, Helvetica, Geneva } +a { color: #000000; font-weight: bold; text-decoration: none } +.klein { font-size: 10px; font-family: Verdana, Arial, Helvetica, Geneva } +.small { font-size: 8px; font-family: Verdana, Arial, Helvetica, Geneva } +.navi { font-size: 12px; font-family: Verdana, Arial, Helvetica, Geneva } +a:hover { font-weight: bold; text-decoration: underline } diff --git a/template/French/noauth.html b/template/French/noauth.html new file mode 100644 index 0000000..f67705e --- /dev/null +++ b/template/French/noauth.html @@ -0,0 +1,13 @@ + + + Authorisation Requise + + + +

Authorisation Requise

+ +

This server could not verify that you are authorized to access the document requested. Either you supplied the wrong credentials (e.g., bad password), or your browser doesn't understand how to supply the credentials required.

+ + + + diff --git a/template/French/noperm.html b/template/French/noperm.html new file mode 100644 index 0000000..a0e4e49 --- /dev/null +++ b/template/French/noperm.html @@ -0,0 +1,12 @@ + + + <tmpl_var title> + + + +

+ +

+ + + diff --git a/template/French/prog_detail.html b/template/French/prog_detail.html new file mode 100644 index 0000000..60b46ca --- /dev/null +++ b/template/French/prog_detail.html @@ -0,0 +1,33 @@ + + + + + + + <tmpl_var title> + + + + + + + + + + + + + + + + + + + + +
| -
 

 +  [fermer] + 		 
+ + + diff --git a/template/French/prog_list.html b/template/French/prog_list.html new file mode 100644 index 0000000..420a9d6 --- /dev/null +++ b/template/French/prog_list.html @@ -0,0 +1,108 @@ + + + + + + + + + + + + +
+ + + + + + +
+

+ 		Choisissez une chaîne:  +   + +  
+ +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

+ 		+

+
      
  +

-

+ 		+



+ 		+

+ 		+

+ 		 
    
+
+ + + + + diff --git a/template/French/prog_summary.html b/template/French/prog_summary.html new file mode 100644 index 0000000..7f2ed63 --- /dev/null +++ b/template/French/prog_summary.html @@ -0,0 +1,85 @@ + + + + + + + VDRAdmin - En ce moment + + + + + +
+ + + + + + + +
+

+ 		En ce moment tout de suite | ou à:  + + +  
+
+ + + + + + + + + + + + + + + + + + + + + +
+ + + + + +
+ +

+

+

-

+
+
+
+
+ suite +
+
+
+ 		+
+
+
+ + diff --git a/template/French/rc.html b/template/French/rc.html new file mode 100644 index 0000000..544ae99 --- /dev/null +++ b/template/French/rc.html @@ -0,0 +1,110 @@ + + + + + + + <tmpl_var host> Télécommande + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + diff --git a/template/French/rec_list.html b/template/French/rec_list.html new file mode 100644 index 0000000..34200bc --- /dev/null +++ b/template/French/rec_list.html @@ -0,0 +1,123 @@ + + + + + + + + + + + + + + + + + + +
+

Enregistrements

+ 		  + + Total: + + ( + + ) | Free: + + ( + + ) +   
+
+ + + + +
  >>
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

+

  Date

  Heure

  Nom

+ 		  
  +

Total

+ 		+

Neu new

+ 		+

 

+ 		+

+ 		+

+ 		 
      

+ + + + + + +
+ +
Supprimer les enregistr. sélectionnés
 + +
+
+ +
+
+ + + diff --git a/template/French/style.css b/template/French/style.css new file mode 100644 index 0000000..96cf065 --- /dev/null +++ b/template/French/style.css @@ -0,0 +1,28 @@ +body { background: #c4cdd7 url(bilder/background.gif) repeat-x } +td { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +.rec { font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +div { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +input { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +textarea { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +select { color: #000; font-weight: normal; font-size: 11px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif } +b { font-weight: bold } +i { font-style: italic } +a { color: #039; text-decoration: none } +a:visited { color: #039; text-decoration: none } +a:hover { color: #cc0000; text-decoration: underline } +a:active { color: #000; text-decoration: underline } +a.rec:link { color: #c00; text-decoration: none } +a.rec:visited { color: #000; text-decoration: none } +a.rec:hover { color: #cc0000; text-decoration: underline } +a.rec:active { color: #000; text-decoration: underline } +.headline { font-weight: bold; font-size: 14px; margin-top: 20px; margin-bottom: 20px } +.subheadline { color: #039; font-weight: bold } +.kleine { font-size: 10px } +.mini { font-size: 9px } +.rechts { text-align: right} +.einzug { margin: 10px 12px } +.einzug_ohnetop { margin-right: 12px; margin-left: 12px } +.einzug_liste { margin: 3px 5px 0px 5px } +.einzug_liste_headlines { margin-right: 5px; margin-left: 6px } +.einzugklein { color: #000; font-weight: normal; font-size: 10px; font-family: Verdana, Arial, Geneva, Helvetica, sans-serif; margin-right: 7px; margin-left: 7px } +.gbutton { color: black; font-weight: bold } diff --git a/template/French/timer_list.html b/template/French/timer_list.html new file mode 100644 index 0000000..4bad271 --- /dev/null +++ b/template/French/timer_list.html @@ -0,0 +1,161 @@ + + + + + + + + + + + + + + + + + + + + +
+

Timer

+ 		  + + + + + + +
+ +
Nouveau prog.
 + +
+ 		 
+
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+

+ 		+

  Actif

+ 		+

  Chaîne

+ 		+

  Jour

+ 		+

  Début

+ 		+

  Fin

+ 		+

  Nom

+ 		   
  +

+ + + + + + + + + + + +  OuiNonVPSAuto + +

+ 		+

+ 		+

+ 		+

+ 		+

+ 		+

+ 		+

+ 		+

+ 		+

+ 		 
          

+ + + + + + +
+ +
Suppr. prog. sélectionnés
 + +
+
+ + diff --git a/template/French/timer_new.html b/template/French/timer_new.html new file mode 100644 index 0000000..3fe0b30 --- /dev/null +++ b/template/French/timer_new.html @@ -0,0 +1,172 @@ + + + + + VDRAdmin - <tmpl_if newtimer>Nouveau programme<tmpl_else>Edition programme</tmpl_if> + + + + + +
+ + + + + + + +
+

Nouveau programmeEditer programme

+ 		   
+
+
+ + + + + + + + + + + + + + +
   
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
 Programme actif + + oui + non + + oui + non + +
 Automatic Timer Checking + + program ID + recording time + disabled + + + recording time + disabled + + + recording time + disabled + +
 Chaîne
 Jour de l'enregistrement
+ Lundi Mardi Mercredi Jeudi Vendredi Samedi Dimanche
 Début :
 Fin :
 Priorité
 Durée de vie
 Titre
 Résumé
+
+
+
+
+
+ + + + + + + + + +
+ + + diff --git a/template/French/toolbar.html b/template/French/toolbar.html new file mode 100644 index 0000000..4b5cacc --- /dev/null +++ b/template/French/toolbar.html @@ -0,0 +1,40 @@ + + + + + + + Barre d'outils + + + +
+ + + + + + + + + + + + + +
+   +
+

+
+ + + diff --git a/template/French/tv.html b/template/French/tv.html new file mode 100644 index 0000000..0976ba8 --- /dev/null +++ b/template/French/tv.html @@ -0,0 +1,75 @@ + + + + TV (<tmpl_var host>) + + + + + + +
+ + + + + + + +
+ +
+
+ + Photo + Intervale +
+
+ + diff --git a/udpc.pl b/udpc.pl new file mode 120000 index 0000000..7888567 --- /dev/null +++ b/udpc.pl @@ -0,0 +1 @@ +udpd.pl \ No newline at end of file diff --git a/udpd.pl b/udpd.pl new file mode 100755 index 0000000..c4a38f1 --- /dev/null +++ b/udpd.pl @@ -0,0 +1,52 @@ +#!/usr/bin/perl + +## +# Simple UDP Server/Client to display messages in VDR +# +# 22.02.2004 by Thomas Koch +## + +use IO::Socket; +use IO::Socket::INET 1.26; +use strict; + +my $myself = join("", $0 =~ /^.*\/(.*)/); + +# Server +if($myself eq "udpd.pl") { + my $pid = fork(); + if($pid != 0) { + exit(0); + } + my($Socket) = IO::Socket::INET->new( + Proto => 'udp', + LocalPort => 4711, + Reuse => 1 + ) || die; + my $message; + while($Socket->recv($message, 1024)) { + my($port, $ipaddr) = sockaddr_in($Socket->peername); + my $hishost = gethostbyaddr($ipaddr, AF_INET); + system("logger udpd: client $hishost with message \\'$message\\'"); + for(my $z = 0; $z < 3; $z++) { + for(my $i = 0; $i < 3; $i++) { + system("svdrpsend.pl mesg $message 2>/dev/null >/dev/null"); + } + sleep(3); + } + } + exit(0); +} + +# Client +if($myself eq "udpc.pl") { + my $message = join(" ", @ARGV); + my $Socket = IO::Socket::INET->new( + PeerAddr => inet_ntoa(INADDR_BROADCAST), + PeerPort => 4711, + Proto => 'udp', + Broadcast => 1 + ) || die; + my $result = $Socket->send($message); +} + diff --git a/vdradmind.at b/vdradmind.at new file mode 100644 index 0000000..801f47b --- /dev/null +++ b/vdradmind.at @@ -0,0 +1 @@ +0:TEST:5:1200:1300:1:1:1:0::0 diff --git a/vdradmind.bl_example b/vdradmind.bl_example new file mode 100644 index 0000000..3791048 --- /dev/null +++ b/vdradmind.bl_example @@ -0,0 +1,2 @@ +Dr. Stefan Frank: Der Arzt, dem die Frauen vertrauen +Der Prinz von Bel-Air diff --git a/vdradmind.pl b/vdradmind.pl new file mode 100755 index 0000000..faa157c --- /dev/null +++ b/vdradmind.pl @@ -0,0 +1,3894 @@ +#!/usr/bin/perl + +# +# vdradmin.pl by Thomas Koch +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License +# as published by the Free Software Foundation; either version 2 +# of the License, or (at your option) any later version. +# +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# Or, point your browser to http://www.gnu.org/copyleft/gpl.html +# +# 08.10.2001 +# + + +my $BASENAME; +BEGIN { + $0 =~ /(^.*\/)/; + $BASENAME = $1; + unshift(@INC, "/usr/share/vdradmin/lib"); + unshift(@INC, $BASENAME . "lib/"); +} + +use CGI qw(:no_debug); +use IO::Socket; +use HTML::Template::Expr(); +use Template; +use Time::Local qw(timelocal); +use POSIX ":sys_wait_h", qw(strftime mktime); +use MIME::Base64(); + +$SIG{CHLD} = sub { wait }; + +use strict; +#use warnings; + +my $SEARCH_FILES_IN_SYSTEM = (-d '/usr/share/vdradmin/lib' ? 1 : 0); # for distribution + +sub true () { 1 }; +sub false () { 0 }; +sub CRLF () { "\r\n" }; +sub LOG_ACCESS () { 1 }; +sub LOG_SERVERCOM () { 2 }; +sub LOG_VDRCOM () { 4 }; +sub LOG_STATS () { 8 }; +sub LOG_AT () { 16 }; +sub LOG_CHECKTIMER () { 32 }; +sub LOG_FATALERROR () { 64 }; +sub LOG_DEBUG () { 32768 }; + +my %CONFIG; +$CONFIG{VDR_HOST} = "localhost"; +$CONFIG{VDR_PORT} = 2001; +$CONFIG{USERNAME} = "linvdr"; +$CONFIG{PASSWORD} = "linvdr"; +$CONFIG{GUEST_ACCOUNT} = 0; +$CONFIG{LANGUAGE} = "Deutsch"; +$CONFIG{LOGLEVEL} = 81; # 32799 +$CONFIG{CACHE_TIMEOUT} = 60; +$CONFIG{CACHE_LASTUPDATE} = 0; +$CONFIG{AT_FUNC} = 1; +$CONFIG{AT_TIMEOUT} = 120; +$CONFIG{AT_LIFETIME} = 99; +$CONFIG{AT_PRIORITY} = 99; +$CONFIG{TM_LIFETIME} = 99; +$CONFIG{TM_PRIORITY} = 99; +$CONFIG{TM_MARGIN_BEGIN} = 10; +$CONFIG{TM_MARGIN_END} = 10; +$CONFIG{ST_FUNC} = 1; +$CONFIG{ST_URL} = ""; +$CONFIG{LOGINPAGE} = 0; +$CONFIG{LOGGING} = 0; +$CONFIG{MOD_GZIP} = 0; +# +$CONFIG{LOGFILE} = "vdradmind.log"; +$CONFIG{SERVERPORT} = 8001; +$CONFIG{RECORDINGS} = 1; +$CONFIG{ZEITRAHMEN} = 1; +$CONFIG{TIMES} = '18:00, 20:00, 21:00, 22:00'; +$CONFIG{EPG_DIRECT} = 1; +$CONFIG{EPG_FILENAME} = "/video/epg.data"; +$CONFIG{SKIN} = 'bilder'; + +my $VERSION = "0.97-am1"; +my $SERVERVERSION = "vdradmind/$VERSION"; +my $VIDEODIR = "/video"; +my $DONE = &DONE_Read || {}; + +my($TEMPLATEDIR, $CONFFILE, $LOGFILE, $PIDFILE, $AT_FILENAME, $DONE_FILENAME, $BL_FILENAME); +if(!$SEARCH_FILES_IN_SYSTEM) { + $TEMPLATEDIR = "${BASENAME}template"; + $CONFFILE = "${BASENAME}vdradmind.conf"; + $LOGFILE = "${BASENAME}$CONFIG{LOGFILE}"; + $PIDFILE = "${BASENAME}vdradmind.pid"; + $AT_FILENAME = "${BASENAME}vdradmind.at"; + $DONE_FILENAME = "${BASENAME}vdradmind.done"; + $BL_FILENAME = "${BASENAME}vdradmind.bl"; +} else { + $TEMPLATEDIR = "/usr/share/vdradmin/template"; + $CONFFILE = "/etc/vdradmin/vdradmind.conf"; + $LOGFILE = "/var/log/$CONFIG{LOGFILE}"; + $PIDFILE = "/var/run/vdradmind.pid"; + $AT_FILENAME = "/etc/vdradmin/vdradmind.at"; + $DONE_FILENAME = "/etc/vdradmin/vdradmind.done"; + $BL_FILENAME = "/etc/vdradmin/vdradmind.bl"; +} + +# IMHO a better Template Modul ;-) +# some useful options (see below for full list) +my $Xconfig = { + START_TAG => '\<\?\%', # Tagstyle + END_TAG => '\%\?\>', # Tagstyle + INCLUDE_PATH => $TEMPLATEDIR, # or list ref + INTERPOLATE => 1, # expand "$var" in plain text + PRE_CHOMP => 1, # cleanup whitespace + POST_CHOMP => 1, # cleanup whitespace + EVAL_PERL => 1, # evaluate Perl code blocks + CACHE_SIZE => 10000, # Tuning for Templates + COMPILE_EXT => 'cache', # Tuning for Templates + COMPILE_DIR => '/tmp', # Tuning for Templates + +}; + +# create Template object +my $Xtemplate = Template->new($Xconfig); +# ---- End new template section ---- + +my $I18NFILE = "i18n.pl"; +my $USE_SHELL_GZIP = true; # set on false to use the gzip library + +if($CONFIG{MOD_GZIP}) { + # lib gzipping + use Compress::Zlib; +} + +my($DEBUG) = 0; +my(%EPG, @CHAN, $q, $ACCEPT_GZIP, $SVDRP, $HOST); +my(%mimehash) = ( + html => "text/html", + png => "image/png", + gif => "image/gif", + jpg => "image/jpeg", + css => "text/css", + ico => "image/x-icon", + js => "application/x-javascript", + swf => "application/x-shockwave-flash" +); +my @LOGINPAGES = qw(prog_list prog_list2 prog_summary prog_timeline timer_list rec_list); + + +$SIG{INT} = \&Shutdown; +$SIG{TERM} = \&Shutdown; +$SIG{HUP} = \&HupSignal; +$SIG{PIPE} = 'IGNORE'; + +# +my $DAEMON = 1; +for(my $i = 0; $i < scalar(@ARGV); $i++) { + $_ = $ARGV[$i]; + if(/-h|--help/) { + print("Usage $0 [OPTION]...\n"); + print("A perl client for the Linux Video Disk Recorder.\n\n"); + print(" -nf --nofork don't fork\n"); + print(" -c --config run configuration dialog\n"); + print(" -k --kill kill a fork'ed vdradmin\n"); + print(" -h --help this here\n"); + print("\nReport bugs to .\n"); + exit(0); + } + if(/--nofork|-nf/) { $DAEMON = 0; last; } + if(/--config|-c/) { + $CONFIG{VDR_HOST} = Question("What's your VDR hostname (e.g video.intra.net)?", "localhost"); + $CONFIG{VDR_PORT} = Question("What's the port VDR listen to SVDRP query's?", "2001"); + $CONFIG{SERVERHOST} = Question("On which address should vdradmin listen (0.0.0.0 for any)?", "0.0.0.0"); + $CONFIG{SERVERPORT} = Question("On which port should vdradmin answer?", "8001"); + $CONFIG{USERNAME} = Question("Username?", "linvdr"); + $CONFIG{PASSWORD} = Question("Password?", "linvdr"); + $CONFIG{EPG_FILENAME} = Question("Where is your epg.data?", "/video/epg.data"); + $CONFIG{EPG_DIRECT} = ($CONFIG{EPG_FILENAME} and -e $CONFIG{EPG_FILENAME} ? 1 : 0); + + open(CONF, ">$CONFFILE") || die "Cannot open $CONFFILE: $!\n"; + for(keys(%CONFIG)) { + print(CONF "$_ = $CONFIG{$_}\n"); + } + close(CONF); + + print("Config file sucessfull written.\n"); + exit(0); + } + if(/--kill|-k/) { + kill(2, getPID($PIDFILE)); + unlink($PIDFILE); + exit(0); + } + if(/--displaycall|-i/) { + for(my $z = 0; $z < 5; $z++) { + DisplayMessage($ARGV[$i+1]); + sleep(3); + } + CloseSocket(); + exit(0); + } + if(/--message|-m/) { + DisplayMessage($ARGV[$i+1]); + CloseSocket(); + exit(0); + } +} + +ReadConfig(); + + +if(-e "$PIDFILE") { + print "There's already an copy of this program running! (pid: " . getPID($PIDFILE) . ")\n"; + print "If you feel this is a error, remove $PIDFILE!\n"; + exit(0); +} + +if($DAEMON) { + my($pid) = fork; + if($pid != 0) { + print("vdradmind.pl $VERSION started with pid $pid.\n"); + writePID($pid); + exit(0); + } +} + + +my($Socket) = IO::Socket::INET->new( + Proto => 'tcp', + LocalPort => $CONFIG{SERVERPORT}, + LocalAddr => $CONFIG{SERVERHOST}, + Listen => 10, + Reuse => 1 +); +die("can't start server: $!\n") if (!$Socket); +$Socket->timeout($CONFIG{AT_TIMEOUT} * 60) if($CONFIG{AT_FUNC}); +$CONFIG{CACHE_LASTUPDATE} = 0; + +# +my(@I18N_Days, @I18N_Month, %ERRORMESSAGE, %COMMONMESSAGE, + @LOGINPAGES_DESCRIPTION, %HELP); +LoadTranslation(); + +UptoDate(); + +## +# Mainloop +## +my($Client, $MyURL, $Referer, $Request, $Query, $Guest); +my @GUEST_USER = qw(prog_detail prog_list prog_list2 prog_timeline timer_list at_timer_list + prog_summary rec_list rec_detail show_top toolbar show_help); +my @TRUSTED_USER = (@GUEST_USER, qw(at_timer_edit at_timer_new at_timer_save + at_timer_delete timer_new_form timer_add timer_delete timer_toggle rec_delete rec_rename rec_edit + conf_list prog_switch rc_show rc_hitk grab_picture at_timer_toggle tv_show + live_stream rec_stream force_update)); + +# Force Update at start +UptoDate(1); + + +while(true) { + $Client = $Socket->accept(); + + # + if(!$Client) { + UptoDate(1); + next; + } + + my $peer = $Client->peerhost; + my @Request = ParseRequest($Client); + my $raw_request = $Request[0]; + + $ACCEPT_GZIP = 0; + + if($raw_request =~ /^GET (\/[\w\.\/-\:]*)([\?[\w=&\.\+\%-\:\!]*]*)[\#\d ]+HTTP\/1.\d$/) { + ($Request, $Query) = ($1, $2 ? substr($2, 1, length($2)) : undef); + } else { + Error("404", "Not Found", "The requested URL /bad_request was not found on this server."); + close($Client); + next; + } + + # parse header + my($username, $password, $http_useragent); + for my $line (@Request) { + if($line =~ /Referer: (.*)/) { + $Referer = $1; + } + if($line =~ /Host: (.*)/) { + $HOST = $1; + } + if($line =~ /Authorization: basic (.*)/i) { + ($username, $password) = split(":", MIME::Base64::decode_base64($1), 2); + } + if($line =~ /User-Agent: (.*)/i) { + $http_useragent = $1; + } + if($line =~ /Accept-Encoding: (.*)/i) { + if($1 =~ /gzip/) { + $ACCEPT_GZIP = 1; + } + } + } + + # authenticate + if($CONFIG{USERNAME} eq $username && $CONFIG{PASSWORD} eq $password) { + $Guest = 0; + } elsif(($CONFIG{USERNAME_GUEST} eq $username && $CONFIG{PASSWORD_GUEST} eq $password) && $CONFIG{GUEST_ACCOUNT}) { + $Guest = 1; + } else { + headerNoAuth(); + close($Client); + next; + } + + + # serve request + $SVDRP = SVDRP->new; + my ($http_status, $bytes_transfered); + $MyURL = "." . $Request; + if($Request eq "/vdradmin.pl") { + $q = CGI->new($Query); + my $aktion; + + my @ALLOWED_FUNCTIONS; + $Guest ? (@ALLOWED_FUNCTIONS = @GUEST_USER) : (@ALLOWED_FUNCTIONS = @TRUSTED_USER); + + for(@ALLOWED_FUNCTIONS) { + ($aktion = $q->param("aktion")) if($q->param("aktion") eq $_); + } + if($aktion) { + eval("(\$http_status, \$bytes_transfered) = $aktion();"); + } else { + # XXX redirect to no access template + Error("403", "Forbidden", "You don't have permission to access this function."); + next; + } + } elsif($Request eq "/") { + $MyURL = "./vdradmin.pl"; + ($http_status, $bytes_transfered) = show_index(); + } else { + ($http_status, $bytes_transfered) = SendFile($Request); + } + Log(LOG_ACCESS, access_log($Client->peerhost, $username, time(), $raw_request, + $http_status, $bytes_transfered, $Request, $http_useragent)); + close($Client); + $SVDRP->close; +} + +############################################################################# +############################################################################# +sub GetChannelDesc { + my(%hash); + for(@CHAN) { + $hash{$_->{id}} = $_->{name}; + } + return(%hash); +} + +sub GetChannelDescByNumber { + my $vdr_id = shift; + + if($vdr_id) { + for(@CHAN) { + if($_->{vdr_id} == $vdr_id) { + return($_->{name}); + } + } + } else { return(0); } +} + +sub include { + my $file = shift; + if($file) { + eval(ReadFile($file)); + } +} + +sub ReadFile { + my $file = shift; + return if(!$file); + + open(I18N, $file) || HTMLError("Cannot open $file!"); + my $buf = join("", ); + close(I18N); + return($buf); +} + +sub FullDay { + return($I18N_Days[shift]); +} + +sub FullMonth { + return($I18N_Month[shift()-1]); +} + +sub GetChannelID { + my($sid) = $_[0]; + for(@CHAN) { + if($_->{id} == $sid) { + return($_->{number}); + } + } +} + +sub EURL { + my($text) = @_; + $text =~ s/([^0-9a-zA-Z])/sprintf("%%%2.2x", ord($1))/ge; + return($text); +} + +sub HTMLError { + my $error = join("", @_); + my $template = HTML::Template->new( + filename => "$TEMPLATEDIR/$CONFIG{LANGUAGE}/error.html"); + $template->param(error => $error); + $CONFIG{CACHE_LASTUPDATE} = 0; + return(header("200", "text/html", $template->output)); +} + + +sub FillInZero { + my($str, $length) = @_; + while(length($str) < $length) { + $str = "0$str"; + } + return($str); +} + +sub MHz { + my $frequency = shift; + while($frequency > 20000) { + $frequency /= 1000; + } + return(int($frequency)); +} + +sub ChanTree { + undef(@CHAN); + $SVDRP->command("lstc"); + while($_ = $SVDRP->readoneline) { + chomp; + my($vdr_id, $temp) = split(/ /, $_, 2); + my($name, $frequency, $polarization, $source, $symbolrate, $vpid, $apid, + $tpid, $ca, $service_id, $nid, $tid, $rid) = split(/\:/, $temp); + $name =~ /(^[^,;]*).*/; #TODO? + $name = $1; + push(@CHAN, { + vdr_id => $vdr_id, + name => $name, + frequency => MHz($frequency), + polarization => $polarization, + source => $source, + symbolrate => $symbolrate, + vpid => $vpid, + apid => $apid, + tpid => $tpid, + ca => $ca, + service_id => $service_id, + nid => $nid, + tid => $tid, + rid => $rid + }); + } +} + +sub get_vdrid_from_channelid { + my $channel_id = shift; + if($channel_id =~ /^(\d*)$/) { # vdr 1.0.x & >= vdr 1.1.15 + for my $channel (@CHAN) { + if($channel->{service_id} == $1) { + return($channel->{vdr_id}); + } + } + } elsif($channel_id =~ /^(.*)-(.*)-(.*)-(.*)-(.*)$/) { + for my $channel (@CHAN) { + if($channel->{source} eq $1 && + $channel->{nid} == $2 && + ($channel->{nid} ? $channel->{tid} : $channel->{frequency}) == $3 && + $channel->{service_id} == $4 && + $channel->{rid} == $5) { + return($channel->{vdr_id}); + } + } + } elsif($channel_id =~ /^(.*)-(.*)-(.*)-(.*)$/) { + for my $channel (@CHAN) { + if($channel->{source} eq $1 && + $channel->{nid} == $2 && + ($channel->{nid} ? $channel->{tid} : $channel->{frequency}) == $3 && + $channel->{service_id} == $4) { + return($channel->{vdr_id}); + } + } + } else { + print "Can't find channel_id $channel_id\n"; + } +} + +sub get_name_from_vdrid { + my $vdr_id = shift; + if($vdr_id) { + # Kanalliste nach identischer vdr_id durchsuchen + my @C = grep($_->{vdr_id} == $vdr_id, @CHAN); + # Es darf nach Spec nur eine ‹bereinstimmung geben + if(scalar(@C) == 1) { + return $C[0]->{name}; + } + } +} + +sub get_transponder_from_vdrid { + my $vdr_id = shift; + if($vdr_id) { + # Kanalliste nach identischer vdr_id durchsuchen + my @C = grep($_->{vdr_id} == $vdr_id, @CHAN); + # Es darf nach Spec nur eine ‹bereinstimmung geben + if(scalar(@C) == 1) { + return("$C[0]->{source}-$C[0]->{frequency}-$C[0]->{polarization}"); + } + } +} + +sub get_ca_from_vdrid { + my $vdr_id = shift; + if($vdr_id) { + # Kanalliste nach identischer vdr_id durchsuchen + my @C = grep($_->{vdr_id} == $vdr_id, @CHAN); + # Es darf nach Spec nur eine ‹bereinstimmung geben + if(scalar(@C) == 1) { + return($C[0]->{ca}); + } + } +} + +############################################################################# +# EPG functions +############################################################################# + +sub EPG_getEntry { + my $vdr_id = shift; + my $epg_id = shift; + if($vdr_id && $epg_id) { + for(@{$EPG{$vdr_id}}) { + #if($_->{id} == $epg_id) { + if($_->{event_id} == $epg_id) { + return($_); + } + } + } +} + +sub getNumberOfElements { + my $ref = shift; + if($ref) { + return(@{$ref}); + } else { + return(0); + } +} + +sub getElement { + my $ref = shift; + my $index = shift; + if($ref) { + return($ref->[$index]); + } else { + return; + } +} + +sub EPG_buildTree { + $SVDRP->command("lste"); + my($i, @events); + my($id, $bc) = (1, 0); + undef(%EPG); + while($_ = $SVDRP->readoneline) { + chomp; + if(/^C ([^ ]+) *(.*)/) { + $bc++; + undef(@events); + my($channel_id, $channel_name) = ($1, $2); + my $vdr_id = get_vdrid_from_channelid($channel_id); + while($_ = $SVDRP->readoneline) { + if(/^E (.*) (.*) (.*) (.*)/ || /^E (.*) (.*) (.*)/) { + my($event_id, $time, $duration) = ($1, $2, $3); + my($title, $subtitle, $summary); + while($_ = $SVDRP->readoneline) { + if(/^T (.*)/) { $title = $1; $title =~ s/\|/
/sig } + if(/^S (.*)/) { $subtitle = $1; $subtitle =~ s/\|/
/sig } + if(/^D (.*)/) { $summary = $1; $summary =~ s/\|/
/sig } + if(/^e/) { + # + push(@events, { + channel_name => $channel_name, + start => $time, + stop => $time + $duration, + duration => $duration, + title => $title, + subtitle => $subtitle, + summary => $summary, + id => $id, + vdr_id => $vdr_id, + event_id => $event_id + }); + $id++; + last; + } + } + } elsif(/^c/) { + my($last) = 0; + my(@temp); + for(sort({ $a->{start} <=> $b->{start} } @events)) { + next if($last == $_->{start}); + push(@temp, $_); + $last = $_->{start}; + } + $EPG{$vdr_id} = [ @temp ]; + last; + } + } + } + } + Log(LOG_STATS, "EPGTree: $id events, $bc broadcasters"); +} + + +############################################################################# +# Socket functions +############################################################################# + +sub PrintToClient { + my $string = join("", @_); + return if(!defined($string)); + print($Client $string) if($Client); +} + +sub ParseRequest { + my $Socket = shift; + my (@Request, $Line); + do { + $Line = <$Socket>; + $Line =~ s/\r\n//g; + push(@Request, $Line); + } while($Line); + return(@Request); +} + +sub CloseSocket { + $SVDRP->close(); +} + +sub OpenSocket { + $SVDRP = SVDRP->new; +} + +sub SendCMD { + my $cmd = join("", @_); + + OpenSocket() if(!$SVDRP); + + my @output; + $SVDRP->command($cmd); + while($_ = $SVDRP->readoneline) { + push(@output, $_); + } + return(@output); +} + +sub mygmtime() { + gmtime; +} + +sub headerTime { + my $time = shift; + $time = time() if(!$time); + my @weekdays = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"); + my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"); + + return( + sprintf("%s, %s %s %s %02d:%02d:%02d GMT", + $weekdays[my_strfgmtime("%w", $time)], + my_strfgmtime("%d", $time), + $months[my_strfgmtime("%m", $time) - 1], + my_strfgmtime("%Y", $time), + my_strfgmtime("%H", $time), + my_strfgmtime("%M", $time), + my_strfgmtime("%S", $time) + ) + ); +} + +sub GZip { + my $content = shift; + my $filename = "/tmp/vdradmin." . time(); + open(PIPE, "| gzip -9 - > $filename") || die "cant open pipe to gzip ($!)"; + print PIPE $$content; + close(PIPE); + + open(FILE, $filename) || die "cant open $filename ($1)"; + my $result = join("", ); + close(FILE); + + unlink($filename); + + #my $pid = open2(*RDFH, *WTFH, "gzip -1 -c -"); + #print "Write\n"; + #print WTFH $$content; + #print "Done\n"; + #close(WTFH); + #my $result = join("", ); + #close(RDFH); + #waitpid($pid, 0); + + return($result); +} + +sub LibGZip { + my $content = shift; + return(Compress::Zlib::memGzip($$content)); +} + +sub header { + my($status, $ContentType, $data, $caching) = @_; + Log(LOG_STATS, "Template Error: ".$Xtemplate->error()) + if($status >= 500); + if($ACCEPT_GZIP && $CONFIG{MOD_GZIP}) { + if($USE_SHELL_GZIP) { + $data = GZip(\$data); + } else { + $data = LibGZip(\$data); + } + } + + my $status_text = " OK" if($status eq "200"); + + PrintToClient("HTTP/1.0 $status$status_text", CRLF); + PrintToClient("Date: ", headerTime(), CRLF); + if(!$caching) { + PrintToClient("Expires: Mon, 26 Jul 1997 05:00:00 GMT", CRLF); + PrintToClient("Cache-Control: max-age=0", CRLF); + } else { + PrintToClient("Expires: ", headerTime(time() + 3600), CRLF); + PrintToClient("Cache-Control: max-age=3600", CRLF); + } + PrintToClient("Server: $SERVERVERSION", CRLF); + PrintToClient("Content-Length: ", length($data), CRLF) if($data); + PrintToClient("Connection: close", CRLF); + PrintToClient("Content-encoding: gzip", CRLF) if($CONFIG{MOD_GZIP} && $ACCEPT_GZIP); + PrintToClient("Content-type: $ContentType", CRLF, CRLF) if($ContentType); + PrintToClient($data) if($data); + return($status, length($data)); +} + +sub headerForward { + my $url = shift; + PrintToClient("HTTP/1.0 302 Found", CRLF); + PrintToClient("Date: ", headerTime(), CRLF); + PrintToClient("Server: $SERVERVERSION", CRLF); + PrintToClient("Connection: close", CRLF); + PrintToClient("Location: $url", CRLF); + PrintToClient("Content-type: text/html", CRLF, CRLF); + return(302, 0); +} + +sub headerNoAuth { + my $template = TemplateNew("noauth.html"); + my $data = $template->output; + PrintToClient("HTTP/1.0 401 Authorization Required", CRLF); + PrintToClient("Date: ", headerTime(), CRLF); + PrintToClient("Server: $SERVERVERSION", CRLF); + PrintToClient("WWW-Authenticate: Basic realm=\"vdradmind\"", CRLF); + PrintToClient("Content-Length: ", length($data), CRLF) if($data); + PrintToClient("Connection: close", CRLF); + PrintToClient("Content-type: text/html", CRLF, CRLF); + PrintToClient($data); + return(401, length($data)); +} + +sub Error { + my $template = HTML::Template->new( + filename => "$TEMPLATEDIR/$CONFIG{LANGUAGE}/noperm.html"); + $template->param( + title => $_[0], + h1 => $_[1], + error => $_[2], + ); + return(header("$_[0] $_[1]", "text/html", $template->output)); +} + +sub SendFile { + my($File) = @_; + my($buf, $temp); + $File =~ s/^\///; + $File =~ s/^bilder/$CONFIG{SKIN}/i + if(defined $CONFIG{SKIN}); + my $FileWithPath = sprintf("%s/%s/%s", +# my $FileWithPath = sprintf("%s/%s/%s/%s", +# $BASENAME, + $TEMPLATEDIR, + $CONFIG{LANGUAGE}, + $File); + + # Skin css file + $FileWithPath = sprintf('%s/%s/%s/%s', $TEMPLATEDIR, $CONFIG{LANGUAGE}, $CONFIG{SKIN}, $File) + if((split('[/\.]',$File))[-1] eq 'css' and -e sprintf('%s/%s/%s/%s', $TEMPLATEDIR, $CONFIG{LANGUAGE}, $CONFIG{SKIN}, $File)); + + if(-e $FileWithPath) { + if(-r $FileWithPath) { + $buf = ReadFile($FileWithPath); + $temp = $File; + $temp =~ /([A-Za-z0-9]+)\.([A-Za-z0-9]+)/; + if(!$mimehash{$2}) { die("can't find mime-type \'$2\'\n"); } + return(header("200", $mimehash{$2}, $buf, 1)); + } else { + Error("403", "Forbidden", "You don't have permission to access /$File on this server."); + } + } else { + Error("404", "Not Found", "The requested URL /$File was not found on this server."); + } +} + +############################################################################# +# autotimer functions +############################################################################# +sub AT_Read { + my(@at); + if(-e $AT_FILENAME) { + open(AT_FILE, $AT_FILENAME) || + HTMLError("Cant open $AT_FILENAME!"); + while() { + chomp; + next if($_ eq ""); + my($active, $pattern, $section, $start, $stop, $episode, $prio, $lft, $channel, $directory, $done) = split(/\:/, $_); + push(@at, { + active => $active, + pattern => $pattern, + section => $section, + start => $start, + stop => $stop, + episode => $episode, + prio => $prio, + lft => $lft, + channel => $channel, + directory => $directory, + done => $done + }); + } + close(AT_FILE); + } + return(@at); +} + +sub AT_Write { + my @at = @_; + open(AT_FILE, ">" . $AT_FILENAME) || + HTMLError("Cant open $AT_FILENAME!"); + for(@at) { + my $temp; + for my $item (qw(active pattern section start stop episode prio lft channel directory done)) { + $_->{$item} =~ s/\:/_/g; + if(length($temp) == 0) { + $temp = $_->{$item}; + } else { + $temp .= ":" . $_->{$item}; + } + } + print AT_FILE $temp, "\n"; + } + close(AT_FILE); +} + +sub DONE_Write { + my $done = shift || return; + open(DONE_FILE, ">" . $DONE_FILENAME) || HTMLError("Cant open $DONE_FILENAME!"); + foreach my $n (sort keys %$done) { + printf DONE_FILE "%s::%d::%s\n", $n, $done->{$n}, scalar localtime($done->{$n}); + }; + close(DONE_FILE); +} + +sub DONE_Read { + my $done; + if(-e $DONE_FILENAME) { + open(DONE_FILE, $DONE_FILENAME) || HTMLError("Cant open $AT_FILENAME!"); + while() { + chomp; + next if($_ eq ""); + my @line = split('\:\:', $_); + $done->{$line[0]} = $line[1]; + } + close(DONE_FILE); + } + return $done; +} + +sub BlackList_Read { + my %blacklist; + if(-e $BL_FILENAME) { + open(BL_FILE, $BL_FILENAME) || HTMLError("Cant open $BL_FILENAME!"); + while() { + chomp; + next if($_ eq ""); + $blacklist{$_} = 1; + } + close(BL_FILE); + } + return %blacklist; +} + + +sub AutoTimer { + return if(!$CONFIG{AT_FUNC}); + Log(LOG_AT, "Auto Timer: Scanning for events..."); + my($search, $start, $stop) = @_; + + my @at = AT_Read(); + $DONE = &DONE_Read unless($DONE); + my %blacklist = &BlackList_Read; + + # Merken der wanted Channels (geht schneller + # bevor das immer wieder in der unteren Schleife gemacht wird). + my $wanted; + for my $n ( split( ",", $CONFIG{CHANNELS_WANTED} ) ) { + $wanted->{$n} = 1; + } + + # Die Timerliste holen + my $timer; + foreach my $t (ParseTimer(0)){ + my $key = sprintf('%d:%s:%s', + $t->{vdr_id}, + $t->{title} + ); + $timer->{$key} = $t; + } + + for my $sender (keys(%EPG)) { + for my $event (@{$EPG{$sender}}) { + for my $at (@at) { + if(!$at->{active}) { + next; + } + + # Ein Timer der schon programmmiert wurde kann + # ignoriert werden + next if($event->{event_id} == $timer->{event_id}); + + # Wenn CHANNELS_WANTED_AUTOTIMER dann next wenn der Kanal + # nicht in der WantedList steht + if($CONFIG{CHANNELS_WANTED_AUTOTIMER}) { + next unless defined $wanted->{ $event->{vdr_id} }; + } + + if($at->{channel}) { + if($at->{channel} != $event->{vdr_id}) { + next; + } + } + + # Hamwa schon gehabt? + my $DoneStr = sprintf('%s~%s', + $event->{title}, + ($event->{subtitle} ? $event->{subtitle} : ''), + ); + + if(exists $DONE->{$DoneStr}) { + Log(LOG_DEBUG, sprintf("Auto Timer: already done \"%s\"", $DoneStr)); + next; + } + + # Wollen wir nicht haben. + my $BLStr = $event->{title}; + $BLStr .= "~" . $event->{subtitle} if $event->{subtitle}; + + if($blacklist{$BLStr} eq 1 || $blacklist{$event->{title}} eq 1) { + Log(LOG_DEBUG, sprintf("Auto Timer: blacklisted \"%s\"", $event->{title})); + next; + } + + + + my $SearchStr; + if($at->{section} & 1) { + $SearchStr = $event->{title}; + } + if(($at->{section} & 2) && defined($event->{subtitle})) { + $SearchStr .= "~" . $event->{subtitle}; + } + if($at->{section} & 4) { + $SearchStr .= "~" . $event->{summary}; + } + + # Regular Expressions are surrounded by slashes -- everything else + # are search patterns + if($at->{pattern} =~ /^\/(.*)\/(i?)$/) { + # We have a RegExp + Log(LOG_DEBUG, sprintf("Auto Timer: Checking RegExp \"%s\"", $at->{pattern})); + + if((! length($SearchStr)) || (! length($1))) { + Log(LOG_DEBUG, "No search string or regexp, skipping!"); + next; + } + + next if(!defined($1)); + # Shall we search case insensitive? + if(($2 eq "i") && ($SearchStr !~ /$1/i)) { + next; + } elsif(($2 ne "i") && ($SearchStr !~ /$1/)) { + next; + } else { + Log(LOG_AT, sprintf("Auto Timer: RegExp \"%s\" matches \"%s\"", $at->{pattern}, $SearchStr)); + } + } else { + # We have a search pattern + Log(LOG_DEBUG, sprintf("Auto Timer: Checking pattern \"%s\"", $at->{pattern})); + + # Escape special characters within the search pattern + my $atpattern = $at->{pattern}; + #$atpattern =~ s/([\+\?\.\*\^\$\(\)\[\]\{\}\|\\])/\\\1/g; + $atpattern =~ s/([\+\?\.\*\^\$\(\)\[\]\{\}\|\\])/\\$1/g; + + Log(LOG_DEBUG, sprintf("Auto Timer: Escaped pattern: \"%s\"", $atpattern)); + + if((! length($SearchStr)) || (! length($atpattern))) { + Log(LOG_DEBUG, "No search string or pattern, skipping!"); + next; + } + # split search pattern at spaces into single sub-patterns, and + # test for all of them (logical "and") + my $fp = 1; + for my $pattern (split(/ +/, $atpattern)) { + # search for each sub-pattern, case insensitive + if($SearchStr !~ /$pattern/i) { + $fp = 0; + } else { + Log(LOG_DEBUG, sprintf("Auto Timer: Found matching pattern: \"%s\"", $pattern)); + } + } + next if(!$fp); + } + + Log(LOG_DEBUG, sprintf("Auto Timer: Comparing pattern \"%s\" (%s - %s) with event \"%s\" (%s - %s)", + $at->{pattern}, $at->{start}, $at->{stop}, + $event->{title}, my_strftime("%H%M", $event->{start}), my_strftime("%H%M", $event->{stop}))); + # Do we have a time slot? + if($at->{start}) { + # We have a start time and possibly a stop time for the auto timer + # Do we have Midnight between AT start and stop time? + if(($at->{stop}) && ($at->{stop} < $at->{start})) { + # The AT includes Midnight + Log(LOG_DEBUG, "922: AT includes Midnight"); + # Do we have Midnight between Event start and stop? + if(my_strftime("%H%M", $event->{stop}) < my_strftime("%H%M", $event->{start})) { + # The event includes Midnight + Log(LOG_DEBUG, "926: Event includes Midnight"); + if(my_strftime("%H%M", $event->{start}) < $at->{start}) { + Log(LOG_DEBUG, "924: Event starts before AT start"); + next; + } + if(my_strftime("%H%M", $event->{stop}) > $at->{stop}) { + Log(LOG_DEBUG, "932: Event ends after AT stop"); + next; + } + } else { + # Normal event not spreading over Midnight + Log(LOG_DEBUG, "937: Event does not includes Midnight"); + if(my_strftime("%H%M", $event->{start}) < $at->{start}) { + if(my_strftime("%H%M", $event->{start}) > $at->{stop}) { + # The event starts before AT start and after AT stop + Log(LOG_DEBUG, "941: Event starts before AT start and after AT stop"); + next; + } + if(my_strftime("%H%M", $event->{stop}) > $at->{stop}) { + # The event ends after AT stop + Log(LOG_DEBUG, "946: Event ends after AT stop"); + next; + } + } + } + } else { + # Normal auto timer, not spreading over midnight + Log(LOG_DEBUG, "953: AT does not include Midnight"); + # Is the event spreading over midnight? + if(my_strftime("%H%M", $event->{stop}) < my_strftime("%H%M", $event->{start})) { + # Event spreads midnight + if($at->{stop}) { + # We have a AT stop time defined before midnight -- no match + Log(LOG_DEBUG, "959: Event includes Midnight, Autotimer not"); + next; + } + } else { + # We have a normal event, nothing special + # Event must not start before AT start + if(my_strftime("%H%M", $event->{start}) < $at->{start}) { + Log(LOG_DEBUG, "963: Event starts before AT start"); + next; + } + # Event must not end after AT stop + if(($at->{stop}) && (my_strftime("%H%M", $event->{stop}) > $at->{stop})) { + Log(LOG_DEBUG, "968: Event ends after AT stop"); + next; + } + } + } + } else { + # We have no AT start time + if($at->{stop}) { + if(my_strftime("%H%M", $event->{stop}) > $at->{stop}) { + Log(LOG_DEBUG, "977: Only AT stop time, Event stops after AT stop"); + next; + } + } + } + + Log(LOG_AT, sprintf("Auto Timer: Found \"%s\"", $at->{pattern})); + +######################################################################################### +# 20050130: patch by macfly: parse extended EPG information provided by tvm2vdr.pl +######################################################################################### + + my $title = $event->{title}; + my %at_details; + + if($at->{directory}) { + $title = $at->{directory}; + $at_details{'title'} = $event->{title}; + $at_details{'subtitle'} = $event->{subtitle} ? $event->{subtitle} : my_strftime("%Y-%m-%d", $event->{start}); + $at_details{'date'} = my_strftime("%Y-%m-%d", $event->{start}); + $at_details{'regie'} = $1 if $event->{summary} =~ m/\|Director: (.*?)\|/; + $at_details{'category'} = $1 if $event->{summary} =~ m/\|Category: (.*?)\|/; + $at_details{'genre'} = $1 if $event->{summary} =~ m/\|Genre: (.*?)\|/; + $at_details{'year'} = $1 if $event->{summary} =~ m/\|Year: (.*?)\|/; + $at_details{'country'} = $1 if $event->{summary} =~ m/\|Country: (.*?)\|/; + $at_details{'originaltitle'} = $1 if $event->{summary} =~ m/\|Originaltitle: (.*?)\|/; + $at_details{'fsk'} = $1 if $event->{summary} =~ m/\|FSK: (.*?)\|/; + $at_details{'episode'} = $1 if $event->{summary} =~ m/\|Episode: (.*?)\|/; + $at_details{'rating'} = $1 if $event->{summary} =~ m/\|Rating: (.*?)\|/; + $title =~ s/%([\w_-]+)%/$at_details{lc($1)}/sieg; + } else { + $title = $event->{title}; + if(($at->{episode}) && ($event->{subtitle})) { + $title .= "~" . $event->{subtitle}; + } + } + + + # gemaess vdr.5 alle : durch | ersetzen. + $title =~s#:#|#g; + + # sind irgendweche Tags verwendet worden, die leer waren und die doppelte Verzeichnisse erzeugten? + $title =~s#~+#~#g; + +######################################################################################### +# 20050130: patch by macfly: parse extended EPG information provided by tvm2vdr.pl +######################################################################################### + + Log(LOG_AT, sprintf("AutoTimer: Programming Timer \"%s\" (Event-ID %s, %s - %s)", $title, $event->{event_id}, strftime("%Y%m%d-%H%M", localtime($event->{start})), strftime("%Y%m%d-%H%M", localtime($event->{stop})))); + + AT_ProgTimer(0x8001, $event->{event_id}, $event->{vdr_id}, $event->{start}, $event->{stop}, + $title, $event->{summary}, $at->{prio}, $at->{lft}); + + $DONE->{$DoneStr} = $event->{stop} + if($at->{done}); + } + } + } + Log(LOG_AT, "Auto Timer: Done."); + Log(LOG_AT, "Auto Timer: Search for old Done Entrys..."); + for(keys %$DONE) { delete $DONE->{$_} if(time > $DONE->{$_}) } + Log(LOG_AT, "Auto Timer: Save done list..."); + &DONE_Write($DONE) if($DONE); + Log(LOG_AT, "Auto Timer: Done."); +} + + +sub AT_ProgTimer { + my($active, $event_id, $channel, $start, $stop, $title, $summary, $prio, $lft) = @_; + + $title =~ s/\:/ /g; + + $start -= ($CONFIG{TM_MARGIN_BEGIN} * 60); + $stop += ($CONFIG{TM_MARGIN_END} * 60); + + ($prio = $CONFIG{AT_PRIORITY}) if(!$prio); + ($lft = $CONFIG{AT_LIFETIME}) if(!$lft); + + my $found = 0; + my $Update = 0; + for(ParseTimer(1)) { + if(($event_id) && ($_->{event_id} == $event_id) && ($_->{vdr_id} == $channel)) { + $found = 1; + } + if((!$found) && ($_->{vdr_id} == $channel) && ($_->{dor} == my_strftime("%d", $start)) && ($_->{start} eq $start)) { + $found = 1; + } + } + + # we will only programm new timers, CheckTimers is responsible for + # updating existing timers + if (!$found) { + Log(LOG_AT, sprintf("AT_ProgTimer: Programming Timer \"%s\" (Event-ID %s, %s - %s)", $title, $event_id, strftime("%Y%m%d-%H%M", localtime($start)), strftime("%Y%m%d-%H%M", localtime($stop)))); + ProgTimer( + 0, + $active, + $event_id, + $channel, + $start, + $stop, + $prio, + $lft, + $title, + $summary + ); + } +} + +sub PackStatus { + # make a 32 bit signed int with high 16 Bit as event_id and low 16 Bit as + # active value + my($active, $event_id) = @_; + + # we must generate a 32 bit signed int, due perl knows no overflow at 32 bit, + # we have to do the overflow manually: + + # is the 16th bit set? then the signed 32 bit int is negative! + if ($event_id & 0x8000) { + # strip the first bit (by & 0x7FFF) of the event_id, so a 15 bit + # (positive) int will remain, then shift the int 16 bits to the left and + # add active -- result is a 31 bit (always positive) int. + # The 32nd bit is the minus sign, and due the (binary) smallest value + # is the (int) lowest possible number, we have to substract the lowest + # value + 1 from the 31 bit value -- result is the signed 32 bit int equal + # to the (unsigned) 32 bit int. + return ($active | (($event_id & 0x7FFF) << 16)) - 0x80000000; + } + else { + return $active | ($event_id << 16); + } +} + +sub UnpackActive { + my($tmstatus) = @_; + # strip the first 16 bit + return ($tmstatus & 0xFFFF); +} + +sub UnpackEvent_id { + my($tmstatus) = @_; + # remove the lower 16 bit by shifting the value 16 bits to the right + return $tmstatus >> 16; +} + +sub CheckTimers { + my $event; + + for my $timer (ParseTimer(1)) { + # only check autotimers (16th bit set) with event_id + if( ($timer->{active} & 0x8000) && ($timer->{event_id})) { + for $event (@{$EPG{$timer->{vdr_id}}}) { + # look for matching event_id on the same channel -- it's unique + if($timer->{event_id} == $event->{event_id}) { + Log(LOG_CHECKTIMER, sprintf("CheckTimers: Checking timer \"%s\" (No. %s) for changes by Event-ID", $timer->{title}, $timer->{id})); + # update timer if the existing one differs from the EPG + #if(($timer->{title} ne ($event->{subtitle} ? ($event->{title} . "~" . $event->{subtitle}) : $event->{title})) || + # (($event->{summary}) && (!$timer->{summary})) || + if((($event->{summary}) && (!$timer->{summary})) || + ($timer->{start} ne ($event->{start} - $CONFIG{TM_MARGIN_BEGIN} * 60)) || + ($timer->{stop} ne ($event->{stop} + $CONFIG{TM_MARGIN_END} * 60))) { + Log(LOG_CHECKTIMER, sprintf("CheckTimers: Timer \"%s\" (No. %s, Event-ID %s, %s - %s) differs from EPG: \"%s\", Event-ID %s, %s - %s)", $timer->{title}, $timer->{id}, $timer->{event_id}, strftime("%Y%m%d-%H%M", localtime($timer->{start})), strftime("%Y%m%d-%H%M", localtime($timer->{stop})), $event->{title}, $event->{event_id}, strftime("%Y%m%d-%H%M", localtime($event->{start})), strftime("%Y%m%d-%H%M", localtime($event->{stop})))); + ProgTimer( + $timer->{id}, + $timer->{active}, + $timer->{event_id}, + $timer->{vdr_id}, + $event->{start} - $CONFIG{TM_MARGIN_BEGIN} * 60, + $event->{stop} + $CONFIG{TM_MARGIN_END} * 60, + $timer->{prio}, + $timer->{lft}, + # always add subtitle if there is one + #$event->{subtitle} ? ($event->{title} . "~" . $event->{subtitle}) : $event->{title}, + $timer->{title}, + # If there already is a summary, the user might have changed it -- leave it untouched. + $timer->{summary} ? $timer->{summary} : $event->{summary}, + ); + Log(LOG_CHECKTIMER, sprintf("CheckTimers: Timer %s updated.", $timer->{id})); + } + } + } + } + # all autotimers without event_id will be updated by channel number and start/stop time + elsif( ($timer->{active} & 0x8000) && (!$timer->{event_id})) { + # We're checking only timers which doesn't record + if ($timer->{start} > time()) { + Log(LOG_CHECKTIMER, sprintf("CheckTimers: Checking timer \"%s\" (No. %s) for changes by recording time", $timer->{title}, $timer->{id})); + my @eventlist; + + for my $event (@{$EPG{$timer->{vdr_id}}}) { + # look for events within the margins of the current timer + if(($event->{start} < $timer->{stop}) && ($event->{stop} > $timer->{start})) { + push @eventlist, $event; + } + } + # now we have all events in eventlist that touch the old timer margins + # check for each event how probable it is matching the old timer + if(scalar(@eventlist) > 0) { + my $maxwight = 0; + $event = $eventlist[0]; + + for (my $i=0; $i < scalar(@eventlist); $i++) { + my($start, $stop); + + if($eventlist[$i]->{start} < $timer->{start}) { + $start = $timer->{start}; + } else { + $start = $eventlist[$i]->{start}; + } + if($eventlist[$i]->{stop} > $timer->{stop}) { + $stop = $timer->{stop}; + } else { + $stop = $eventlist[$i]->{stop}; + } + + my $wight = ($stop - $start) / ($eventlist[$i]->{stop} - $eventlist[$i]->{start}); + + if($wight > $maxwight) { + $maxwight = $wight; + $event = $eventlist[$i]; + } + } + # update timer if the existing one differs from the EPG + if((($event->{summary}) && (!$timer->{summary})) || + ($timer->{start} > ($event->{start} - $CONFIG{TM_MARGIN_BEGIN} * 60)) || + ($timer->{stop} < ($event->{stop} + $CONFIG{TM_MARGIN_END} * 60))) { + Log(LOG_CHECKTIMER, sprintf("CheckTimers: Timer \"%s\" (No. %s, Event-ID %s, %s - %s) differs from EPG: \"%s\", Event-ID %s, %s - %s)", $timer->{title}, $timer->{id}, $timer->{event_id}, strftime("%Y%m%d-%H%M", localtime($timer->{start})), strftime("%Y%m%d-%H%M", localtime($timer->{stop})), $event->{title}, $event->{event_id}, strftime("%Y%m%d-%H%M", localtime($event->{start})), strftime("%Y%m%d-%H%M", localtime($event->{stop})))); + ProgTimer( + $timer->{id}, + $timer->{active}, + 0, + $timer->{vdr_id}, + $timer->{start} > ($event->{start} - $CONFIG{TM_MARGIN_BEGIN} * 60) ? $event->{start} - $CONFIG{TM_MARGIN_BEGIN} * 60 : $timer->{start}, + $timer->{stop} < ($event->{stop} + $CONFIG{TM_MARGIN_END} * 60) ? $event->{stop} + $CONFIG{TM_MARGIN_END} * 60 : $timer->{stop}, + $timer->{prio}, + $timer->{lft}, + # don't touch the title since we're not too sure about the event + $timer->{title}, + # If there already is a summary, the user might have changed it -- leave it untouched. + $timer->{summary} ? $timer->{summary} : $event->{summary}, + ); + Log(LOG_CHECKTIMER, sprintf("CheckTimers: Timer %s updated.", $timer->{id})); + } + } + } else { + Log(LOG_CHECKTIMER, sprintf("CheckTimers: Skipping Timer \"%s\" (No. %s, %s - %s)", $timer->{title}, $timer->{id}, strftime("%Y%m%d-%H%M", localtime($timer->{start})), strftime("%Y%m%d-%H%M", localtime($timer->{stop})))); + } + } + } +} + +############################################################################# +# regulary timers +############################################################################# +sub my_mktime { + my $sec = 0; + my $min = shift; + my $hour = shift; + my $mday = shift; + my $mon = shift; + my $year = shift() - 1900; + + #my $time = mktime($sec, $min, $hour, $mday, $mon, $year, 0, 0, (localtime(time))[8]); + my $time = mktime($sec, $min, $hour, $mday, $mon, $year, 0, 0, -1); +} + +sub ParseTimer { + my $pc = shift; + my $tid = shift; + my $entry = 1; + + my @temp; + for(SendCMD("lstt")) { + last if(/^No timers defined/); + chomp; + my($id, $temp) = split(/ /, $_, 2); + my($tmstatus, $vdr_id, $dor, $start, $stop, $prio, $lft, $title, $summary) = split(/\:/, $temp, 9); + + my($startsse, $stopsse, $weekday, $off, $perrec, $length, $first); + + my($active, $event_id); + $active = UnpackActive($tmstatus); + $event_id = UnpackEvent_id($tmstatus); + + # direct recording (menu, red) + $active = 1 if($active == 3); + + if(length($dor) == 7) { # repeating timer + $startsse = my_mktime(substr($start, 2, 2), substr($start, 0, 2), + my_strftime("%d"), (my_strftime("%m") - 1), my_strftime("%Y")); + $stopsse = my_mktime(substr($stop, 2, 2), substr($stop, 0, 2), + my_strftime("%d"), (my_strftime("%m") - 1), my_strftime("%Y")); + if($stopsse < $startsse) { + $stopsse += 86400; + } + $weekday = ((localtime(time))[6] + 6) % 7; + $perrec = join("", substr($dor, $weekday), substr($dor, 0, $weekday)); + $perrec =~ m/^-+/g; + + $off = (pos $perrec) * 86400; + if($off == 0 && $stopsse < time) { + #$weekday = ($weekday + 1) % 7; + $perrec = join("", substr($dor, ($weekday + 1) % 7), substr($dor, 0, ($weekday + 1) % 7)); + $perrec =~ m/^-+/g; + $off = ((pos $perrec) + 1) * 86400; + } + $startsse += $off; + $stopsse += $off; + } elsif(length($dor) == 18) { # first-day timer + $dor =~ /.{7}\@(\d\d\d\d)-(\d\d)-(\d\d)/; + $startsse = my_mktime(substr($start, 2, 2), + substr($start, 0, 2), $3, ($2 - 1), $1); + # 31 + 1 = ?? + $stopsse = my_mktime(substr($stop, 2, 2), + substr($stop, 0, 2), $stop > $start ? $3 : $3 + 1, + ($2 - 1), $1); + } else { # regular timer + $startsse = my_mktime(substr($start, 2, 2), + substr($start, 0, 2), $dor, (my_strftime("%m") - 1), + my_strftime("%Y")); + + $stopsse = my_mktime(substr($stop, 2, 2), + substr($stop, 0, 2), $stop > $start ? $dor : $dor + 1, + (my_strftime("%m") - 1), my_strftime("%Y")); + } + + # move timers which have expired one month into the future + if(length($dor) != 7 && $stopsse < time) { + $startsse = my_mktime(substr($start, 2, 2), + substr($start, 0, 2), $dor, (my_strftime("%m") % 12), + (my_strftime("%Y") + (my_strftime("%m") == 12 ? 1 : 0))); + + $stopsse = my_mktime(substr($stop, 2, 2), + substr($stop, 0, 2), $stop > $start ? $dor : $dor + 1, + (my_strftime("%m") % 12), + (my_strftime("%Y") + (my_strftime("%m") == 12 ? 1 : 0))); + } + + if($CONFIG{RECORDINGS} && length($dor) == 7) { # repeating timer + # generate repeating timer entries for up to 28 days + $first = 1; + for($weekday += $off / 86400, $off = 0; $off < 28; $off++) { + $perrec = join("", substr($dor, ($weekday + $off) % 7), substr($dor, 0, ($weekday + $off) % 7)); + $perrec =~ m/^-+/g; + if ((pos $perrec) != 0) { + next; + } + + $length = push(@temp, { + id => $id, + vdr_id => $vdr_id, + start => $startsse, + stop => $stopsse, + startsse => $startsse + $off * 86400, + stopsse => $stopsse + $off * 86400, + active => $active, + event_id => $event_id, + cdesc => get_name_from_vdrid($vdr_id), + transponder => get_transponder_from_vdrid($vdr_id), + ca => get_ca_from_vdrid($vdr_id), + dor => $dor, + prio => $prio, + lft => $lft, + title => $title, + summary => $summary, + collision => 0, + critical => 0, + first => $first + }); + $first = 0; + } + } else { + $length = push(@temp, { + id => $id, + vdr_id => $vdr_id, + start => $startsse, + stop => $stopsse, + startsse => $startsse, + stopsse => $stopsse, + active => $active, + event_id => $event_id, + cdesc => get_name_from_vdrid($vdr_id), + transponder => get_transponder_from_vdrid($vdr_id), + ca => get_ca_from_vdrid($vdr_id), + dor => $dor, + prio => $prio, + lft => $lft, + title => $title, + summary => $summary, + collision => 0, + critical => 0, + first => -1 + }); + } + + # save index of entry with specific timer id for later use + if($tid && $tid == $id) { + $entry = $length; + } + } + + if($tid) { + return($temp[$entry - 1]); + } else { + return(@temp); + } +} + +############################################################################# +# Tools +############################################################################# +sub DisplayMessage { + my $message = shift; + SendCMD(sprintf("mesg %s", $message)); +} + +sub LoadTranslation { + undef @I18N_Days; + undef @I18N_Month; + undef %ERRORMESSAGE; + undef %COMMONMESSAGE; + undef %HELP; + undef @LOGINPAGES_DESCRIPTION; + include("$TEMPLATEDIR/$CONFIG{LANGUAGE}/$I18NFILE"); +} + +sub HelpURL { + my $area = shift; + return(sprintf("%s?aktion=show_help&area=%s", $MyURL, $area)); +} + +sub ProgTimer { + # $start and $stop are expected as seconds since 00:00:00 1970-01-01 UTC. + my($timer_id, $active, $event_id, $channel, $start, $stop, $prio, $lft, $title, $summary, $dor) = @_; + + $title =~ s/\://g; + + if(($CONFIG{NO_EVENTID} == 1) && ($event_id > 0)) { + $event_id = 0; + Log(LOG_CHECKTIMER, sprintf("ProgTimer: Event-ID removed for recording \"%s\"", $title)); + } else { + for my $n (split(",", $CONFIG{NO_EVENTID_ON})) { + if(($n == $channel) && ($event_id > 0)) { + $event_id = 0; + Log(LOG_CHECKTIMER, sprintf("ProgTimer: Event-ID removed for recording \"%s\" on channel %s", $title, $channel)); + } + } + } + + Log(LOG_AT, sprintf("ProgTimer: Programming Timer \"%s\" (Channel %s, Event-ID %s, %s - %s)", $title, $channel, $event_id, my_strftime("%Y%m%d-%H%M", $start), my_strftime("%Y%m%d-%H%M", $stop))); + + my $return = SendCMD( + sprintf("%s %s:%s:%s:%s:%s:%s:%s:%s:%s", + $timer_id ? "modt $timer_id" : "newt", + # only autotimers with 16th bit set will be extended by the event_id + $active & 0x8000 ? PackStatus($active, $event_id) : $active, + $channel, + $dor ? $dor : RemoveLeadingZero(strftime("%d", localtime($start))), + strftime("%H%M", localtime($start)), + strftime("%H%M", localtime($stop)), + $prio, + $lft, + $title, + $summary + ) + ); + + return $return; +} + +sub RedirectToReferer { + my $url = shift; + if($Referer =~ /vdradmin\.pl\?.*$/) { + return(headerForward($Referer)); + } else { + return(headerForward($url)); + } +} + +sub salt { + $_ = $_[0]; + my $string; + my($offset1, $offset2); + if(length($_) > 8) { + $offset1 = length($_) - 9; + $offset2 = length($_) - 1; + } else { + $offset1 = 0; + $offset2 = length($_) - 1; + } + $string = substr($_, $offset1, 1); + $string .= substr($_, $offset2, 1); + return($string); +} + +sub Shutdown { + unlink($PIDFILE); + exit(0) +}; + +sub getPID { + open(PID, shift); + $_ = ; + close(PID); + return($_); +} + +sub writePID { + open(FILE, ">$PIDFILE"); + print FILE shift; + close(FILE); +} + +sub HupSignal { + UptoDate(1); +} + +sub UptoDate { + my $force = shift; + if(((time() - $CONFIG{CACHE_LASTUPDATE}) >= ($CONFIG{CACHE_TIMEOUT} * 60)) || $force) { + OpenSocket(); + ChanTree(); + EPG_buildTree(); + CheckTimers(); + AutoTimer(); + CloseSocket(); + $CONFIG{CACHE_LASTUPDATE} = time(); + } + return(0); +} + +sub Log { + if($#_ >= 1) { + my $level = shift; + my $message = join("", @_); + print $message . "\n" if $DEBUG; + if($CONFIG{LOGGING}) { + if($CONFIG{LOGLEVEL} & $level) { + open(LOGFILE, ">>" . $LOGFILE); + print LOGFILE sprintf("%s: %s\n", my_strftime("%d.%m.%Y %H:%M:%S"), $message); + close(LOGFILE); + } + } + } else { + Log(LOG_FATALERROR, "bogus Log() call"); + } +} + +sub TemplateNew { + my $file = shift; + $CONFIG{LANGUAGE} = "English" if(!$CONFIG{LANGUAGE}); + $file = "$TEMPLATEDIR/$CONFIG{LANGUAGE}/$file"; + if(!-e $file) { + Log(LOG_FATALERROR, "Fatal! Can't find $file!"); + } + my $template = HTML::Template::Expr->new( + die_on_bad_params => 0, + loop_context_vars => 1, + filename => $file); + return $template; +} + +sub my_strftime { + my $format = shift; + my $time = shift; + return(strftime($format, $time ? localtime($time) : localtime(time))); +} + +sub my_strfgmtime { + my $format = shift; + my $time = shift; + return(strftime($format, $time ? gmtime($time) : gmtime(time))); +} + +sub GetFirstChannel { + return($CHAN[0]->{service_id}); +} + +sub ChannelHasEPG { + my $service_id = shift; + for my $event (@{$EPG{$service_id}}) { + return(1); + } + return(0); +} + +sub Encode_Referer { + if($_[0]) { $_ = $_[0]; } else { $_ = $Referer; } + return(MIME::Base64::encode_base64($_)); +} + +sub Decode_Referer { + return(MIME::Base64::decode_base64(shift)); +} + +sub encode_ref { + my($tmp) = $_[0]->url(-relative=>1,-query=>1); + my(undef, $query) = split(/\?/, $tmp, 2); + return(MIME::Base64::encode_base64($query)); +} + +sub decode_ref { + return(MIME::Base64::decode_base64($_[0])); +} + +sub access_log { + my $ip = shift; + my $username = shift; + my $time = shift; + my $rawrequest = shift; + my $http_status = shift; + my $bytes_transfered = shift; + my $request = shift; + my $useragent = shift; + return sprintf("%s - %s [%s +0100] \"%s\" %s %s \"%s\" \"%s\"", + $ip, + $username, + my_strftime("%d/%b/%Y:%H:%M:%S", $time), + $rawrequest, + $http_status, + $bytes_transfered, + $request, + $useragent + ); +} + +sub ReadConfig { + if(-e $CONFFILE) { + open(CONF, $CONFFILE); + while() { + chomp; + my($key, $value) = split(/ \= /, $_, 2); + $CONFIG{$key} = $value; + } + close(CONF); + } else { + print "$CONFFILE doesn't exist. Please run \"$0 --config\"\n"; + print "Exitting!\n"; + exit(1); + #open(CONF, ">$CONFFILE"); + #for(keys(%CONFIG)) { + # print(CONF "$_ = $CONFIG{$_}\n"); + #} + #close(CONF); + #return(1); + } + return(0); +} + +sub Question { + my($quest, $default) = @_; + print("$quest [$default]: "); + my($answer); + $answer = ; + if($answer eq "\n") { + return($default); + } else { + return($answer); + } +} + +sub RemoveLeadingZero { + my($str) = @_; + while(substr($str, 0, 1) == 0) { + $str = substr($str, 1, (length($str) - 1)); + } + return($str); +} + +sub csvAdd { + my $csv = shift; + my $add = shift; + + my $found = 0; + for my $item (split(",", $csv)) { + $found = 1 if($item eq $add); + } + $csv = join(",", (split(",", $csv), $add)) if(!$found); + return($csv); +} + +sub csvRemove { + my $csv = shift; + my $remove = shift; + + my $newcsv; + for my $item (split(",", $csv)) { + if($item ne $remove) { + my $found = 0; + if(defined($newcsv)) { + for my $dup (split(",", $newcsv)) { + $found = 1 if($dup eq $item); + } + } + $newcsv = join(",", (split(",", $newcsv), $item)) if(!$found); + } + } + return($newcsv); +} + +sub Einheit { + my @einheiten = qw(MB GB TB); + my $einheit = 0; + my $zahl = shift; + while($zahl > 1024) { + $zahl /= 1024; + $einheit++; + } + return(int($zahl) . $einheiten[$einheit]); +} + +sub MBToMinutes { + my $mb = shift; + my $minutes = $mb / 25.75; + my $hours = $minutes / 60; + $minutes %= 60; + return(sprintf("%2d:%02d", $hours, $minutes)); +} + +sub VideoDiskFree { + $_ = join("", SendCMD("stat disk")); + if(/^(\d+)MB (\d+)MB (\d+)%$/) { + return(Einheit($1), MBToMinutes($1), Einheit($2), MBToMinutes($2), $3); + } elsif(/^Command unrecognized: "stat"$/) { + #print "VDR doesnt know about this extension\n"; + } else { + print "Unknown response $_\n"; + } + return undef; +} + +############################################################################# +# frontend +############################################################################# +sub show_index { + my $template = TemplateNew("index.html"); + my $page; + if(defined($CONFIG{LOGINPAGE})) { + $page = $LOGINPAGES[$CONFIG{LOGINPAGE}]; + } else { + $page = $LOGINPAGES[0]; + } + $template->param( + loginpage => "$MyURL?aktion=$page", + version => $VERSION, + host => $CONFIG{VDR_HOST}, + ); + return(header("200", "text/html", $template->output)); +} + +sub toolbar { + my $template = TemplateNew("toolbar.html"); + + my @channel; + for my $channel (@CHAN) { + # if its wished, display only wanted channels + if($CONFIG{CHANNELS_WANTED_PRG}) { + my $found = 0; + for my $n (split(",", $CONFIG{CHANNELS_WANTED})) { + ($found = 1) if($n eq $channel->{vdr_id}); + } + next if(!$found); + } + + # skip channels without EPG data + if(ChannelHasEPG($channel->{vdr_id})) { + push(@channel, { + name => $channel->{name}, + vdr_id => $channel->{vdr_id}, + #current => ($vdr_id == $channel->{vdr_id}) ? 1 : 0, + }); + } + } + + $template->param( + url => $MyURL, + chanloop => \@channel + ); + return(header("200", "text/html", $template->output)); +} + +# obsolete? +sub show_top { + my $template = TemplateNew("top.html"); + return(header("200", "text/html", $template->output)); +} + +sub prog_switch { + my $channel = $q->param("channel"); + if($channel) { + SendCMD("chan $channel"); + } + SendFile($BASENAME . "/images/switch_channel.gif"); +} + +sub prog_detail { + return if(UptoDate()); + my $vdr_id = $q->param("vdr_id"); + my $epg_id = $q->param("epg_id"); + + my($channel_name, $title, $subtitle, $start, $stop, $date, $text); + + if($vdr_id && $epg_id) { + for(@{$EPG{$vdr_id}}) { + #if($_->{id} == $epg_id) { #XXX + if($_->{event_id} == $epg_id) { + $channel_name = $_->{channel_name}; + $title = $_->{title}; + $subtitle = $_->{subtitle}; + $start = my_strftime("%H:%M", $_->{start}); + $stop = my_strftime("%H:%M", $_->{stop}); + $text = $_->{summary}; + $date = sprintf("%s., %s. %s %s", + substr(FullDay(my_strftime("%w", $_->{start})), 0, 2), + my_strftime("%d", $_->{start}), + FullMonth(my_strftime("%m", $_->{start})), + my_strftime("%Y", $_->{start})); + last; + } + } + } + + my $displaytext = $text; + my $displaytitle = $title; + my $displaysubtitle = $subtitle; + + $displaytext =~ s/\n/
\n/g; + $displaytext =~ s/\|/
\n/g; + $displaytitle =~ s/\n/
\n/g; + $displaytitle =~ s/\|/
\n/g; + $displaysubtitle =~ s/\n/
\n/g; + $displaysubtitle =~ s/\|/
\n/g; + + my $template = TemplateNew("prog_detail.html"); + $template->param( + title => $displaytitle ? $displaytitle : undef, + recurl => sprintf("%s?aktion=timer_new_form&epg_id=%s&vdr_id=%s", $MyURL, $epg_id, $vdr_id), + switchurl => sprintf("%s?aktion=prog_switch&channel=%s", $MyURL, $vdr_id), + channel_name => $channel_name, + subtitle => $displaysubtitle, + start => $start, + stop => $stop, + text => $displaytext ? $displaytext : undef, + date => $date + ); + return(header("200", "text/html", $template->output)); +} + + +############################################################################# +# program listing +############################################################################# +sub prog_list { + return if(UptoDate()); + my $vdr_id = $q->param("vdr_id"); + + # called without vdr_id, redirect to the first known channel + if(!$vdr_id) { + return(headerForward("$MyURL?aktion=prog_list&vdr_id=1")); + } + + # + my @channel; + for my $channel (@CHAN) { + # if its wished, display only wanted channels + if($CONFIG{CHANNELS_WANTED_PRG}) { + my $found = 0; + for my $n (split(",", $CONFIG{CHANNELS_WANTED})) { + ($found = 1) if($n eq $channel->{vdr_id}); + } + next if(!$found); + } + + # skip channels without EPG data + if(ChannelHasEPG($channel->{vdr_id})) { + push(@channel, { + name => $channel->{name}, + vdr_id => $channel->{vdr_id}, + current => ($vdr_id == $channel->{vdr_id}) ? 1 : 0, + }); + } + } + + # find the next/prev channel + my $ci = 0; + for(my $i = 0; $i <= $#channel; $i++) { + ($ci = $i) if($vdr_id == $channel[$i]->{vdr_id}); + } + my ($next_channel, $prev_channel); + ($prev_channel = $channel[$ci - 1]->{vdr_id}) if($ci > 0); + ($next_channel = $channel[$ci + 1]->{vdr_id}) if($ci < $#channel); + + # + my(@show, $progname, $cnumber); + my $day = 0; + for my $event (@{$EPG{$vdr_id}}) { + if(my_strftime("%d", $event->{start}) != $day) { + # new day + push(@show, { endd => 1 }) if(scalar(@show) > 0); + push(@show, { + title => $event->{channel_name} . " | " . + FullDay(my_strftime("%w", $event->{start})) . ", " . + my_strftime("%d.%m.%Y", $event->{start}), + newd => 1, + next_channel => $next_channel ? "$MyURL?aktion=prog_list&vdr_id=$next_channel" : undef, + prev_channel => $prev_channel ? "$MyURL?aktion=prog_list&vdr_id=$prev_channel" : undef, + }); + $day = strftime("%d", localtime($event->{start})); + } + push(@show, { + ssse => $event->{start}, + emit => my_strftime("%H:%M", $event->{start}), + duration => my_strftime("%H:%M", $event->{stop}), + title => $event->{title}, + subtitle => $event->{subtitle}, + recurl => sprintf("%s?aktion=timer_new_form&epg_id=%s&vdr_id=%s", $MyURL, $event->{event_id}, $event->{vdr_id}), + infurl => $event->{summary} ? sprintf("%s?aktion=prog_detail&epg_id=%s&vdr_id=%s", $MyURL, $event->{event_id}, $event->{vdr_id}) : undef, + newd => 0, + anchor => $event->{event_id} + }); + $progname = $event->{progname}; + $cnumber = $event->{cnumber}; + } + if(scalar(@show)) { + push(@show, { endd => 1 }); + } + + + # + my($template) = TemplateNew("prog_list.html"); + $template->param( + url => $MyURL, + loop => \@show, + chanloop => \@channel, + progname => GetChannelDescByNumber($vdr_id), + switchurl => "$MyURL?aktion=prog_switch&channel=" . $vdr_id, + streamurl => "$MyURL?aktion=live_stream&channel=" . $vdr_id, + toolbarurl => "$MyURL?aktion=toolbar" + ); + return(header("200", "text/html", $template->output)); +} + + + + +############################################################################# +# program listing 2 +# "What's up today" extension. +# +# Contributed by Thomas Blon, 6. Mar 2004 +############################################################################# +sub prog_list2 { + return if(UptoDate()); + + # + my $vdr_id; + my @channel; + + for my $channel (@CHAN) { + # if its wished, display only wanted channels + if($CONFIG{CHANNELS_WANTED_PRG}) { + my $found = 0; + for my $n (split(",", $CONFIG{CHANNELS_WANTED})) { + ($found = 1) if($n eq $channel->{vdr_id}); + } + next if(!$found); + } + + # skip channels without EPG data + if(ChannelHasEPG($channel->{vdr_id})) { + push(@channel, { + name => $channel->{name}, + vdr_id => $channel->{vdr_id}, + current => ($vdr_id == $channel->{vdr_id}) ? 1 : 0, + }); + } + } + + my(@show, $progname, $cnumber); + + foreach (@channel) { # loop through all channels + $vdr_id = $_->{vdr_id}; + + # find the next/prev channel + my $ci = 0; + for(my $i = 0; $i <= $#channel; $i++) { + ($ci = $i) if($vdr_id == $channel[$i]->{vdr_id}); + } + my ($next_channel, $prev_channel); + ($prev_channel = $channel[$ci - 1]->{vdr_id}) if($ci > 0); + ($next_channel = $channel[$ci + 1]->{vdr_id}) if($ci < $#channel); + + + my $day = 0; + my $dayflag = 0; + + + for my $event (@{$EPG{$vdr_id}}) { + if(my_strftime("%d", $event->{start}) != $day) { # new day + $day = strftime("%d", localtime($event->{start})); + $dayflag++; + } + + if($dayflag == 1) { + push(@show, { + title => $event->{channel_name} . " | " . + FullDay(my_strftime("%w", $event->{start})) . ", " . + my_strftime("%d.%m.%Y", $event->{start}), + newd => 1, + undef, + undef, + }); + + $dayflag++; + } + + if($dayflag == 2) { + push(@show, { + ssse => $event->{start}, + emit => my_strftime("%H:%M", $event->{start}), + duration => my_strftime("%H:%M", $event->{stop}), + title => $event->{title}, + subtitle => $event->{subtitle}, + recurl => sprintf("%s?aktion=timer_new_form&epg_id=%s&vdr_id=%s", $MyURL, $event->{event_id}, $event->{vdr_id}), + infurl => $event->{summary} ? sprintf("%s?aktion=prog_detail&epg_id=%s&vdr_id=%s", $MyURL, $event->{event_id}, $event->{vdr_id}) : undef, + newd => 0, + anchor => $event->{event_id} + }); + $progname = $event->{progname}; + $cnumber = $event->{cnumber}; + } + } + push(@show, { endd => 1 }); + } # end: for $vdr_id + + + # + my($template) = TemplateNew("prog_list2.html"); + $template->param( + url => $MyURL, + loop => \@show, + chanloop => \@channel, + progname => GetChannelDescByNumber($vdr_id), + switchurl=> "$MyURL?aktion=prog_switch&channel=" . $vdr_id, + toolbarurl => "$MyURL?aktion=toolbar" + ); + return(header("200", "text/html", $template->output)); +} + + +############################################################################# +# regular timers +############################################################################# +sub timer_list { + return if(UptoDate()); + + # + my $desc; + if(!defined($q->param("desc"))) { + $desc = 1; + } else { + $q->param("desc") ? ($desc = 1) : ($desc = 0); + } + my $sortby = $q->param("sortby"); + ($sortby = "day") if(!$sortby); + + # + my @timer; + my @timer2; + my @days; + + my ($TagAnfang, $TagEnde); + for my $timer (ParseTimer(0)) { + if($timer->{startsse} < time() && $timer->{stopsse} > time() && ($timer->{active} & 1)) { + $timer->{recording} = 1; + } + if($timer->{active} & 1) { + if($timer->{active} & 0x8000) { + $timer->{active} = 0x8001; + } else { + $timer->{active} = 1; + } + } else { + $timer->{active} = 0; + } + $timer->{delurl} = $MyURL . "?aktion=timer_delete&timer_id=" . $timer->{id}, + $timer->{modurl} = $MyURL . "?aktion=timer_new_form&timer_id=" . $timer->{id}, + $timer->{toggleurl} = sprintf("%s?aktion=timer_toggle&active=%s&id=%s", $MyURL, ($timer->{active} & 1) ? 0 : 1, $timer->{id}), + $timer->{dor} = my_strftime("%d.%m", $timer->{startsse}); + + $TagAnfang=my_mktime(0,0,my_strftime("%d", $timer->{start}),my_strftime("%m", $timer->{start}),my_strftime("%Y", $timer->{start})); + $TagEnde=my_mktime(0,0,my_strftime("%d", $timer->{stop}),my_strftime("%m", $timer->{stop}),my_strftime("%Y", $timer->{stop})); + + $timer->{startlong} = ((my_mktime(my_strftime("%M", $timer->{start}),my_strftime("%H", $timer->{start}),my_strftime("%d", $timer->{start}),my_strftime("%m", $timer->{start}),my_strftime("%Y", $timer->{start})))-$TagAnfang)/60; + $timer->{stoplong} = ((my_mktime(my_strftime("%M", $timer->{stop}),my_strftime("%H", $timer->{stop}),my_strftime("%d", $timer->{stop}),my_strftime("%m", $timer->{stop}),my_strftime("%Y", $timer->{stop})))-$TagEnde)/60; + $timer->{starttime} = my_strftime("%y%m%d", $timer->{startsse}); + $timer->{stoptime} = my_strftime("%y%m%d", $timer->{stopsse}); + $timer->{sortfield} = $timer->{cdesc} . $timer->{startsse}; + $timer->{infurl} = $timer->{event_id} ? sprintf("%s?aktion=prog_detail&epg_id=%s&vdr_id=%s", $MyURL, $timer->{event_id}, $timer->{vdr_id}) : undef, + + $timer->{start} = my_strftime("%H:%M", $timer->{start}); + $timer->{stop} = my_strftime("%H:%M", $timer->{stop}); + $timer->{sortbyactive} = 1 if($sortby eq "active"); + $timer->{sortbychannel} = 1 if($sortby eq "channel"); + $timer->{sortbyname} = 1 if($sortby eq "name"); + $timer->{sortbystart} = 1 if($sortby eq "start"); + $timer->{sortbystop} = 1 if($sortby eq "stop"); + $timer->{sortbyday} = 1 if($sortby eq "day"); + push(@timer, $timer); + } + @timer = sort({ $a->{startsse} <=> $b->{startsse} } @timer); + + # + if($CONFIG{RECORDINGS}) { + my($ii, $jj, $timer, $last); + for($ii = 0; $ii < @timer; $ii++) { + if($timer[$ii]->{first} == -1 || $timer[$ii]->{first} == 1) { + $last = $ii; + } + + # Liste der benutzten Transponder + my @Transponder = (get_transponder_from_vdrid($timer[$ii]->{vdr_id})); + $timer[$ii]->{collision} = 0; + + for($jj = 0; $jj < $ii; $jj++) { + if($timer[$ii]->{startsse} >= $timer[$jj]->{startsse} && + $timer[$ii]->{startsse} < $timer[$jj]->{stopsse}) { + if($timer[$ii]->{active} && $timer[$jj]->{active}) { + # Timer kollidieren zeitlich. Pruefen, ob die Timer evtl. auf + # gleichem Transponder oder CAM liegen und daher ohne Probleme + # aufgenommen werden koennen + Log(LOG_DEBUG, sprintf("Kollission: %s (%s, %s) -- %s (%s, %s)\n", + substr($timer[$ii]->{title},0,15), $timer[$ii]->{vdr_id}, + get_transponder_from_vdrid($timer[$ii]->{vdr_id}), + get_ca_from_vdrid($timer[$ii]->{vdr_id}), + substr($timer[$jj]->{title},0,15), $timer[$jj]->{vdr_id}, + get_transponder_from_vdrid($timer[$jj]->{vdr_id}), + get_ca_from_vdrid($timer[$jj]->{vdr_id}))); + + if($timer[$ii]->{vdr_id} != $timer[$jj]->{vdr_id} && + get_ca_from_vdrid($timer[$ii]->{vdr_id}) == + get_ca_from_vdrid($timer[$jj]->{vdr_id}) && + get_ca_from_vdrid($timer[$ii]->{vdr_id}) >= 100) { + # Beide Timer laufen auf dem gleichen CAM auf verschiedenen + # Kanaelen, davon kann nur einer aufgenommen werden + Log(LOG_DEBUG, "Beide Kanaele gleiches CAM"); + ($timer[$ii]->{collision}) = $CONFIG{RECORDINGS}; + # Nur Kosmetik: Transponderliste vervollstaendigen + push(@Transponder, get_transponder_from_vdrid($timer[$jj]->{vdr_id})); + } else { + # "grep" prueft die Bedingung fuer jedes Element, daher den + # Transponder vorher zwischenspeichern -- ist effizienter + my $t = get_transponder_from_vdrid($timer[$jj]->{vdr_id}); + if(scalar(grep($_ eq $t, @Transponder)) == 0) { + ($timer[$ii]->{collision})++; + push(@Transponder, get_transponder_from_vdrid($timer[$jj]->{vdr_id})); + } + } + } + } + } + } + splice(@timer, $last + 1); + for ($ii = 0; $ii < @timer; $ii++) { + $timer[$ii]->{critical} = $timer[$ii]->{collision} >= $CONFIG{RECORDINGS}; + if ($timer[$ii]->{critical} > 0) { + for ($jj = $ii - 1; $jj >= 0; $jj--) { + if ($timer[$jj]->{stopsse} > $timer[$ii]->{startsse}) { + $timer[$jj]->{critical} = 1; + } + else { + last; + } + } + } + $timer[$ii]->{collision} = $timer[$ii]->{collision} >= ($CONFIG{RECORDINGS} - 1); + if ($timer[$ii]->{collision} > 0) { + for ($jj = $ii - 1; $jj >= 0; $jj--) { + if ($timer[$jj]->{stopsse} > $timer[$ii]->{startsse}) { + $timer[$jj]->{collision} = 1; + } + else { + last; + } + } + } + $timer[$ii]->{collision} |= ($timer[$ii]->{ca} >= 100); + } + } + + # + my($ii, $jj, $kk, $current, $title); + + for ($ii = 0; $ii < @timer; $ii++) + { + if($ii==0) + { + if(!defined($q->param("timer"))) + { + $current=my_strftime("%y%m%d", $timer[$ii]->{startsse}); + $title=FullDay(my_strftime("%w", $timer[$ii]->{startsse})) . ", " . my_strftime("%d.%m.%Y", $timer[$ii]->{startsse}); + } + else + { + $current=$q->param("timer"); + $kk = my_mktime(0,0,substr($current, 4, 2),substr($current, 2, 2)-1,"20".substr($current, 0, 2)); + $title=FullDay(my_strftime("%w", $kk)) . ", " . my_strftime("%d.%m.%Y", $kk); + } + } + + $jj=0; + for ($kk = 0; $kk < @days; $kk++) + { + if($days[$kk]->{day} == my_strftime("%d.%m", $timer[$ii]->{startsse})) + { + $jj=1; + last; + } + } + if($jj==0) { + push(@days, { + day => my_strftime("%d.%m", $timer[$ii]->{startsse}), + sortfield => my_strftime("%y%m%d", $timer[$ii]->{startsse}), + current => ($current == my_strftime("%y%m%d", $timer[$ii]->{startsse})) ? 1 : 0, + }); + } + + $jj=0; + for ($kk = 0; $kk < @days; $kk++) + { + if($days[$kk]->{day} == my_strftime("%d.%m", $timer[$ii]->{stopsse})) + { + $jj=1; + last; + } + } + if($jj==0) { + push(@days, { + day => my_strftime("%d.%m", $timer[$ii]->{stopsse}), + sortfield => my_strftime("%y%m%d", $timer[$ii]->{stopsse}), + current => ($current == my_strftime("%y%m%d", $timer[$ii]->{stopsse})) ? 1 : 0, + }); + } + } + + @days = sort({ $a->{sortfield} <=> $b->{sortfield} } @days); + + + # + if($sortby eq "active") { + if(!$desc) { + @timer = sort({ $b->{active} <=> $a->{active} } @timer); + } else { + @timer = sort({ $a->{active} <=> $b->{active} } @timer); + } + } elsif($sortby eq "channel") { + if(!$desc) { + @timer = sort({ lc($b->{cdesc}) cmp lc($a->{cdesc}) } @timer); + } else { + @timer = sort({ lc($a->{cdesc}) cmp lc($b->{cdesc}) } @timer); + } + } elsif($sortby eq "name") { + if(!$desc) { + @timer = sort({ lc($b->{title}) cmp lc($a->{title}) } @timer); + } else { + @timer = sort({ lc($a->{title}) cmp lc($b->{title}) } @timer); + } + } elsif($sortby eq "start") { + if(!$desc) { + @timer = sort({ $b->{start} <=> $a->{start} } @timer); + } else { + @timer = sort({ $a->{start} <=> $b->{start} } @timer); + } + } elsif($sortby eq "stop") { + if(!$desc) { + @timer = sort({ $b->{stop} <=> $a->{stop} } @timer); + } else { + @timer = sort({ $a->{stop} <=> $b->{stop} } @timer); + } + } elsif($sortby eq "day") { + if(!$desc) { + @timer = sort({ $b->{startsse} <=> $a->{startsse} } @timer); + } else { + @timer = sort({ $a->{startsse} <=> $b->{startsse} } @timer); + } + } + $desc ? ($desc = 0) : ($desc = 1); + @timer2=@timer; + @timer2=sort({ lc($a->{sortfield}) cmp lc($b->{sortfield}) } @timer2); + + my $template = TemplateNew("timer_list.html"); + my $vars = { + sortbydayurl => "$MyURL?aktion=timer_list&sortby=day&desc=$desc", + sortbychannelurl => "$MyURL?aktion=timer_list&sortby=channel&desc=$desc", + sortbynameurl => "$MyURL?aktion=timer_list&sortby=name&desc=$desc", + sortbyactiveurl => "$MyURL?aktion=timer_list&sortby=active&desc=$desc", + sortbystarturl => "$MyURL?aktion=timer_list&sortby=start&desc=$desc", + sortbystopurl => "$MyURL?aktion=timer_list&sortby=stop&desc=$desc", + sortbyday => ($sortby eq "day") ? 1 : 0, + sortbychannel => ($sortby eq "channel") ? 1 : 0, + sortbyname => ($sortby eq "name") ? 1 : 0, + sortbyactive => ($sortby eq "active") ? 1 : 0, + sortbystart => ($sortby eq "start") ? 1 : 0, + sortbystop => ($sortby eq "stop") ? 1 : 0, + desc => $desc, + timer_loop => \@timer, + timers => \@timer2, + day_loop => \@days, + nturl => $MyURL . "?aktion=timer_new_form", + url => $MyURL, + help_url => HelpURL("timer_list"), + current => $current, + title => $title, + }; + + $template->param( $vars ); + # New Template + my $output; + my $out = $template->output; + $Xtemplate->process(\$out, $vars, \$output) + || return(header("200", "text/html", $Xtemplate->error())); + + return(header("200", "text/html", $output)); +} + +sub timer_toggle { + UptoDate(); + my $active = $q->param("active"); + my $id = $q->param("id"); + # XXX check return + SendCMD(sprintf("modt %s %s", $id, $active ? "on" : "off")); + return(headerForward(RedirectToReferer("$MyURL?aktion=timer_list"))); +} + +sub timer_new_form { + UptoDate(); + + my $epg_id = $q->param("epg_id"); + my $vdr_id = $q->param("vdr_id"); + my $timer_id = $q->param("timer_id"); + + my $this_event; + if($epg_id) { # new timer + my $this = EPG_getEntry($vdr_id, $epg_id); + $this_event->{active} = 0x8001; + $this_event->{event_id} = $this->{event_id}; + $this_event->{start} = $this->{start} - ($CONFIG{TM_MARGIN_BEGIN} * 60); + $this_event->{stop} = $this->{stop} + ($CONFIG{TM_MARGIN_END} * 60); + $this_event->{dor} = $this->{dor}; + $this_event->{title} = $this->{title}; + $this_event->{summary}= $this->{summary}; + $this_event->{vdr_id} = $this->{vdr_id}; + } elsif($timer_id) { # edit existing timer + $this_event = ParseTimer(0, $timer_id); + } else { # none of the above + $this_event->{start} = time(); + $this_event->{stop} = 0; + $this_event->{active} = 1; + $this_event->{vdr_id} = 1; + } + + my @channels; + for my $channel (@CHAN) { + ($channel->{vdr_id} == $this_event->{vdr_id}) ? ($channel->{current} = 1) : ($channel->{current} = 0); + push(@channels, $channel); + } + + # determine referer (redirect to where we come from) + my $ref; + if(defined($epg_id)) { + if($Referer =~ /(.*)\#\d+$/) { + $ref = sprintf("%s#%s", $1, $epg_id); + } else { + $ref = sprintf("%s#%s", $Referer, $epg_id); + } + } + + # check if we may use Event-IDs in general or not + if($CONFIG{NO_EVENTID} == 1) { + # OK, remove Event-ID + $this_event->{event_id} = 0; + } else { + # check if the current channel is on the Event-ID-blacklist + for my $n (split(",", $CONFIG{NO_EVENTID_ON})) { + if($n == $this_event->{vdr_id}) { + # OK, remove Event-ID, on this channel no recording may have one. + $this_event->{event_id} = 0; + } + } + } + + my $template = TemplateNew("timer_new.html"); + $template->param( + url => $MyURL, + active => $this_event->{active} & 1, + event_id => ($this_event->{event_id} << 1) + (($this_event->{active} & 0x8000) >> 15), + starth => my_strftime("%H", $this_event->{start}), + startm => my_strftime("%M", $this_event->{start}), + stoph => $this_event->{stop} ? my_strftime("%H", $this_event->{stop}) : "00", + stopm => $this_event->{stop} ? my_strftime("%M", $this_event->{stop}) : "00", + dor => (length($this_event->{dor}) == 7) ? $this_event->{dor} : my_strftime("%d", $this_event->{start}), + prio => $this_event->{prio} ? $this_event->{prio} : $CONFIG{TM_PRIORITY}, + lft => $this_event->{lft} ? $this_event->{lft} : $CONFIG{TM_LIFETIME}, + title => $this_event->{title}, + summary => $this_event->{summary}, + timer_id => $timer_id ? $timer_id : 0, + channels => \@channels, + newtimer => $timer_id ? 0 : 1, + referer => Encode_Referer($ref), + help_url => HelpURL("timer_new"), + ); + return(header("200", "text/html", $template->output)); +} + +sub timer_add { + my $timer_id = $q->param("timer_id"); + + my $data; + + if($q->param("save")) { + + if($q->param("starth") =~ /\d+/ && $q->param("starth") < 24 && $q->param("starth") >= 0) { + $data->{start} = $q->param("starth"); + } else { print "Help!\n"; } + if($q->param("startm") =~ /\d+/ && $q->param("startm") < 60 && $q->param("startm") >= 0) { + $data->{start} .= $q->param("startm"); + } else { print "Help!\n"; } + + if($q->param("stoph") =~ /\d+/ && $q->param("stoph") < 24 && $q->param("stoph") >= 0) { + $data->{stop} = $q->param("stoph"); + } else { print "Help!\n"; } + if($q->param("stopm") =~ /\d+/ && $q->param("stopm") < 60 && $q->param("stopm") >= 0) { + $data->{stop} .= $q->param("stopm"); + } else { print "Help!\n"; } + + if($q->param("prio") =~ /\d+/) { + $data->{prio} = $q->param("prio"); + } + + if($q->param("lft") =~ /\d+/) { + $data->{lft} = $q->param("lft"); + } + + if($q->param("active") == 0 || $q->param("active") == 1) { + $data->{active} = $q->param("active"); + } + + if($q->param("event_id") == 0) { + $data->{event_id} = 0; + } + + # if($q->param("event_id") == 1 && $data->{active} == 1) { + if($q->param("event_id") == 1) { + $data->{event_id} = 0; + $data->{active} |= 0x8000; + } + + # if($q->param("event_id") > 1 && $data->{active} == 1) { + if($q->param("event_id") > 1) { + $data->{event_id} = ($q->param("event_id") >> 1); + $data->{active} |= 0x8000; + } + + if($q->param("dor") =~ /[0-9MTWTWFSS-]+/) { + $data->{dor} = $q->param("dor"); + } + + if($q->param("channel") =~ /\d+/) { + $data->{channel} = $q->param("channel"); + } + + if(length($q->param("title")) > 0) { + $data->{title} = $q->param("title"); + } + + if(length($q->param("summary")) > 0) { + $data->{summary} = $q->param("summary"); + $data->{summary} =~ s/\://g; + $data->{summary} =~ s/[\r\n]//g; + } + + my $dor = $data->{dor}; + if(length($data->{dor}) == 7) { + # dummy + $dor = 1; + } + $data->{startsse} = my_mktime(substr($data->{start}, 2, 2), + substr($data->{start}, 0, 2), $dor, + (my_strftime("%m") - 1), my_strftime("%Y")); + + $data->{stopsse} = my_mktime(substr($data->{stop}, 2, 2), + substr($data->{stop}, 0, 2), + $data->{stop} > $data->{start} ? $dor : $dor + 1, + (my_strftime("%m") - 1), my_strftime("%Y")); + + my $return = ProgTimer( + $timer_id, + $data->{active}, + $data->{event_id}, + $data->{channel}, + $data->{startsse}, + $data->{stopsse}, + $data->{prio}, + $data->{lft}, + $data->{title}, + $data->{summary}, + ($dor == 1) ? $data->{dor} : undef + ); + + } + + #XXX + if($q->param("referer")) { + return(headerForward(Decode_Referer($q->param("referer")))); + } else { + return(headerForward("$MyURL?aktion=timer_list")); + } +} + +sub timer_delete { + my($timer_id) = $q->param('timer_id'); + if($timer_id) { + my($result) = SendCMD("delt $timer_id"); + if($result =~ /Timer "$timer_id" is recording/i) { + SendCMD("modt $timer_id off"); + sleep(1); + SendCMD("delt $timer_id"); + } + } else { + my @sorted; + for($q->param) { + if(/xxxx_(.*)/) { + push(@sorted, $1); + } + } + @sorted = sort({ $b <=> $a } @sorted); + for my $t (@sorted) { + my($result) = SendCMD("delt $t"); + if($result =~ /Timer "$t" is recording/i) { + SendCMD("modt $t off"); + sleep(1); + SendCMD("delt $t"); + } + } + CloseSocket(); + } + return(headerForward(RedirectToReferer("$MyURL?aktion=timer_list"))); +} + +sub rec_stream { + my($id) = $q->param('id'); + my($i, $title, $newtitle); + my $data; + my $f; + my(@tmp, $dirname, $name, $parent, @files); + my( $date, $time, $day, $month, $hour, $minute); + + for(SendCMD("lstr")) { + ($i, $date, $time, $title) = split(/ +/, $_, 4); + last if($id == $i); + } + $time = substr($time, 0, 5); # needed for wareagel-patch + if ( $id == $i) { + chomp($title); + ($day, $month)= split( /\./, $date); + ($hour, $minute)= split( /:/, $time); + # escape characters + $title =~ s/~/\//g; + $title =~ s/\ /\_/g; + for ( $i=0 ;$ i < length($title); $i++) { + unless ( substr($title,$i,1) =~ /[öäüßÖÄÜA-Za-z0123456789_!@\$%&\(\)\+,\-;=]/) { + $newtitle.= sprintf( "#%02X", ord( substr($title,$i,1))); + } else { + $newtitle.= substr($title,$i,1); + } + } + $title=$newtitle; + @files= `find $VIDEODIR/$title/????-$month-$day.$hour?$minute.??.??.rec -name "???.vdr" | sort -r`; + foreach (@files) { + $_ =~ s/$VIDEODIR//; + $data= $CONFIG{ST_URL}."$_\n$data"; + } + } + return(header("200", "audio/x-mpegurl", $data)); +} + +############################################################################# +# live streaming +############################################################################# +sub live_stream { + my $channel = $q->param("channel"); + my ($data, $ifconfig, $ip); + + if ( $CONFIG{VDR_HOST} eq "localhost") { + $ifconfig=`/sbin/ifconfig eth0`; + if ( $ifconfig =~ /inet.+:(\d+\.\d+\.\d+\.\d+)\s+Bcast/) { + $ip=$1; + } + } else { + $ip= $CONFIG{VDR_HOST}; + } + $data="http://$ip:3000/$channel"; + return(header("200", "audio/x-mpegurl", $data)); +} + +############################################################################# +# automatic timers +############################################################################# +sub at_timer_list { + return if(UptoDate()); + + # + my $desc; + if(!defined($q->param("desc"))) { + $desc = 1; + } else { + $q->param("desc") ? ($desc = 1) : ($desc = 0); + } + my $sortby = $q->param("sortby"); + ($sortby = "pattern") if(!$sortby); + + # + my @at; + my $id = 0; + for(AT_Read()) { + $id++; + if($_->{start}) { + $_->{start} = substr($_->{start}, 0, 2) . ":" . substr($_->{start}, 2, 5); + } + if($_->{stop}) { + $_->{stop} = substr($_->{stop}, 0, 2) . ":" . substr($_->{stop}, 2, 5); + } + $_->{modurl} = $MyURL . "?aktion=at_timer_edit&id=$id"; + $_->{delurl} = $MyURL . "?aktion=at_timer_delete&id=$id"; + $_->{prio} = $_->{prio} ? $_->{prio} : $CONFIG{AT_PRIORITY}; + $_->{lft} = $_->{lft} ? $_->{lft} : $CONFIG{AT_LIFETIME}; + $_->{id} = $id; + $_->{channel} = GetChannelDescByNumber($_->{channel}); + $_->{sortbyactive} = 1 if($sortby eq "active"); + $_->{sortbychannel} = 1 if($sortby eq "channel"); + $_->{sortbypattern} = 1 if($sortby eq "pattern"); + $_->{sortbystart} = 1 if($sortby eq "start"); + $_->{sortbystop} = 1 if($sortby eq "stop"); + $_->{toggleurl} = sprintf("%s?aktion=at_timer_toggle&active=%s&id=%s", $MyURL, ($_->{active} & 1) ? 0 : 1, $_->{id}), + push(@at, $_); + } + my @timer = sort({ lc($a->{pattern}) cmp lc($b->{pattern}) } @at); + + # + if($sortby eq "active") { + if(!$desc) { + @timer = sort({ $b->{active} <=> $a->{active} } @timer); + } else { + @timer = sort({ $a->{active} <=> $b->{active} } @timer); + } + } elsif($sortby eq "channel") { + if(!$desc) { + @timer = sort({ lc($b->{channel}) cmp lc($a->{channel}) } @timer); + } else { + @timer = sort({ lc($a->{channel}) cmp lc($b->{channel}) } @timer); + } + } elsif($sortby eq "pattern") { + if(!$desc) { + @timer = sort({ lc($b->{pattern}) cmp lc($a->{pattern}) } @timer); + } else { + @timer = sort({ lc($a->{pattern}) cmp lc($b->{pattern}) } @timer); + } + } elsif($sortby eq "start") { + if(!$desc) { + @timer = sort({ $b->{start} <=> $a->{start} } @timer); + } else { + @timer = sort({ $a->{start} <=> $b->{start} } @timer); + } + } elsif($sortby eq "stop") { + if(!$desc) { + @timer = sort({ $b->{stop} <=> $a->{stop} } @timer); + } else { + @timer = sort({ $a->{stop} <=> $b->{stop} } @timer); + } + } + $desc ? ($desc = 0) : ($desc = 1); + + # + my $template = TemplateNew("at_timer_list.html"); + $template->param( + sortbychannelurl => "$MyURL?aktion=at_timer_list&sortby=channel&desc=$desc", + sortbypatternurl => "$MyURL?aktion=at_timer_list&sortby=pattern&desc=$desc", + sortbyactiveurl => "$MyURL?aktion=at_timer_list&sortby=active&desc=$desc", + sortbystarturl => "$MyURL?aktion=at_timer_list&sortby=start&desc=$desc", + sortbystopurl => "$MyURL?aktion=at_timer_list&sortby=stop&desc=$desc", + sortbychannel => ($sortby eq "channel") ? 1 : 0, + sortbypattern => ($sortby eq "pattern") ? 1 : 0, + sortbyactive => ($sortby eq "active") ? 1 : 0, + sortbystart => ($sortby eq "start") ? 1 : 0, + sortbystop => ($sortby eq "stop") ? 1 : 0, + desc => $desc, + at_timer_loop => \@timer, + naturl => $MyURL . "?aktion=at_timer_new", + #naturl => $MyURL . "?aktion=at_timer_new&active=1", + url => $MyURL, + force_update_url => "$MyURL?aktion=force_update", + help_url => HelpURL("at_timer_list"), + ); + return(header("200", "text/html", $template->output)); +} + +sub at_timer_toggle { + UptoDate(); + my $active = $q->param("active"); + my $id = $q->param("id"); + + my(@at, $z); + + for(AT_Read()) { + $z++; + if($z == $id) { + $_->{active} = $active; + } + push(@at, $_); + } + AT_Write(@at); + + return(headerForward(RedirectToReferer("$MyURL?aktion=at_timer_list"))); +} + +sub at_timer_edit { + my $id = $q->param("id"); + + my @at = AT_Read(); + + # + my @chans; + for my $chan (@CHAN) { + if($chan->{vdr_id}) { + $chan->{cur} = ($chan->{vdr_id} == $at[$id-1]->{channel}) ? 1 : 0; + push(@chans, $chan); + } + } + + my $template = TemplateNew("at_new.html"); + $template->param( + channels => \@chans, + id => $id, + url => $MyURL, + prio => $at[$id-1]->{prio} ? $at[$id-1]->{prio} : $CONFIG{AT_PRIORITY}, + lft => $at[$id-1]->{lft} ? $at[$id-1]->{lft} : $CONFIG{AT_LIFETIME}, + active => $at[$id-1]->{active}, + done => $at[$id-1]->{done}, + episode => $at[$id-1]->{episode}, + pattern => $at[$id-1]->{pattern}, + starth => (length($at[$id-1]->{start}) >= 4) ? substr($at[$id-1]->{start}, 0, 2) : undef, + startm => (length($at[$id-1]->{start}) >= 4) ? substr($at[$id-1]->{start}, 2, 5) : undef, + stoph => (length($at[$id-1]->{stop}) >= 4) ? substr($at[$id-1]->{stop}, 0, 2) : undef, + stopm => (length($at[$id-1]->{stop}) >= 4) ? substr($at[$id-1]->{stop}, 2, 5) : undef, + title => ($at[$id-1]->{section} & 1) ? 1 : 0, + subtitle => ($at[$id-1]->{section} & 2) ? 1 : 0, + description => ($at[$id-1]->{section} & 4) ? 1 : 0, + directory => $at[$id-1]->{directory}, + newtimer => 0, + help_url => HelpURL("at_timer_new") + ); + return(header("200", "text/html", $template->output)); +} + +sub at_timer_new { + my $template = TemplateNew("at_new.html"); + $template->param( + url => $MyURL, + active => $q->param("active"), + done => $q->param("done"), + title => 1, + channels => \@CHAN, + prio => $CONFIG{AT_PRIORITY}, + lft => $CONFIG{AT_LIFETIME}, + newtimer => 1, + help_url => HelpURL("at_timer_new"), + ); + return(header("200", "text/html", $template->output)); +} + +sub at_timer_save { + my $id = $q->param("id"); + + if($q->param("save")) { + if(!$id) { + my @at = AT_Read(); + my $section = 0; + ($section += 1) if($q->param("title")); + ($section += 2) if($q->param("subtitle")); + ($section += 4) if($q->param("description")); + push(@at, { + episode => $q->param("episode") ? $q->param("episode") : 0, + active => $q->param("active"), + done => $q->param("done"), + pattern => $q->param("pattern"), + section => $section, + start => $q->param("starth") . $q->param("startm"), + stop => $q->param("stoph") . $q->param("stopm"), + prio => $q->param("prio"), + lft => $q->param("lft"), + channel => $q->param("channel"), + directory => $q->param("directory") + }); + AT_Write(@at); + } else { + my $z = 0; + my @at; + for(AT_Read()) { + $z++; + if($z != $id) { + push(@at, $_); + } else { + my $section = 0; + ($section += 1) if($q->param("title")); + ($section += 2) if($q->param("subtitle")); + ($section += 4) if($q->param("description")); + push(@at, { + episode => $q->param("episode") ? $q->param("episode") : 0, + active => $q->param("active"), + done => $q->param("done"), + pattern => $q->param("pattern"), + section => $section, + start => $q->param("starth") . $q->param("startm"), + stop => $q->param("stoph") . $q->param("stopm"), + prio => $q->param("prio"), + lft => $q->param("lft"), + channel => $q->param("channel"), + directory => $q->param("directory") + }); + } + } + AT_Write(@at); + } + + $CONFIG{CACHE_LASTUPDATE} = 0; + UptoDate(); + } + headerForward("$MyURL?aktion=at_timer_list"); +} + +sub at_timer_delete { + my $id = $q->param("id"); + my $z = 0; + + my @at = AT_Read(); + my @new; + if($id) { + for(@at) { + $z++; + push(@new, $_) if($id != $z); + } + AT_Write(@new); + } else { + my @sorted; + for($q->param) { + if(/xxxx_(.*)/) { + push(@sorted, $1); + } + } + @sorted = sort({ $b <=> $a } @sorted); + my $z = 0; + for my $at (@at) { + $z++; + my $push = 1; + for my $sorted (@sorted) { + ($push = 0) if($z == $sorted); + } + push(@new, $at) if($push); + } + AT_Write(@new); + } + headerForward("$MyURL?aktion=at_timer_list"); +} + + +############################################################################# +# timeline +############################################################################# +sub prog_timeline { + return if(UptoDate()); + my $time = $q->param("time"); + + # zeitpunkt bestimmen + my $event_time; + my $event_time_to; + + if($time ne "") { + my ($hour, $minute); + if($time =~ /(\d{1,2})(\D?)(\d{1,2})/) { + if(length($1) == 1 && length($3) == 1 && !$2) { + $hour = $1 . $3; + } else { + ($hour, $minute) = ($1, $3); + } + } elsif($time =~ /\d/) { + $hour = $time; + } + + if($hour <= my_strftime("%H") && $minute < my_strftime("%M")) { + $event_time = timelocal( + 0, + $minute, + $hour, + my_strftime("%d", time + 86400), + (my_strftime("%m", time + 86400) - 1), + my_strftime("%Y") + ) + 1; + } else { + $event_time = timelocal( + 0, + $minute, + $hour, + my_strftime("%d"), + (my_strftime("%m") - 1), + my_strftime("%Y") + ) + 1; + } + } else { + $event_time = time(); + } + + $event_time_to = $event_time + ($CONFIG{ZEITRAHMEN} * 3600); + + # Timer parsen, und erstmal alle rausschmeissen die nicht in der Zeitzone liegen + my $TIM; + for my $timer (ParseTimer(0)) { + next if($timer->{stopsse} < $event_time or $timer->{startsse} > $event_time_to); + my $title = (split(/\~/, $timer->{title}))[-1]; + $TIM->{$title} = $timer; + } + + my(@show, @shows, @temp); + my $shows; + + my @epgChannels = split(/\,/, $CONFIG{CHANNELS_WANTED}); + @epgChannels = keys(%EPG) + unless scalar @epgChannels; + + foreach(@epgChannels) { # Sender durchgehen + next unless(ChannelHasEPG($_)); + foreach my $event (sort {$a->{start} <=> $b->{start} } @{$EPG{$_}}) { # Events durchgehen + next if($event->{stop} < $event_time or $event->{start} > $event_time_to ); + + push(@show, { + date => my_strftime("%d.%m.%y", $event->{start}), + longdate => sprintf("%s., %s. %s %s", + substr(FullDay(my_strftime("%w", $event->{start}), $event->{start}), 0, 2), + my_strftime("%d", $event->{start}), + FullMonth(my_strftime("%m", $event->{start})), + my_strftime("%Y", $event->{start})), + start => $event->{start}, + stop => $event->{stop}, + title => $event->{title}, + subtitle => (length($event->{subtitle}) > 30 ? substr($event->{subtitle}, 0, 30) . "..." : $event->{subtitle}), + progname => $event->{channel_name}, + summary => $event->{summary}, + vdr_id => $event->{vdr_id}, + proglink => sprintf("%s?aktion=prog_list&vdr_id=%s", $MyURL, $event->{vdr_id}), + switchurl=> sprintf("%s?aktion=prog_switch&channel=%s", $MyURL, $event->{vdr_id}), + infurl => ($event->{summary} ? sprintf("%s?aktion=prog_detail&epg_id=%s&vdr_id=%s", $MyURL, $event->{event_id}, $event->{vdr_id}) : undef), + recurl => sprintf("%s?aktion=timer_new_form&epg_id=%s&vdr_id=%s", $MyURL, $event->{event_id}, $event->{vdr_id}), + anchor => $event->{event_id}, + timer => ( defined $TIM->{ $event->{title} } && $TIM->{ $event->{title} }->{vdr_id} == $event->{vdr_id} ? 1 : 0 ), + }); + } + # needed for vdr 1.0.x, dunno why + @show = sort({ $a->{vdr_id} <=> $b->{vdr_id} } @show); + push(@{ $shows->{ $EPG{$_}->[0]->{vdr_id} } }, @show) + if @show; + undef @show; + } + + my $vars = { + shows => $shows, + now_sec => $event_time, + now => strftime("%H:%M", localtime($event_time)), + datum => sprintf("%s., %s. %s %s", + substr(FullDay(my_strftime("%w", time), time), 0, 2), + my_strftime("%d", time), + FullMonth(my_strftime("%m", time)), + my_strftime("%Y", time)), + nowurl => $MyURL . "?aktion=prog_timeline", + url => $MyURL, + config => \%CONFIG, + }; + + my $template = TemplateNew("prog_timeline.html"); + $template->param( $vars ); + + # New Template + my $output; + my $out = $template->output; + $Xtemplate->process(\$out, $vars, \$output) + || return(header("500", "text/html", $Xtemplate->error())); + + return(header("200", "text/html", $output)); +} + + +############################################################################# +# summary +############################################################################# +sub prog_summary { + return if(UptoDate()); + my $time = $q->param("time"); + my $search = $q->param("search"); + + # zeitpunkt bestimmen + my $event_time; + if($time ne "") { + my ($hour, $minute); + if($time =~ /(\d{1,2})(\D?)(\d{1,2})/) { + if(length($1) == 1 && length($3) == 1 && !$2) { + $hour = $1 . $3; + } else { + ($hour, $minute) = ($1, $3); + } + } elsif($time =~ /\d/) { + $hour = $time; + } + + if($hour <= my_strftime("%H") && $minute < my_strftime("%M")) { + $event_time = timelocal( + 0, + $minute, + $hour, + my_strftime("%d", time + 86400), + (my_strftime("%m", time + 86400) - 1), + my_strftime("%Y") + ) + 1; + } else { + $event_time = timelocal( + 0, + $minute, + $hour, + my_strftime("%d"), + (my_strftime("%m") - 1), + my_strftime("%Y") + ) + 1; + } + } else { + $event_time = time(); + } + + my(@show, @shows, @temp); + for(keys(%EPG)) { + for my $event (@{$EPG{$_}}) { + if(!$search) { + if($CONFIG{CHANNELS_WANTED_SUMMARY}) { + my $f = 0; + for my $n (split(/\,/, $CONFIG{CHANNELS_WANTED})) { + ($f = 1) if($n eq $event->{vdr_id}); + } + next if(!$f); + } + next if($event_time > $event->{stop}); + } else { + my($found); + for my $word (split(/ +/, $search)) { + $found = 0; + for my $section (qw(title subtitle summary)) { + if($event->{$section} =~ /$word/i) { + $found = 1; + } + } + if(!$found) { + last; + } + } + next if(!$found); + } + + push(@show, { + date => my_strftime("%d.%m.%y", $event->{start}), + longdate => sprintf("%s., %s. %s %s", + substr(FullDay(my_strftime("%w", $event->{start}), $event->{start}), 0, 2), + my_strftime("%d", $event->{start}), + FullMonth(my_strftime("%m", $event->{start})), + my_strftime("%Y", $event->{start})), + start => my_strftime("%H:%M", $event->{start}), + stop => my_strftime("%H:%M", $event->{stop}), + title => $event->{title}, + subtitle => length($event->{subtitle}) > 30 ? substr($event->{subtitle}, 0, 30) . "..." : $event->{subtitle}, + progname => $event->{channel_name}, + summary => length($event->{summary}) > 120 ? substr($event->{summary}, 0, 120) . "..." : $event->{summary}, + vdr_id => $event->{vdr_id}, + proglink => sprintf("%s?aktion=prog_list&vdr_id=%s", $MyURL, $event->{vdr_id}), + switchurl=> sprintf("%s?aktion=prog_switch&channel=%s", $MyURL, $event->{vdr_id}), + streamurl=> sprintf("%s?aktion=live_stream&channel=%s", $MyURL, $event->{vdr_id}), + infurl => $event->{summary} ? sprintf("%s?aktion=prog_detail&epg_id=%s&vdr_id=%s", $MyURL, $event->{event_id}, $event->{vdr_id}) : undef, + recurl => sprintf("%s?aktion=timer_new_form&epg_id=%s&vdr_id=%s", $MyURL, $event->{event_id}, $event->{vdr_id}), + anchor => $event->{event_id} + }); + last if(!$search); + } + } + + # needed for vdr 1.0.x, dunno why + @show = sort({ $a->{vdr_id} <=> $b->{vdr_id} } @show); + + # + my @status; + my $spalten = 3; + for(my $i = 0; $i <= $#show; $i++) { + undef(@temp); + undef(@status); + for(my $z = 0; $z < $spalten; $i++, $z++) { + push(@temp, $show[$i]); + push(@status, $show[$i]); + } + $i--; + push(@shows, { day => [ @temp ], status => [ @status ] }); + } + + # + my $template = TemplateNew("prog_summary.html"); + $template->param( + rows => \@shows, + now => strftime("%H:%M", localtime($event_time)), + nowurl => $MyURL . "?aktion=prog_summary", + url => $MyURL + ); + return(header("200", "text/html", $template->output)); +} + + +############################################################################# +# recordings +############################################################################# +sub rec_list { + my(@all_recordings, @recordings); + + # + my $ffserver = `ps -ef | grep ffserver | wc -l`; + my $desc; + if(!defined($q->param("desc"))) { + $desc = 1; + } else { + $q->param("desc") ? ($desc = 1) : ($desc = 0); + } + my $sortby = $q->param("sortby"); + ($sortby = "name") if(!$sortby); + my $parent = $q->param("parent"); + if(!$parent) { + $parent = 0; + } + + my(@response) = SendCMD("lstr"); + for my $recording (@response) { + chomp($recording); + next if(length($recording) == 0); + if($recording =~ /^No recordings available/) { + last; + } + my($new); + my($id, $date, $time, $name) = split(/ +/, $recording, 4); + + # + if(substr($time, 5, 1) eq "*") { + $new = 1; + $time =~ s/\*//; + } + + # + my(@tmp, @tmp2, $serie, $episode, $parent, $dirname, $dirname1); + if($name =~ /~/) { + @tmp2 = split(" ", $name, 2); + if(scalar(@tmp2) > 1) { + if(ord(substr($tmp2[0], length($tmp2[0])-1, 1)) == 180) { + @tmp = split("~", $tmp2[1]); + $name = "$tmp2[0] $tmp[scalar(@tmp) - 1]"; + } else { + @tmp = split("~", $name); + $name = $tmp[scalar(@tmp) - 1]; + } + } else { + @tmp = split("~", $name); + $name = $tmp[scalar(@tmp) - 1]; + } + $dirname = $tmp[scalar(@tmp) - 2]; + $parent = crypt($dirname, salt($dirname)); + } + $parent = 0 if(!$parent); + + # create subfolders + for(my $i = 0; $i < scalar(@tmp) - 1; $i++) { + my $recording_id = crypt($tmp[$i], salt($tmp[$i])); + my $parent; + if($i != 0) { + $parent = crypt($tmp[$i - 1], salt($tmp[$i - 1])); + } else { + $parent = 0; + } + + my $found = 0; + for my $recording (@all_recordings) { + next if(!$recording->{isfolder}); + if($recording->{recording_id} eq $recording_id && $recording->{parent} eq $parent) { + $found = 1; + } + } + if(!$found) { + push(@all_recordings, { + name => $tmp[$i], + recording_id => $recording_id, + parent => $parent, + isfolder => 1, + date => 0, + time => 0, + sortbydate => ($sortby eq "date") ? 1 : 0, + sortbytime => ($sortby eq "time") ? 1 : 0, + sortbyname => ($sortby eq "name") ? 1 : 0, + infurl => sprintf("%s?aktion=rec_list&parent=%s", $MyURL, $recording_id) + }); + } + } + + # + push(@all_recordings, { + sse => timelocal(undef, substr($time, 3, 2), + substr($time, 0, 2), substr($date, 0, 2), + (substr($date, 3, 2) - 1), + my_strftime("%Y")), + date => $date, + time => $time, + name => $name, + serie => $serie, + episode => $episode, + parent => $parent, + new => $new, + id => $id, + sortbydate => ($sortby eq "date") ? 1 : 0, + sortbytime => ($sortby eq "time") ? 1 : 0, + sortbyname => ($sortby eq "name") ? 1 : 0, + delurl => $MyURL . "?aktion=rec_delete&id=$id", + editurl => $MyURL . "?aktion=rec_edit&id=$id", + infurl => $MyURL . "?aktion=rec_detail&id=$id", + streamurl => $MyURL . "?aktion=rec_stream&id=$id" + }); + } + + # XXX doesn't count subsub-folders + for(@all_recordings) { + if($_->{parent} eq $parent && $_->{isfolder}) { + for my $recording (@all_recordings) { + if($recording->{parent} eq $_->{recording_id}) { + $_->{date}++; + $_->{time}++ if($recording->{new}); + } + } + } + } + + # create path array + my @path; my $fuse = 0; + my $rparent = $parent; + while($rparent) { + for my $recording (@all_recordings) { + if($recording->{recording_id} eq $rparent) { + push(@path, { + name => $recording->{name}, + url => ($recording->{recording_id} ne $parent) ? + sprintf("%s?aktion=rec_list&parent=%s", + $MyURL, $recording->{recording_id}) : "" }); + $rparent = $recording->{parent}; + last; + } + } + $fuse++; + last if($fuse > 100); + } + push(@path, { + name => $COMMONMESSAGE{OVERVIEW}, + url => ($parent ne 0) ? + sprintf("%s?aktion=rec_list&parent=%s", $MyURL, 0) : "" }); + @path = reverse(@path); + + # filter + if(defined($parent)) { + for my $recording (@all_recordings) { + if($recording->{parent} eq $parent) { + push(@recordings, $recording); + } + } + } else { + @recordings = @all_recordings; + } + + + # + if($sortby eq "time") { + if(!$desc) { + @recordings = sort({ $b->{time} <=> $a->{time} } @recordings); + } else { + @recordings = sort({ $a->{time} <=> $b->{time} } @recordings); + } + } elsif($sortby eq "name") { + if(!$desc) { + @recordings = sort({ lc($b->{name}) cmp lc($a->{name}) } @recordings); + } else { + @recordings = sort({ lc($a->{name}) cmp lc($b->{name}) } @recordings); + } + } elsif($sortby eq "date") { + if(!$desc) { + @recordings = sort({ $a->{sse} <=> $b->{sse} } @recordings); + } else { + @recordings = sort({ $b->{sse} <=> $a->{sse} } @recordings); + } + } + $desc ? ($desc = 0) : ($desc = 1); + + # + my($total, $minutes_total, $free, $minutes_free, $percent) = VideoDiskFree(); + + + my $template = TemplateNew("rec_list.html"); + $template->param( + recloop => \@recordings, + sortbydateurl => "$MyURL?aktion=rec_list&parent=$parent&sortby=date&desc=$desc&parent=$parent", + sortbytimeurl => "$MyURL?aktion=rec_list&parent=$parent&sortby=time&desc=$desc&parent=$parent", + sortbynameurl => "$MyURL?aktion=rec_list&parent=$parent&sortby=name&desc=$desc&parent=$parent", + sortbydate => ($sortby eq "date") ? 1 : 0, + sortbytime => ($sortby eq "time") ? 1 : 0, + sortbyname => ($sortby eq "name") ? 1 : 0, + desc => $desc, + disk_total => $total, + disk_free => $free, + disk_percent => $percent, + minutes_free => $minutes_free, + minutes_total => $minutes_total, + path => \@path, + url => $MyURL, + help_url => HelpURL("rec_list"), + ); + return(header("200", "text/html", $template->output)); +} + +sub rec_detail { + my($id) = $q->param('id'); + + # + my($i, $title); + for(SendCMD("lstr")) { + ($i, undef, undef, $title) = split(/ +/, $_, 4); + last if($id == $i); + } + chomp($title); + + # + my($text); my($first) = 1; + my($result) = SendCMD("lstr $id"); + if($result !~ /No summary availab/i) { + for(split(/\|/, $result)) { + if($_ ne (split(/\~/, $title))[1]) { + if($first && $title !~ /\~/ && length($title) < 20) { + $title .= "~" . $_; + $first = 0; + } else { + $text .= "$_ "; + } + } + } + } + + # + $title =~ s/\~/ - /; + + my $template = TemplateNew("prog_detail.html"); + $template->param( + text => $text ? $text : "", + title => $title + ); + return(header("200", "text/html", $template->output)); +} + +sub rec_delete { + my($id) = $q->param('id'); + if($id) { + SendCMD("delr $id"); + } else { + for($q->param) { + if(/xxxx_(.*)/) { + SendCMD("delr $1"); + } + } + } + CloseSocket(); + return(headerForward(RedirectToReferer("$MyURL?aktion=rec_list"))); +} + +sub rec_edit { + + my $id = $q->param("id"); + my($i, $title); + + for(SendCMD("lstr")) { + ($i, undef, undef, $title) = split(/ +/, $_, 4); + last if($id == $i); + } + chomp($title); + + my $template = TemplateNew("rec_edit.html"); + $template->param( + url => $MyURL, + title => $title, + id => $id, + ); + return(header("200", "text/html", $template->output)); +} + +sub rec_rename { + my($id) = $q->param('id'); + my($nn) = $q->param('nn'); + if($id) { + SendCMD("RENR $id $nn"); +# } else { +# for($q->param) { +# if(/xxxx_(.*)/) { +# SendCMD("renr $1 $_[0]"); +# } +# } + } + CloseSocket(); + headerForward("$MyURL?aktion=rec_list"); +} + +############################################################################# +# configuration +############################################################################# +sub conf_list { + return if(UptoDate()); + + sub ApplyConfig { + for($q->param) { + if(/[A-Z]+/) { + $CONFIG{$_} = $q->param($_); + } + } + # + LoadTranslation(); + } + + sub WriteConfig { + open(CONF, ">$CONFFILE") || print "Can't open $CONFFILE! ($!)\n"; + for my $key (sort(keys(%CONFIG))) { + print CONF "$key = $CONFIG{$key}\n"; + } + close(CONF); + } + + if($q->param("submit") eq ">>>>>") { + for my $vdr_id ($q->param("all_channels")) { + $CONFIG{CHANNELS_WANTED} = csvAdd($CONFIG{CHANNELS_WANTED}, $vdr_id); + } + ApplyConfig(); WriteConfig(); + } elsif($q->param("submit") eq "<<<<<") { + for my $vdr_id ($q->param("selected_channels")) { + $CONFIG{CHANNELS_WANTED} = csvRemove($CONFIG{CHANNELS_WANTED}, $vdr_id); + } + ApplyConfig(); WriteConfig(); + } elsif($q->param("save")) { + ApplyConfig(); WriteConfig(); + } elsif($q->param("apply")) { + ApplyConfig(); + } + + # + my(@loginpages); + my $i = 0; + for my $loginpage (@LOGINPAGES) { + push(@loginpages, { + id => $i, + name => $LOGINPAGES_DESCRIPTION[$i], + current => ($CONFIG{LOGINPAGE} == $i) ? 1 : 0 + }); + $i++; + } + + # + my @lang; + for my $dir (<$TEMPLATEDIR/*>) { + next if(!-d $dir); + $dir =~ s/.*\///g; + my $found = 0; + for(@lang) { ($found = 1) if($1 && ($_->{name} eq $1)); } + if(!$found) { + push(@lang, { + name => $dir, + aklang => ($CONFIG{LANGUAGE} eq $dir) ? 1 : 0, + }); + } + } + + # + my (@all_channels, @selected_channels); + for my $channel (@CHAN) { + # + push(@all_channels, { + name => $channel->{name}, + vdr_id => $channel->{vdr_id} + }); + + # + my $found = 0; + for(split(",", $CONFIG{CHANNELS_WANTED})) { + if($_ eq $channel->{vdr_id}) { + $found = 1; + } + } + next if !$found; + push(@selected_channels, { + name => $channel->{name}, + vdr_id => $channel->{vdr_id} + }); + } + + my @skinlist; + foreach my $file (glob(sprintf("%s/%s/*",$TEMPLATEDIR, $CONFIG{LANGUAGE}))) { + my $name = (split('\/', $file))[-1]; + push(@skinlist,{ + name => $name, + sel => ($CONFIG{SKIN} eq $name ? 1 : 0) + }) if(-d $file); + } + + my $template = TemplateNew("config.html"); + $template->param( + %CONFIG, + LANGLIST => \@lang, + ALL_CHANNELS => \@all_channels, + SELECTED_CHANNELS => \@selected_channels, + LOGINPAGES => \@loginpages, + SKINLIST => \@skinlist, + url => $MyURL, + help_url => HelpURL("help_url"), + ); + return(header("200", "text/html", $template->output)); +} + +############################################################################# +# remote control +############################################################################# +sub rc_show { + my $template = TemplateNew("rc.html"); + $template->param( + surl_0 => $MyURL . "?aktion=rc_hitk&key=0", + surl_1 => $MyURL . "?aktion=rc_hitk&key=1", + surl_2 => $MyURL . "?aktion=rc_hitk&key=2", + surl_3 => $MyURL . "?aktion=rc_hitk&key=3", + surl_4 => $MyURL . "?aktion=rc_hitk&key=4", + surl_5 => $MyURL . "?aktion=rc_hitk&key=5", + surl_6 => $MyURL . "?aktion=rc_hitk&key=6", + surl_7 => $MyURL . "?aktion=rc_hitk&key=7", + surl_8 => $MyURL . "?aktion=rc_hitk&key=8", + surl_9 => $MyURL . "?aktion=rc_hitk&key=9", + + surl_power => $MyURL . "?aktion=rc_hitk&key=Power", + + surl_ok => $MyURL . "?aktion=rc_hitk&key=Ok", + + surl_menu => $MyURL . "?aktion=rc_hitk&key=Menu", + surl_back => $MyURL . "?aktion=rc_hitk&key=Back", + + surl_up => $MyURL . "?aktion=rc_hitk&key=Up", + surl_down => $MyURL . "?aktion=rc_hitk&key=Down", + surl_left => $MyURL . "?aktion=rc_hitk&key=Left", + surl_right => $MyURL . "?aktion=rc_hitk&key=Right", + + surl_red => $MyURL . "?aktion=rc_hitk&key=Red", + surl_green => $MyURL . "?aktion=rc_hitk&key=Green", + surl_blue => $MyURL . "?aktion=rc_hitk&key=Blue", + surl_yellow => $MyURL . "?aktion=rc_hitk&key=Yellow", + + surl_volplus => $MyURL . "?aktion=rc_hitk&key=VolumePlus", + surl_volminus => $MyURL . "?aktion=rc_hitk&key=VolumeMinus", + url => sprintf("%s?aktion=grab_picture", $MyURL), + host => $CONFIG{VDR_HOST} + ); + return(header("200", "text/html", $template->output)); +} + +sub rc_hitk { + my $key = $q->param("key"); + if($key eq "VolumePlus") { + $key = "Volume+"; + } + if($key eq "VolumeMinus") { + $key = "Volume-"; + } + SendCMD("hitk $key"); + #XXX + SendFile("bilder/spacer.gif"); +} + +sub tv_show { + my $template = TemplateNew("tv.html"); + $template->param( + url => sprintf("%s?aktion=grab_picture", $MyURL), + host => $CONFIG{VDR_HOST} + ); + return(header("200", "text/html", $template->output)); +} + +sub show_help { + my $area = $q->param("area"); + my $text; + if(length($HELP{$area}) == 0) { + $text = $HELP{ENOHELPMSG}; + } else { + $text = $HELP{$area}; + } + my $template = TemplateNew("prog_detail.html"); # XXX eigenes Template? + $template->param(text => $text); + return(header("200", "text/html", $template->output)); +} + +############################################################################# +# experimental +############################################################################# +sub grab_picture { + my $size = $q->param("size"); + my $file = "/tmp/vdr.jpg"; + my $maxwidth = 768; + my $maxheight = 576; + my($width, $height); + if($size eq "full") { + ($width, $height) = ($maxwidth, $maxheight); + } elsif($size eq "half") { + ($width, $height) = ($maxwidth / 2, $maxheight / 2); + } elsif($size eq "quarter") { + ($width, $height) = ($maxwidth / 4, $maxheight / 4); + } else { + ($width, $height) = ($maxwidth / 4, $maxheight / 4); + } + + SendCMD("grab $file jpeg 70 $width $height"); + #SendCMD("grab $file jpeg"); + if(-e $file && -r $file) { + return(header("200", "image/jpeg", ReadFile($file))); + } else { + print "Expected $file does not exist.\n"; + print "Obviously VDR Admin could not find the screenshot file. Ensure that:\n"; + print " - VDR has the rights to write $file\n"; + print " - VDR and VDR Admin run on the same machine\n"; + print " - VDR Admin may read $file\n"; + print " - VDR has access to /dev/video* files\n"; + print " - you have a full featured card\n"; + } +} + +sub force_update { + UptoDate(1); + RedirectToReferer("$MyURL?aktion=prog_summary"); +} + +############################################################################# +# communikation with vdr +############################################################################# +package SVDRP; + +sub true () { main::true(); } +sub false () { main::false(); }; +sub LOG_VDRCOM () { main::LOG_VDRCOM(); }; +sub CRLF () { main::CRLF(); }; + +my($SOCKET, $EPGSOCKET, $query, $connected, $epg); + +sub new { + my $invocant = shift; + my $class = ref($invocant) || $invocant; + my $self = { }; + bless($self, $class); + $connected = false; + $query = false; + $epg = false; + return $self; +} + +sub myconnect { + my $this = shift; + if ( $epg && $CONFIG{EPG_DIRECT}) { + main::Log(LOG_VDRCOM, "LOG_VDRCOM: open EPG $CONFIG{EPG_FILENAME}"); + open($EPGSOCKET,$CONFIG{EPG_FILENAME}) || main::HTMLError(sprintf("Failed to open %s", $CONFIG{EPG_FILENAME})); + return; + } + main::Log(LOG_VDRCOM, "LOG_VDRCOM: connect to $CONFIG{VDR_HOST}:$CONFIG{VDR_PORT}"); + + $SOCKET = IO::Socket::INET->new( + PeerAddr => $CONFIG{VDR_HOST}, + PeerPort => $CONFIG{VDR_PORT}, + Proto => 'tcp' + ) || main::HTMLError(sprintf($ERRORMESSAGE{CONNECT_FAILED}, $CONFIG{VDR_HOST})); + + my $line; + $line = <$SOCKET>; + $connected = true; +} + +sub close { + my $this = shift; + if( $epg && $CONFIG{EPG_DIRECT} ) { + main::Log(LOG_VDRCOM, "LOG_VDRCOM: closing EPG"); + close $EPGSOCKET; + $epg=false; + return; + } + if($connected) { + main::Log(LOG_VDRCOM, "LOG_VDRCOM: closing connection"); + command($this, "quit"); + readoneline($this); + close $SOCKET if $SOCKET; + $connected = false; + } +} + +sub command { + my $this = shift; + my $cmd = join("", @_); + + if ( $cmd =~ /lste/ && $CONFIG{EPG_DIRECT} ) { + $epg=true; + main::Log(LOG_VDRCOM, sprintf("LOG_VDRCOM: special epg ")); + } else { + $epg=false; + } + if(!$connected || $epg) { + myconnect($this); + } + if ( $epg ) { + $query = true; + return; + } + + main::Log(LOG_VDRCOM, sprintf("LOG_VDRCOM: send \"%s\"", $cmd)); + $cmd = $cmd . CRLF; + if($SOCKET) { + my $result = send($SOCKET, $cmd, 0); + if($result != length($cmd)) { + main::HTMLError($ERRORMESSAGE{SEND_COMMAND}, $CONFIG{VDR_HOST}); + } else { + $query = true; + } + } +} + +sub readoneline { + my $this = shift; + my $line; + + if ( $epg && $CONFIG{EPG_DIRECT} ) { + $line = <$EPGSOCKET>; + $line =~ s/\n$//; + main::Log(LOG_VDRCOM, sprintf("LOG_VDRCOM: EPGread \"%s\"", $line)); + $query=true; + return($line); + } + + if($connected && $query) { + $line = <$SOCKET>; + $line =~ s/\r\n$//; + if(substr($line, 3, 1) ne "-") { + $query = 0; + } + $line = substr($line, 4, length($line)); + main::Log(LOG_VDRCOM, sprintf("LOG_VDRCOM: read \"%s\"", $line)); + return($line); + } else { + return undef; + } +} +# +############################################################################# + +# EOF -- cgit v1.2.3