home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _b7c2e50f29287ae0a1b2d7ba57f1dcf0 < prev    next >
Text File  |  2004-06-01  |  3KB  |  130 lines
  1.  
  2. require 5;
  3. package HTML::AsSubs;
  4. #Time-stamp: "2000-06-28 13:06:25 MDT"
  5.  
  6. =head1 NAME
  7.  
  8. HTML::AsSubs - functions that construct a HTML syntax tree
  9.  
  10. =head1 SYNOPSIS
  11.  
  12.  use HTML::AsSubs;
  13.  $h = body(
  14.        h1("This is the heading"),
  15.        p("This is the first paragraph which contains a ",
  16.          a({href=>'link.html'}, "link"),
  17.          " and an ",
  18.          img({src=>'img.gif', alt=>'image'}),
  19.          "."
  20.         ),
  21.       );
  22.  print $h->as_HTML;
  23.  
  24. =head1 DESCRIPTION
  25.  
  26. This module exports functions that can be used to construct various
  27. HTML elements. The functions are named after the tags of the
  28. correponding HTML element and are all written in lower case. If the
  29. first argument is a hash reference then it will be used to initialize the
  30. attributes of this element. The remaining arguments are regarded as
  31. content.
  32.  
  33. For a similar idea (i.e., it's another case where the syntax tree
  34. of the Perl source mirrors the syntax tree of the HTML produced),
  35. see HTML::Element's C<new_from_lol> method.
  36.  
  37. For what I now think is a cleaner implementation of this same idea,
  38. see the excellent module C<XML::Generator>, which is what I suggest
  39. for actual real-life use.  (I suggest this over C<HTML::AsSubs> and
  40. over C<CGI.pm>'s HTML-making functions.)
  41.  
  42. =head1 ACKNOWLEDGEMENT
  43.  
  44. This module was inspired by the following message:
  45.  
  46.  Date: Tue, 4 Oct 1994 16:11:30 +0100
  47.  Subject: Wow! I have a large lightbulb above my head!
  48.  
  49.  Take a moment to consider these lines:
  50.  
  51.  %OVERLOAD=( '""' => sub { join("", @{$_[0]}) } );
  52.  
  53.  sub html { my($type)=shift; bless ["<$type>", @_, "</$type>"]; }
  54.  
  55.  :-)  I *love* Perl 5!  Thankyou Larry and Ilya.
  56.  
  57.  Regards,
  58.  Tim Bunce.
  59.  
  60.  p.s. If you didn't get it, think about recursive data types: html(html())
  61.  p.p.s. I'll turn this into a much more practical example in a day or two.
  62.  p.p.p.s. It's a pity that overloads are not inherited. Is this a bug?
  63.  
  64. =head1 BUGS
  65.  
  66. The exported link() function overrides the builtin link() function.
  67. The exported tr() function must be called using &tr(...) syntax
  68. because it clashes with the builtin tr/../../ operator.
  69.  
  70. =head1 SEE ALSO
  71.  
  72. L<HTML::Element>, L<XML::Generator>
  73.  
  74. =cut
  75.  
  76. use strict;
  77. use vars qw(@ISA $VERSION @EXPORT);
  78.  
  79. require HTML::Element;
  80. require Exporter;
  81. @ISA = qw(Exporter);
  82.  
  83. $VERSION = '1.16';
  84.  
  85. # Problem: exports so damned much.  Has no concept of "export only HTML4
  86. #  elements".  TODO:?? make something that make functions that just
  87. #  wrap XML::Generator calls?
  88.  
  89. use vars qw(@TAGS);
  90. @TAGS = qw(html
  91.        head title base link meta isindex nextid script style
  92.        body h1 h2 h3 h4 h5 h6 p pre div blockquote
  93.        a img br hr
  94.        ol ul dir menu li
  95.        dl dt dd
  96.        dfn cite code em kbd samp strong var address 
  97.        b i u tt
  98.            center font big small strike
  99.            sub sup
  100.        table tr td th caption
  101.        form input select option textarea
  102.            object applet param
  103.            map area
  104.            frame frameset noframe
  105.       );
  106.  
  107. my @code;
  108. for (@TAGS) {
  109.     push(@code, "sub $_ { _elem('$_', \@_); }\n");
  110.     push(@EXPORT, $_);
  111. }
  112. eval join('', @code);
  113. if ($@) {
  114.     die $@;
  115. }
  116.  
  117. sub _elem
  118. {
  119.     my $tag = shift;
  120.     my $attributes;
  121.     if (@_ and defined $_[0] and ref($_[0]) eq "HASH") {
  122.     $attributes = shift;
  123.     }
  124.     my $elem = HTML::Element->new( $tag, %$attributes );
  125.     $elem->push_content(@_);
  126.     $elem;
  127. }
  128.  
  129. 1;
  130.