I want to write a sub so I can use it like this:-------------------------------- mysub (a => 1, b => 2, c => 3) { # ...CODE... }; --------------------------------
Well, you can't do exactly that. The perl parser as it stands already gets confused between what is supposed to be a value and what is supposed to be interpreted, and I think handling the above case would cause a massive amount of headaches for whoever was brave enough to try adding support for it.
But you can, if you are adventurous (or crazy), try and do something like that using a combination of attributes, prototyping, and source filters. It's a Saturday, and I am either adventurous or crazy depending on who you ask, so I gave it a shot. :)
It's not perfect, but perhaps it will give you a good place to start from if you really want to delve into it.
Package, example script and output is attached. Cheers, Mike Gillis
package htmlAsPerl;
# example of how to do crazy things with
# Filter::Simple, attributes, and the (&) prototype.
#
# use/copy/modify/distribute as you like.
#
use warnings;
use strict;
use base 'Exporter';
use Filter::Simple;
my @ELEMENTS = qw(
A ABBR ACRONYM ADDRESS APPLET AREA B BASE BASEFONT BDO BIG BLOCKQUOTE
BODY BR BUTTON CAPTION CENTER CITE CODE COL COLGROUP DD DEL DFN DIR DIV
DL DT EM FIELDSET FONT FORM FRAME FRAMESET H1 H2 H3 H4 H5 H6 HEAD HR HTML
I IFRAME IMG INPUT INS ISINDEX KBD LABEL LEGEND LI LINK MAP MENU META
NOFRAMES NOSCRIPT OBJECT OL OPTGROUP OPTION P PARAM PRE Q S SAMP SCRIPT
SELECT SMALL SPAN STRIKE STRONG STYLE SUB SUP TABLE TBODY TD TEXTAREA
TFOOT TH THEAD TITLE TR TT U UL VAR
);
our @EXPORT = ("MODIFY_CODE_ATTRIBUTES", @ELEMENTS);
my $ELEMENT_RE = join '|', @ELEMENTS;
my $INDENT = 4; # spaces per nesting level
FILTER_ONLY
code => sub {
s/($ELEMENT_RE)\s*:/$1 sub :/g;
};
my %attr_cache;
my $spacedepth = 0;
sub MODIFY_CODE_ATTRIBUTES {
my ($pkg, $code, @attrs) = @_;
my @strings;
foreach (@attrs) {
/^([^(]+) (?: \( (.*) \) )?$/x;
push @strings, defined($2) ? "$1=$2" : $1;
}
my $attr_string = join ' ', @strings;
$attr_cache{$code} = $attr_string;
return ();
}
sub print_indented (@) {
my $spaces = " " x ($INDENT * $spacedepth);
print $spaces, @_;
}
sub element {
my ($name, $content) = @_;
my $attr_string;
if (defined($content)) {
$attr_string = delete $attr_cache{$content};
if (defined($attr_string)) {
print_indented "<$name $attr_string>\n";
}
else {
print_indented "<$name>\n";
}
$spacedepth++;
$content = &$content;
print_indented $content, "\n" if $content;
$spacedepth--;
print_indented "</$name>\n";
}
else {
print_indented "<$name>$_</$name>\n";
}
# return 0 to evaluate as false in 'if $content'
return 0;
}
# it would be really nice if we could do all of this
# automatically with @ELEMENTS, but it turns out that
# prototypes are a compile-time-only thing, so.......
sub A (;&) { element("A" , $_[0]); }
sub ABBR (;&) { element("ABBR" , $_[0]); }
sub ACRONYM (;&) { element("ACRONYM" , $_[0]); }
sub ADDRESS (;&) { element("ADDRESS" , $_[0]); }
sub APPLET (;&) { element("APPLET" , $_[0]); }
sub AREA (;&) { element("AREA" , $_[0]); }
sub B (;&) { element("B" , $_[0]); }
sub BASE (;&) { element("BASE" , $_[0]); }
sub BASEFONT (;&) { element("BASEFONT" , $_[0]); }
sub BDO (;&) { element("BDO" , $_[0]); }
sub BIG (;&) { element("BIG" , $_[0]); }
sub BLOCKQUOTE (;&) { element("BLOCKQUOTE", $_[0]); }
sub BODY (;&) { element("BODY" , $_[0]); }
sub BR (;&) { element("BR" , $_[0]); }
sub BUTTON (;&) { element("BUTTON" , $_[0]); }
sub CAPTION (;&) { element("CAPTION" , $_[0]); }
sub CENTER (;&) { element("CENTER" , $_[0]); }
sub CITE (;&) { element("CITE" , $_[0]); }
sub CODE (;&) { element("CODE" , $_[0]); }
sub COL (;&) { element("COL" , $_[0]); }
sub COLGROUP (;&) { element("COLGROUP" , $_[0]); }
sub DD (;&) { element("DD" , $_[0]); }
sub DEL (;&) { element("DEL" , $_[0]); }
sub DFN (;&) { element("DFN" , $_[0]); }
sub DIR (;&) { element("DIR" , $_[0]); }
sub DIV (;&) { element("DIV" , $_[0]); }
sub DL (;&) { element("DL" , $_[0]); }
sub DT (;&) { element("DT" , $_[0]); }
sub EM (;&) { element("EM" , $_[0]); }
sub FIELDSET (;&) { element("FIELDSET" , $_[0]); }
sub FONT (;&) { element("FONT" , $_[0]); }
sub FORM (;&) { element("FORM" , $_[0]); }
sub FRAME (;&) { element("FRAME" , $_[0]); }
sub FRAMESET (;&) { element("FRAMESET" , $_[0]); }
sub H1 (;&) { element("H1" , $_[0]); }
sub H2 (;&) { element("H2" , $_[0]); }
sub H3 (;&) { element("H3" , $_[0]); }
sub H4 (;&) { element("H4" , $_[0]); }
sub H5 (;&) { element("H5" , $_[0]); }
sub H6 (;&) { element("H6" , $_[0]); }
sub HEAD (;&) { element("HEAD" , $_[0]); }
sub HR (;&) { element("HR" , $_[0]); }
sub HTML (;&) { element("HTML" , $_[0]); }
sub I (;&) { element("I" , $_[0]); }
sub IFRAME (;&) { element("IFRAME" , $_[0]); }
sub IMG (;&) { element("IMG" , $_[0]); }
sub INPUT (;&) { element("INPUT" , $_[0]); }
sub INS (;&) { element("INS" , $_[0]); }
sub ISINDEX (;&) { element("ISINDEX" , $_[0]); }
sub KBD (;&) { element("KBD" , $_[0]); }
sub LABEL (;&) { element("LABEL" , $_[0]); }
sub LEGEND (;&) { element("LEGEND" , $_[0]); }
sub LI (;&) { element("LI" , $_[0]); }
sub LINK (;&) { element("LINK" , $_[0]); }
sub MAP (;&) { element("MAP" , $_[0]); }
sub MENU (;&) { element("MENU" , $_[0]); }
sub META (;&) { element("META" , $_[0]); }
sub NOFRAMES (;&) { element("NOFRAMES" , $_[0]); }
sub NOSCRIPT (;&) { element("NOSCRIPT" , $_[0]); }
sub OBJECT (;&) { element("OBJECT" , $_[0]); }
sub OL (;&) { element("OL" , $_[0]); }
sub OPTGROUP (;&) { element("OPTGROUP" , $_[0]); }
sub OPTION (;&) { element("OPTION" , $_[0]); }
sub P (;&) { element("P" , $_[0]); }
sub PARAM (;&) { element("PARAM" , $_[0]); }
sub PRE (;&) { element("PRE" , $_[0]); }
sub Q (;&) { element("Q" , $_[0]); }
sub S (;&) { element("S" , $_[0]); }
sub SAMP (;&) { element("SAMP" , $_[0]); }
sub SCRIPT (;&) { element("SCRIPT" , $_[0]); }
sub SELECT (;&) { element("SELECT" , $_[0]); }
sub SMALL (;&) { element("SMALL" , $_[0]); }
sub SPAN (;&) { element("SPAN" , $_[0]); }
sub STRIKE (;&) { element("STRIKE" , $_[0]); }
sub STRONG (;&) { element("STRONG" , $_[0]); }
sub STYLE (;&) { element("STYLE" , $_[0]); }
sub SUB (;&) { element("SUB" , $_[0]); }
sub SUP (;&) { element("SUP" , $_[0]); }
sub TABLE (;&) { element("TABLE" , $_[0]); }
sub TBODY (;&) { element("TBODY" , $_[0]); }
sub TD (;&) { element("TD" , $_[0]); }
sub TEXTAREA (;&) { element("TEXTAREA" , $_[0]); }
sub TFOOT (;&) { element("TFOOT" , $_[0]); }
sub TH (;&) { element("TH" , $_[0]); }
sub THEAD (;&) { element("THEAD" , $_[0]); }
sub TITLE (;&) { element("TITLE" , $_[0]); }
sub TR (;&) { element("TR" , $_[0]); }
sub TT (;&) { element("TT" , $_[0]); }
sub U (;&) { element("U" , $_[0]); }
sub UL (;&) { element("UL" , $_[0]); }
sub VAR (;&) { element("VAR" , $_[0]); }
1;
#!/usr/bin/perl
# example usage for htmlAsPerl.pm
use strict;
use warnings;
use lib '.';
use htmlAsPerl;
P { "This is a paragraph." };
P : style("font-weight: bold") {
"This is a paragraph with attributes."
};
DIV { SPAN { EM foreach qw($_ is used if there's no code) } };
TABLE : border(0) : cellpadding(4) {
TR {
TD : width(31) {
"cell 1"
};
TD : valign("top") {
"cell 2"
};
};
TR {
TD {
join (' ', qw(executing code on), $^O);
};
TD : class("lastCell") {
"last cell"
};
};
}
output
Description: Binary data
_______________________________________________ ActivePerl mailing list [email protected] To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
