--- /dev/null
+.\" Automatically generated by Pod::Man 2.22 (Pod::Simple 3.10)
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings. \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote. \*(C+ will
+.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
+.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
+.\" nothing in troff, for use with C<>.
+.tr \(*W-
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+. ds -- \(*W-
+. ds PI pi
+. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
+. ds L" ""
+. ds R" ""
+. ds C` ""
+. ds C' ""
+'br\}
+.el\{\
+. ds -- \|\(em\|
+. ds PI \(*p
+. ds L" ``
+. ds R" ''
+'br\}
+.\"
+.\" Escape single quotes in literal strings from groff's Unicode transform.
+.ie \n(.g .ds Aq \(aq
+.el .ds Aq '
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
+.\" entries marked with X<> in POD. Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.ie \nF \{\
+. de IX
+. tm Index:\\$1\t\\n%\t"\\$2"
+..
+. nr % 0
+. rr F
+.\}
+.el \{\
+. de IX
+..
+.\}
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear. Run. Save yourself. No user-serviceable parts.
+. \" fudge factors for nroff and troff
+.if n \{\
+. ds #H 0
+. ds #V .8m
+. ds #F .3m
+. ds #[ \f1
+. ds #] \fP
+.\}
+.if t \{\
+. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+. ds #V .6m
+. ds #F 0
+. ds #[ \&
+. ds #] \&
+.\}
+. \" simple accents for nroff and troff
+.if n \{\
+. ds ' \&
+. ds ` \&
+. ds ^ \&
+. ds , \&
+. ds ~ ~
+. ds /
+.\}
+.if t \{\
+. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+. \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+. \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+. \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+. ds : e
+. ds 8 ss
+. ds o a
+. ds d- d\h'-1'\(ga
+. ds D- D\h'-1'\(hy
+. ds th \o'bp'
+. ds Th \o'LP'
+. ds ae ae
+. ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "Devel::Declare 3"
+.TH Devel::Declare 3 "2009-08-14" "perl v5.8.7" "User Contributed Perl Documentation"
+.\" For nroff, turn off justification. Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.if n .ad l
+.nh
+.SH "NAME"
+Devel::Declare \- Adding keywords to perl, in perl
+.SH "SYNOPSIS"
+.IX Header "SYNOPSIS"
+.Vb 4
+\& use Method::Signatures;
+\& # or ...
+\& use MooseX::Declare;
+\& # etc.
+\&
+\& # Use some new and exciting syntax like:
+\& method hello (Str :$who, Int :$age where { $_ > 0 }) {
+\& $self\->say("Hello ${who}, I am ${age} years old!");
+\& }
+.Ve
+.SH "DESCRIPTION"
+.IX Header "DESCRIPTION"
+Devel::Declare can install subroutines called declarators which locally take
+over Perl's parser, allowing the creation of new syntax.
+.PP
+This document describes how to create a simple declarator.
+.SH "USAGE"
+.IX Header "USAGE"
+We'll demonstrate the usage of \f(CW\*(C`Devel::Declare\*(C'\fR with a motivating example: a new
+\&\f(CW\*(C`method\*(C'\fR keyword, which acts like the builtin \f(CW\*(C`sub\*(C'\fR, but automatically unpacks
+\&\f(CW$self\fR and the other arguments.
+.PP
+.Vb 2
+\& package My::Methods;
+\& use Devel::Declare;
+.Ve
+.ie n .SS "Creating a declarator with ""setup_for"""
+.el .SS "Creating a declarator with \f(CWsetup_for\fP"
+.IX Subsection "Creating a declarator with setup_for"
+You will typically create
+.PP
+.Vb 3
+\& sub import {
+\& my $class = shift;
+\& my $caller = caller;
+\&
+\& Devel::Declare\->setup_for(
+\& $caller,
+\& { method => { const => \e&parser } }
+\& );
+\& no strict \*(Aqrefs\*(Aq;
+\& *{$caller.\*(Aq::method\*(Aq} = sub (&) {};
+\& }
+.Ve
+.PP
+Starting from the end of this import routine, you'll see that we're creating a
+subroutine called \f(CW\*(C`method\*(C'\fR in the caller's namespace. Yes, that's just a normal
+subroutine, and it does nothing at all (yet!) Note the prototype \f(CW\*(C`(&)\*(C'\fR which means
+that the caller would call it like so:
+.PP
+.Vb 4
+\& method {
+\& my ($self, $arg1, $arg2) = @_;
+\& ...
+\& }
+.Ve
+.PP
+However we want to be able to call it like this
+.PP
+.Vb 3
+\& method foo ($arg1, $arg2) {
+\& ...
+\& }
+.Ve
+.PP
+That's why we call \f(CW\*(C`setup_for\*(C'\fR above, to register the declarator 'method' with a custom
+parser, as per the next section. It acts on an optype, usually \f(CW\*(Aqconst\*(Aq\fR as above.
+(Other valid values are \f(CW\*(Aqcheck\*(Aq\fR and \f(CW\*(Aqrv2cv\*(Aq\fR).
+.PP
+For a simpler way to install new methods, see also Devel::Declare::MethodInstaller::Simple
+.SS "Writing a parser subroutine"
+.IX Subsection "Writing a parser subroutine"
+This subroutine is called at \fIcompilation\fR time, and allows you to read the custom
+syntaxes that we want (in a syntax that may or may not be valid core Perl 5) and
+munge it so that the result will be parsed by the \f(CW\*(C`perl\*(C'\fR compiler.
+.PP
+For this example, we're defining some globals for convenience:
+.PP
+.Vb 1
+\& our ($Declarator, $Offset);
+.Ve
+.PP
+Then we define a parser subroutine to handle our declarator. We'll look at this in
+a few chunks.
+.PP
+.Vb 2
+\& sub parser {
+\& local ($Declarator, $Offset) = @_;
+.Ve
+.PP
+\&\f(CW\*(C`Devel::Declare\*(C'\fR provides some very low level utility methods to parse character
+strings. We'll define some useful higher level routines below for convenience,
+and we can use these to parse the various elements in our new syntax.
+.PP
+Notice how our parser subroutine is invoked at compile time,
+when the \f(CW\*(C`perl\*(C'\fR parser is pointed just \fIbefore\fR the declarator name.
+.PP
+.Vb 3
+\& skip_declarator; # step past \*(Aqmethod\*(Aq
+\& my $name = strip_name; # strip out the name \*(Aqfoo\*(Aq, if present
+\& my $proto = strip_proto; # strip out the prototype \*(Aq($arg1, $arg2)\*(Aq, if present
+.Ve
+.PP
+Now we can prepare some code to 'inject' into the new subroutine. For example we
+might want the method as above to have \f(CW\*(C`my ($self, $arg1, $arg2) = @_\*(C'\fR injected at
+the beginning of it. We also do some clever stuff with scopes that we'll look
+at shortly.
+.PP
+.Vb 5
+\& my $inject = make_proto_unwrap($proto);
+\& if (defined $name) {
+\& $inject = scope_injector_call().$inject;
+\& }
+\& inject_if_block($inject);
+.Ve
+.PP
+We've now managed to change \f(CW\*(C`method ($arg1, $arg2) { ... }\*(C'\fR into \f(CW\*(C`method {
+injected_code; ... }\*(C'\fR. This will compile... but we've lost the name of the
+method!
+.PP
+In a cute (or horrifying, depending on your perspective) trick, we temporarily
+change the definition of the subroutine \f(CW\*(C`method\*(C'\fR itself, to specialise it with
+the \f(CW$name\fR we stripped, so that it assigns the code block to that name.
+.PP
+Even though the \fInext\fR time \f(CW\*(C`method\*(C'\fR is compiled, it will be
+redefined again, \f(CW\*(C`perl\*(C'\fR caches these definitions in its parse
+tree, so we'll always get the right one!
+.PP
+Note that we also handle the case where there was no name, allowing
+an anonymous method analogous to an anonymous subroutine.
+.PP
+.Vb 8
+\& if (defined $name) {
+\& $name = join(\*(Aq::\*(Aq, Devel::Declare::get_curstash_name(), $name)
+\& unless ($name =~ /::/);
+\& shadow(sub (&) { no strict \*(Aqrefs\*(Aq; *{$name} = shift; });
+\& } else {
+\& shadow(sub (&) { shift });
+\& }
+\& }
+.Ve
+.SS "Parser utilities in detail"
+.IX Subsection "Parser utilities in detail"
+For simplicity, we're using global variables like \f(CW$Offset\fR in these examples.
+You may prefer to look at Devel::Declare::Context::Simple, which
+encapsulates the context much more cleanly.
+.PP
+\fI\f(CI\*(C`skip_declarator\*(C'\fI\fR
+.IX Subsection "skip_declarator"
+.PP
+This simple parser just moves across a 'token'. The common case is
+to skip the declarator, i.e. to move to the end of the string
+\&'method' and before the prototype and code block.
+.PP
+.Vb 3
+\& sub skip_declarator {
+\& $Offset += Devel::Declare::toke_move_past_token($Offset);
+\& }
+.Ve
+.PP
+\f(CW\*(C`toke_move_past_token\*(C'\fR
+.IX Subsection "toke_move_past_token"
+.PP
+This builtin parser simply moves past a 'token' (matching \f(CW\*(C`/[a\-zA\-Z_]\ew*/\*(C'\fR)
+It takes an offset into the source document, and skips past the token.
+It returns the number of characters skipped.
+.PP
+\fI\f(CI\*(C`strip_name\*(C'\fI\fR
+.IX Subsection "strip_name"
+.PP
+This parser skips any whitespace, then scans the next word (again matching a
+\&'token'). We can then analyse the current line, and manipulate it (using pure
+Perl). In this case we take the name of the method out, and return it.
+.PP
+.Vb 11
+\& sub strip_name {
+\& skipspace;
+\& if (my $len = Devel::Declare::toke_scan_word($Offset, 1)) {
+\& my $linestr = Devel::Declare::get_linestr();
+\& my $name = substr($linestr, $Offset, $len);
+\& substr($linestr, $Offset, $len) = \*(Aq\*(Aq;
+\& Devel::Declare::set_linestr($linestr);
+\& return $name;
+\& }
+\& return;
+\& }
+.Ve
+.PP
+\f(CW\*(C`toke_scan_word\*(C'\fR
+.IX Subsection "toke_scan_word"
+.PP
+This builtin parser, given an offset into the source document,
+matches a 'token' as above but does not skip. It returns the
+length of the token matched, if any.
+.PP
+\f(CW\*(C`get_linestr\*(C'\fR
+.IX Subsection "get_linestr"
+.PP
+This builtin returns the full text of the current line of the source document.
+.PP
+\f(CW\*(C`set_linestr\*(C'\fR
+.IX Subsection "set_linestr"
+.PP
+This builtin sets the full text of the current line of the source document.
+.PP
+\fI\f(CI\*(C`skipspace\*(C'\fI\fR
+.IX Subsection "skipspace"
+.PP
+This parser skips whitsepace.
+.PP
+.Vb 3
+\& sub skipspace {
+\& $Offset += Devel::Declare::toke_skipspace($Offset);
+\& }
+.Ve
+.PP
+\f(CW\*(C`toke_skipspace\*(C'\fR
+.IX Subsection "toke_skipspace"
+.PP
+This builtin parser, given an offset into the source document,
+skips over any whitespace, and returns the number of characters
+skipped.
+.PP
+\fI\f(CI\*(C`strip_proto\*(C'\fI\fR
+.IX Subsection "strip_proto"
+.PP
+This is a more complex parser that checks if it's found something that
+starts with \f(CW\*(Aq(\*(Aq\fR and returns everything till the matching \f(CW\*(Aq)\*(Aq\fR.
+.PP
+.Vb 2
+\& sub strip_proto {
+\& skipspace;
+\&
+\& my $linestr = Devel::Declare::get_linestr();
+\& if (substr($linestr, $Offset, 1) eq \*(Aq(\*(Aq) {
+\& my $length = Devel::Declare::toke_scan_str($Offset);
+\& my $proto = Devel::Declare::get_lex_stuff();
+\& Devel::Declare::clear_lex_stuff();
+\& $linestr = Devel::Declare::get_linestr();
+\& substr($linestr, $Offset, $length) = \*(Aq\*(Aq;
+\& Devel::Declare::set_linestr($linestr);
+\& return $proto;
+\& }
+\& return;
+\& }
+.Ve
+.PP
+\f(CW\*(C`toke_scan_str\*(C'\fR
+.IX Subsection "toke_scan_str"
+.PP
+This builtin parser uses Perl's own parsing routines to match a \*(L"stringlike\*(R"
+expression. Handily, this includes bracketed expressions (just think about
+things like \f(CW\*(C`q(this is a quote)\*(C'\fR).
+.PP
+Also it Does The Right Thing with nested delimiters (like \f(CW\*(C`q(this (is (a) quote))\*(C'\fR).
+.PP
+It returns the length of the expression matched. Use \f(CW\*(C`get_lex_stuff\*(C'\fR to
+get the actual matched text.
+.PP
+\f(CW\*(C`get_lex_stuff\*(C'\fR
+.IX Subsection "get_lex_stuff"
+.PP
+This builtin returns what was matched by \f(CW\*(C`toke_scan_str\*(C'\fR. To avoid segfaults,
+you should call \f(CW\*(C`clear_lex_stuff\*(C'\fR immediately afterwards.
+.SS "Munging the subroutine"
+.IX Subsection "Munging the subroutine"
+Let's look at what we need to do in detail.
+.PP
+\fI\f(CI\*(C`make_proto_unwrap\*(C'\fI\fR
+.IX Subsection "make_proto_unwrap"
+.PP
+We may have defined our method in different ways, which will result
+in a different value for our prototype, as parsed above. For example:
+.PP
+.Vb 3
+\& method foo { # undefined
+\& method foo () { # \*(Aq\*(Aq
+\& method foo ($arg1) { # \*(Aq$arg1\*(Aq
+.Ve
+.PP
+We deal with them as follows, and return the appropriate \f(CW\*(C`my ($self, ...) = @_;\*(C'\fR
+string.
+.PP
+.Vb 11
+\& sub make_proto_unwrap {
+\& my ($proto) = @_;
+\& my $inject = \*(Aqmy ($self\*(Aq;
+\& if (defined $proto) {
+\& $inject .= ", $proto" if length($proto);
+\& $inject .= \*(Aq) = @_; \*(Aq;
+\& } else {
+\& $inject .= \*(Aq) = shift;\*(Aq;
+\& }
+\& return $inject;
+\& }
+.Ve
+.PP
+\fI\f(CI\*(C`inject_if_block\*(C'\fI\fR
+.IX Subsection "inject_if_block"
+.PP
+Now we need to inject it after the opening \f(CW\*(Aq{\*(Aq\fR of the method body.
+We can do this with the building blocks we defined above like \f(CW\*(C`skipspace\*(C'\fR
+and \f(CW\*(C`get_linestr\*(C'\fR.
+.PP
+.Vb 9
+\& sub inject_if_block {
+\& my $inject = shift;
+\& skipspace;
+\& my $linestr = Devel::Declare::get_linestr;
+\& if (substr($linestr, $Offset, 1) eq \*(Aq{\*(Aq) {
+\& substr($linestr, $Offset+1, 0) = $inject;
+\& Devel::Declare::set_linestr($linestr);
+\& }
+\& }
+.Ve
+.PP
+\fI\f(CI\*(C`scope_injector_call\*(C'\fI\fR
+.IX Subsection "scope_injector_call"
+.PP
+We want to be able to handle both named and anonymous methods. i.e.
+.PP
+.Vb 2
+\& method foo () { ... }
+\& my $meth = method () { ... };
+.Ve
+.PP
+These will then get rewritten as
+.PP
+.Vb 2
+\& method { ... }
+\& my $meth = method { ... };
+.Ve
+.PP
+where 'method' is a subroutine that takes a code block. Spot the problem?
+The first one doesn't have a semicolon at the end of it! Unlike 'sub' which
+is a builtin, this is just a normal statement, so we need to terminate it.
+Luckily, using \f(CW\*(C`B::Hooks::EndOfScope\*(C'\fR, we can do this!
+.PP
+.Vb 1
+\& use B::Hooks::EndOfScope;
+.Ve
+.PP
+We'll add this to what gets 'injected' at the beginning of the method source.
+.PP
+.Vb 3
+\& sub scope_injector_call {
+\& return \*(Aq BEGIN { MethodHandlers::inject_scope }; \*(Aq;
+\& }
+.Ve
+.PP
+So at the beginning of every method, we are passing a callback that will get invoked
+at the \fIend\fR of the method's compilation... i.e. exactly then the closing \f(CW\*(Aq}\*(Aq\fR
+is compiled.
+.PP
+.Vb 8
+\& sub inject_scope {
+\& on_scope_end {
+\& my $linestr = Devel::Declare::get_linestr;
+\& my $offset = Devel::Declare::get_linestr_offset;
+\& substr($linestr, $offset, 0) = \*(Aq;\*(Aq;
+\& Devel::Declare::set_linestr($linestr);
+\& };
+\& }
+.Ve
+.SS "Shadowing each method."
+.IX Subsection "Shadowing each method."
+\fI\f(CI\*(C`shadow\*(C'\fI\fR
+.IX Subsection "shadow"
+.PP
+We override the current definition of 'method' using \f(CW\*(C`shadow\*(C'\fR.
+.PP
+.Vb 4
+\& sub shadow {
+\& my $pack = Devel::Declare::get_curstash_name;
+\& Devel::Declare::shadow_sub("${pack}::${Declarator}", $_[0]);
+\& }
+.Ve
+.PP
+For a named method we invoked like this:
+.PP
+.Vb 1
+\& shadow(sub (&) { no strict \*(Aqrefs\*(Aq; *{$name} = shift; });
+.Ve
+.PP
+So in the case of a \f(CW\*(C`method foo { ... }\*(C'\fR, this call would redefine \f(CW\*(C`method\*(C'\fR
+to be a subroutine that exports 'sub foo' as the (munged) contents of \f(CW\*(C`{...}\*(C'\fR.
+.PP
+The case of an anonymous method is also cute:
+.PP
+.Vb 1
+\& shadow(sub (&) { shift });
+.Ve
+.PP
+This means that
+.PP
+.Vb 1
+\& my $meth = method () { ... };
+.Ve
+.PP
+is rewritten with \f(CW\*(C`method\*(C'\fR taking the codeblock, and returning it as is to become
+the value of \f(CW$meth\fR.
+.PP
+\f(CW\*(C`get_curstash_name\*(C'\fR
+.IX Subsection "get_curstash_name"
+.PP
+This returns the package name \fIcurrently being compiled\fR.
+.PP
+\f(CW\*(C`shadow_sub\*(C'\fR
+.IX Subsection "shadow_sub"
+.PP
+Handles the details of redefining the subroutine.
+.SH "SEE ALSO"
+.IX Header "SEE ALSO"
+One of the best ways to learn \f(CW\*(C`Devel::Declare\*(C'\fR is still to look at
+modules that use it:
+.PP
+<http://cpants.perl.org/dist/used_by/Devel\-Declare>.
+.SH "AUTHORS"
+.IX Header "AUTHORS"
+Matt S Trout \- <mst@shadowcat.co.uk> \- original author
+.PP
+Company: http://www.shadowcat.co.uk/
+Blog: http://chainsawblues.vox.com/
+.PP
+Florian Ragwitz <rafl@debian.org> \- maintainer
+.PP
+osfameron <osfameron@cpan.org> \- first draft of documentation
+.SH "COPYRIGHT AND LICENSE"
+.IX Header "COPYRIGHT AND LICENSE"
+This library is free software under the same terms as perl itself
+.PP
+Copyright (c) 2007, 2008, 2009 Matt S Trout
+.PP
+Copyright (c) 2008, 2009 Florian Ragwitz
+.PP
+stolen_chunk_of_toke.c based on toke.c from the perl core, which is
+.PP
+Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
projects / catagits/Gitalist.git / blobdiff