क्या पर्ल में रेगेक्स बाध्यकारी ऑपरेटर `= ~` अधिभारित करने का कोई तरीका है?

Question

मैं एक छोटे से डीएसएल पर काम कर रहा हूं जो ओवरलोडेड मानों पर प्रयुक्त ऑपरेटरों को कैप्चर करने के लिए ओवरलोडिंग के लिए nomethod फ़ॉलबैक का उपयोग करता है। यह के कार्य के समान है जो overload के दस्तावेज़ में वर्णित है।

यह मानक तुलना ऑपरेटरों के लिए ठीक काम करता है, लेकिन निम्नलिखित पर विचार:

my $ret = $overloaded =~ /regex/; 

इस मामले में, nomethod$overloaded stringify को कहा जाता है, और उसके बाद से अधिक भार खो दिया है हो जाता है। मैंने एक बंधे हुए चर को वापस करने के बारे में सोचा, जो कम से कम मुझे मूल अधिभारित वस्तु के आसपास ले जाने देगा, लेकिन यह अभी भी रेगेक्स के निष्पादन के दौरान खो जाएगा।

तो, परम सवाल अगर वहाँ एक प्रतीकात्मक कैलकुलेटर की 'overload रों विचार का विस्तार करने के लिए regex बाध्यकारी ऑपरेटरों =~ और !~ शामिल करने के लिए किसी भी तरह से है, तो यह है कि इसके बाद के संस्करण कोड नमूना ($overloaded, qr/regex/, 0, '=~') या कुछ इसी तरह के साथ nomethod कहेंगे है?

मैंने स्मार्टमैच ऑपरेटर ~~ को ओवरलोड करने में भी संक्षेप में देखा लेकिन ऐसा लगता है कि यह चाल भी नहीं है (हमेशा अधिभार के बजाय रेगेक्स मिलान के लिए डिफ़ॉल्ट)।

संपादित करें: मैंने ~~ और अधिक देखा, और पाया कि my $ret = $overloaded ~~ q/regex/ स्मार्टमैचिंग नियमों के कारण काम करता है। बंद करें, लेकिन आदर्श समाधान नहीं है, और मैं इसे पूर्व 5.10 काम करना चाहता हूं, इसलिए मैं अन्य उत्तरों का स्वागत करता हूं।

Answer 1

मुझे लगता है कि डीएसएल source filters के साथ पर्ल में सबसे अच्छी तरह लिखे गए हैं। आप सचमुच कुछ भी कर सकते हैं जो आप चाहते हैं। ;-) आपके उदाहरण में, आप myfunc (FOO, BAR) के साथ FOO = ~ BAR को प्रतिस्थापित कर सकते हैं और मनमानी कोड चला सकते हैं।

यहाँ एक उदाहरण समाधान है:

# THE "MyLang" SOURCE FILTER 
package MyLang; 
use strict; 
use warnings; 
use Filter::Util::Call; 

sub import { 
    my ($type, @args) = @_; 
    my %p = @args; 
    no strict 'refs'; 
    my $caller = caller; 
    # Create the function to call 
    *{"${caller}::_mylang_defaultmethod"} = sub { 
     my ($a, $op, $b) = @_; 
     $p{nomethod}->($a, $b, 0, $op); 
    }; 
    my ($ref) = []; 
    filter_add(bless $ref); 
} 

sub filter { 
    my ($self) = @_; 
    my ($status); 
    if ($status = filter_read() > 0) { 
     $_ =~ s/([^=]+)(=~)([^;]+)/ _mylang_defaultmethod($1,'$2',$3)/g; 
    } 
    $status; 
} 

1; 

उदाहरण का उपयोग

use MyLang nomethod => \&mywrap; 

my $a = "foo"; 
my $b = "bar"; 
$x = $a =~ $b; 

sub mywrap { 
    my ($a, $b, $inv, $op) = @_; 
    print "$a\n"; 
} 

के बाद से यह क्या है चर "एक $" में है अब ऊपर प्रिंट होगा "foo \ n"। बेशक आप फिल्टर में रेगेक्स प्रतिस्थापन के लिए कुछ और अधिक बुद्धिमान पार्सिंग करना चाह सकते हैं, लेकिन यह अवधारणा का एक सरल सबूत है।