PPIx::Regexp::Token::Reference - Represent a reference to a capture

PPIx-Regexp documentation Contained in the PPIx-Regexp distribution.

Index

Code Index:

NAME

Top

PPIx::Regexp::Token::Reference - Represent a reference to a capture

SYNOPSIS

Top

 use PPIx::Regexp::Dumper;
 PPIx::Regexp::Dumper->new( 'qr{\1}smx' )
     ->print();

INHERITANCE

Top

PPIx::Regexp::Token::Reference is a PPIx::Regexp::Token.

PPIx::Regexp::Token::Reference is the parent of PPIx::Regexp::Token::Backreference, PPIx::Regexp::Token::Condition and PPIx::Regexp::Token::Recursion.

DESCRIPTION

Top

This abstract class represents a reference to a capture buffer, either numbered or named. It should never be instantiated, but it provides a number of methods to its subclasses.

METHODS

Top

This class provides the following public methods. Methods not documented here are private, and unsupported in the sense that the author reserves the right to change or remove them without notice.

absolute

 print "The absolute reference is ", $ref->absolute(), "\n";

This method returns the absolute number of the capture buffer referred to. This is the same as number() for unsigned numeric references. If the reference is to a named buffer, undef is returned.

is_named

 $ref->is_named and print "named reference\n";

This method returns true if the reference is named rather than numbered.

is_relative

 $ref->is_relative()
     and print "relative numbered reference\n";

This method returns true if the reference is numbered and it is a relative number (i.e. if it is signed).

name

 print "The name is ", $ref->name(), "\n";

This method returns the name of the capture buffer referred to. In the case of a reference to a numbered capture (i.e. is_named returns false), this method returns undef.

number

 print "The number is ", $ref->number(), "\n";

This method returns the number of the capture buffer referred to. In the case of a reference to a named capture (i.e. is_named returns true), this method returns undef.

SUPPORT

Top

Support is by the author. Please file bug reports at http://rt.cpan.org, or in electronic mail to the author.

AUTHOR

Top

Thomas R. Wyant, III wyant at cpan dot org

COPYRIGHT AND LICENSE

Top

Copyright (C) 2009-2011 by Thomas R. Wyant, III

This program is free software; you can redistribute it and/or modify it under the same terms as Perl 5.10.0. For more details, see the full text of the licenses in the directory LICENSES.

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.

PPIx-Regexp documentation Contained in the PPIx-Regexp distribution. 
package PPIx::Regexp::Token::Reference;

use strict;
use warnings;

use base qw{ PPIx::Regexp::Token };

use Carp qw{ confess };
use List::Util qw{ first };

our $VERSION = '0.020';


sub absolute {
    my ( $self ) = @_;
    return $self->{absolute};
}


sub is_named {
    my ( $self ) = @_;
    return $self->{is_named};
}


sub is_relative {
    my ( $self ) = @_;
    return $self->{is_relative};
}


sub name {
    my ( $self ) = @_;
    return $self->{name};
}


sub number {
    my ( $self ) = @_;
    return $self->{number};
}

# Called by the lexer to record the capture number.
sub __PPIX_LEXER__record_capture_number {
    my ( $self, $number ) = @_;
    if ( ! exists $self->{absolute} && exists $self->{number}
	&& $self->{number} =~ m/ \A [-+] /smx ) {

	my $delta = $self->{number};
	$delta > 0 and --$delta;	# no -0 or +0.
	$self->{absolute} = $number + $delta;

    }
    return $number;
}

# Called after the token is manufactured. The calling sequence is
# $token->__PPIX_TOKEN__post_make( $tokenizer, $arg );
# For the sake of reblessing into this class, we are expected to deal
# with the situation where the optional argument is missing.
sub __PPIX_TOKEN__post_make {
    my ( $self, $tokenizer, $arg ) = @_;

    my $capture;
    if ( defined $arg ) {
	$tokenizer
	    and $capture = first { defined $_ } $tokenizer->capture();
	defined $capture or $capture = $arg->{capture};
    } else {
	my $content = $self->content();
	foreach ( $self->__PPIX_TOKEN__recognize() ) {
	    my ( $re, $a ) = @{ $_ };
	    $content =~ $re or next;
	    $arg = $a;
	    if ( exists $arg->{capture} ) {
		$capture = $arg->{capture};
	    } else {
		foreach my $inx ( 1 .. $#- ) {
		    defined $-[$inx] or next;
		    $capture = substr $content, $-[$inx], $+[$inx] - $-[$inx];
		    last;
		}
	    }
	    last;
	}
    }

    defined $capture
	or confess q{Programming error - reference '},
	    $self->content(), q{' of unknown form};

    foreach my $key ( keys %{ $arg } ) {
	$key eq 'capture' and next;
	$self->{$key} = $arg->{$key};
    }

    if ( $arg->{is_named} ) {
	$self->{absolute} = undef;
	$self->{is_relative} = undef;
	$self->{name} = $capture;
    } elsif ( $capture !~ m/ \A [-+] /smx ) {
	$self->{absolute} = $self->{number} = $capture;
	$self->{is_relative} = undef;
    } else {
	$self->{number} = $capture;
	$self->{is_relative} = 1;
    }

    return;
};


1;

__END__


# ex: set textwidth=72 :