1package Math::SymbolicX::ParserExtensionFactory; 2 3use 5.006; 4use strict; 5use warnings; 6use Carp; 7use Math::Symbolic; 8use Text::Balanced; 9 10our $BeenUsedBefore = {}; 11our $Functions = {}; 12our $Order = []; 13our $RegularExpression = qr/(?!)/; 14 15our $VERSION = '3.02'; 16 17sub import { 18 my $package = shift; 19 croak("Uneven number of arguments in usage of " 20 . "Math::SymbolicX::ParserExtensionFactory") 21 if @_ % 2; 22 23 my %args = @_; 24 25 _extend_parser(); 26 27 foreach my $key ( keys %args ) { 28 croak("Invalid keys => value pairs as arguments in usage of " 29 . "Math::SymbolicX::ParserExtensionFactory") 30 if not ref( $args{$key} ) eq 'CODE'; 31 if ( not exists $Functions->{$key} ) { 32 push @$Order, $key; 33 } 34 $Functions->{$key} = $args{$key}; 35 } 36 37 $RegularExpression = _regenerate_regex($Order); 38 39 return (); 40} 41 42sub _extend_parser { 43 44 my $parser = shift; 45 $parser = $Math::Symbolic::Parser if not defined $parser; 46 47 # make sure there is a parser 48 if (not defined $parser) { 49 $parser = $Math::Symbolic::Parser = Math::Symbolic::Parser->new(); 50 } 51 52 if ( not exists $BeenUsedBefore->{"$parser"} ) { 53 if ($parser->isa('Parse::RecDescent')) { 54 _extend_parser_recdescent($parser) 55 } 56 elsif ($parser->isa('Math::Symbolic::Parser::Yapp')) { 57 _extend_parser_yapp($parser); 58 } 59 else { 60 die "Unsupported parser type!"; 61 } 62 $BeenUsedBefore->{"$parser"} = 1; 63 } 64} 65 66sub _extend_parser_yapp { 67 # This is a no-op since ::Parser::Yapp has built-in support for 68 # ::ParserExtensionFactory. This would probably not be possible 69 # otherwise. 70 return(1); 71} 72 73sub _extend_parser_recdescent { 74 my $parser = shift; 75 $parser->{__PRIV_EXT_FUNC_REGEX} = qr/(?!)/; 76 $parser->Extend(<<'EXTENSION'); 77function: /$thisparser->{__PRIV_EXT_FUNC_REGEX}\s*(?=\()/ {extract_bracketed($text, '(')} 78 { 79 warn 'function_private_msx_parser_extension_factory ' 80 if $Math::Symbolic::Parser::DEBUG; 81 my $function = $item[1]; 82 $function =~ s/\s+$//; 83 my $argstring = substr($item[2], 1, length($item[2])-2); 84 die "Invalid extension function and/or arguments '$function$item[2]' ". 85 "(Math::SymbolicX::ParserExtensionFactory)" 86 if not exists 87 $thisparser->{__PRIV_EXT_FUNCTIONS}{$function}; 88 my $result = $thisparser->{__PRIV_EXT_FUNCTIONS}{$function}->($argstring); 89 die "Invalid result of extension function application " 90 ."('$item[1]($argstring)'). Also refer to the " 91 ."Math::SymbolicX::ParserExtensionFactory manpage." 92 if ref($result) !~ /^Math::Symbolic/; 93 $return = $result; 94 } 95 96 | /$Math::SymbolicX::ParserExtensionFactory::RegularExpression\s*(?=\()/ {extract_bracketed($text, '(')} 97 { 98 warn 'function_global_msx_parser_extension_factory ' 99 if $Math::Symbolic::Parser::DEBUG; 100 my $function = $item[1]; 101 $function =~ s/\s+$//; 102 my $argstring = substr($item[2], 1, length($item[2])-2); 103 die "Invalid extension function and/or arguments '$function$item[2]' ". 104 "(Math::SymbolicX::ParserExtensionFactory)" 105 if not exists 106 $Math::SymbolicX::ParserExtensionFactory::Functions->{$function}; 107 my $result = $Math::SymbolicX::ParserExtensionFactory::Functions->{$function}->($argstring); 108 die "Invalid result of extension function application " 109 ."('$item[1]($argstring)'). Also refer to the " 110 ."Math::SymbolicX::ParserExtensionFactory manpage." 111 if ref($result) !~ /^Math::Symbolic/; 112 $return = $result; 113 } 114 115EXTENSION 116 return(1); 117} 118 119sub _regenerate_regex { 120 my @arrays = @_; 121 my $string = join '|', map {"\Q$_\E"} map {@$_} @arrays; 122 return qr/(?!)/ if $string eq ''; 123 return qr/(?:$string)/; 124} 125 126sub add_private_functions { 127 shift if not ref $_[0] and $_[0] eq __PACKAGE__; 128 my $parser = shift; 129 croak("Invalid number of arguments!") if @_ % 2; 130 131 $parser->{__PRIV_EXT_FUNCTIONS} ||= {}; 132 $parser->{__PRIV_EXT_FUNC_ORDER} ||= []; 133 while (@_) { 134 my $name = shift; 135 push @{$parser->{__PRIV_EXT_FUNC_ORDER}}, $name; 136 $parser->{__PRIV_EXT_FUNCTIONS}{$name} = shift; 137 } 138 139 $parser->{__PRIV_EXT_FUNC_REGEX} = _regenerate_regex( $parser->{__PRIV_EXT_FUNC_ORDER} ); 140} 141 1421; 143__END__ 144 145=head1 NAME 146 147Math::SymbolicX::ParserExtensionFactory - Generate parser extensions 148 149=head1 SYNOPSIS 150 151 use Math::Symbolic qw/parse_from_string/; 152 153 # This will extend all parser objects in your program: 154 use Math::SymbolicX::ParserExtensionFactory ( 155 156 functionname => sub { 157 my $argumentstring = shift; 158 my $result = construct_some_math_symbolic_tree( $argumentstring ); 159 return $result; 160 }, 161 162 anotherfunction => sub { 163 ... 164 }, 165 166 ); 167 168 # ... 169 # Later in your code 170 171 my $formula = parse_from_string('variable * 4 * functionname(someargument)'); 172 173 # use $formula as a Math::Symbolic object. 174 # Refer to Math::SymbolicX::BigNum (arbitrary precision arithmetic 175 # support through the Math::Big* modules) or to 176 # Math::SymbolicX::ComplexNumbers (complex number support) for examples. 177 178 179 # Alternative: modify a single parser object only: 180 my $parser = Math::Symbolic::Parser->new(); 181 182 Math::SymbolicX::ParserExtensionFactory->add_private_functions( 183 $parser, 184 fun_function => sub {...}, 185 my_function => sub {...}, 186 ... 187 ); 188 189=head1 DESCRIPTION 190 191This module provides a simple way to extend the Math::Symbolic parser with 192arbitrary functions that return any valid Math::Symbolic tree. 193The return value of the function call is 194inserted into the complete parse tree at the point at which the function 195call is parsed. Familiarity with the Math::Symbolic module will be 196assumed throughout the documentation. 197 198This module is not object oriented. It does not export anything. You should 199not call any subroutines directly nor should you modify any class data 200directly. The complete interface is the call to 201C<use Math::SymbolicX::ParserExtensionFactory> and its arguments. The reason 202for the long module name is that you should not have to call it multiple times 203in your code because it modifies the parser for good. It is intended to be 204a pain to type. :-) 205 206The aim of the module is to allow for hooks into the parser without modifying 207the parser yourself because that requires rather in-depth knowledge of the 208module code. By specifying key => value pairs of function names and 209function implementations (code references) as arguments to the use() call 210of the module, this module extends the parser that is stored in the 211C<$Math::Symbolic::Parser> variable with the specified functions and whenever 212"C<yourfunction(any argument string with balanced parenthesis)>" occurs 213in the code, the subroutine reference is called with the argument string as 214argument. 215 216The subroutine is expected to return any Math::Symbolic tree. That means, 217as of version 0.506 of Math::Symbolic, a Math::Symbolic::Operator, a 218Math::Symbolic::Variable, 219or a Math::Symbolic::Constant object. The returned object will be incorporated 220into the Math::Symbolic tree that results from the parse at the exact position 221at which the custom function call was parsed. 222 223Please note that the usage of this module will be quite slow at compile time 224because it has to regenerate the complete Math::Symbolic parser the first 225time you use this module in your code. The run time performance penalty 226should be low, however. 227 228=head1 FUNCTIONS 229 230=head2 add_private_functions 231 232Callable as class method or function. First argument must be the parser 233object to modify (either a Parse::RecDescent or a Parse::Yapp based 234Math::Symbolic parser), followed by key/value pairs of function names 235and code refs (implementations). 236 237Modifies only the parser passed in as first argument. For an example, 238see synopsis above. 239 240=head1 CAVEATS 241 242Since version 2.00 of this module, the old, broken parsing of the argument 243string which would fail on nested, unescaped parenthesis was replaced 244by a better routine which will correctly parse nested pairs of parenthesis. 245 246On the flip side, if the argument string contains unmatched parenthesis, 247the parse will fail. Examples: 248 249 "myfunction(foo(bar)" # fails because missing closing parenthesis 250 251Escaping of parenthesis in the argument string B<is no longer supported>. 252 253=head1 AUTHOR 254 255Copyright (C) 2003-2009 Steffen Mueller 256 257This library is free software; you can redistribute it and/or modify 258it under the same terms as Perl itself. 259 260You may contact the author at symbolic-module at steffen-mueller dot net 261 262Please send feedback, bug reports, and support requests to the Math::Symbolic 263support mailing list: 264math-symbolic-support at lists dot sourceforge dot net. Please 265consider letting us know how you use Math::Symbolic. Thank you. 266 267If you're interested in helping with the development or extending the 268module's functionality, please contact the developers' mailing list: 269math-symbolic-develop at lists dot sourceforge dot net. 270 271=head1 SEE ALSO 272 273New versions of this module can be found on 274http://steffen-mueller.net or CPAN. 275 276Also have a look at L<Math::Symbolic>, 277and at L<Math::Symbolic::Parser> 278 279Refer to L<Math::SymbolicX::BigNum> (arbitrary precision 280arithmetic support through the Math::Big* modules) or to 281L<Math::SymbolicX::ComplexNumbers> (complex number support) for examples. 282 283=cut 284