<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl
package Wrap::Simple;

use warnings;
use strict 'vars';

use Exporter;
use vars qw/$VERSION @ISA @EXPORT @EXPORT_OK/;

$VERSION     = "1.0";
$VERSION     = eval $VERSION;

@ISA         = qw/Exporter/;
@EXPORT      = qw/can wrap/;
@EXPORT_OK   = @EXPORT;

=pod

=head1 NAME

Wrap::Simple - a simple wrapper for perl

=head1 INTERFACES

=over 4

=item can

B&lt;can&gt; ç¨ćĽćŁćľäź&nbsp;éçĺć°ćŻĺŚĺŻć§čĄďźĺŚćĺŻć§čĄĺčżĺčŻĽĺ˝ć°ĺźç¨ăĺć°ĺä¸şä¸¤ç§ďźä¸ä¸şĺ˝ć°ĺďź
ć­¤ćśéčżćŁćľ main ĺä¸­ççŹŚĺˇčĄ¨ćĽćŁćľćŻĺŚĺŻć§čĄăĺŚĺ¤ä¸ç§ćšĺźä¸şäťŁç&nbsp;ĺźç¨ďźć­¤ćśéčż B&lt;ref()&gt; 
ćšĺźćĽćŁćľă

    sub foo { print "foo ...\n" }
    
    my $p1 = 'foo';
    my $p2 = \&amp;foo;

    print can $p1;
    print can $p2;

=cut

sub can {
    my $func = shift;
    return $func if $func and ref $func eq 'CODE';
    if (grep { $_ eq $func } keys %::) {
        *f = $::{$func};
        return \&amp;f;
    }
    return 0;
}

=item wrap

B&lt;wrap&gt; ç¨ćĽĺ°čŁĺ˝ć°ĺšśčżĺĺ˝ć°ĺźç¨ăçŹŹä¸ä¸Şĺć°ä¸şčŚĺ°čŁçĺ˝ć°ďźĺŠä˝çĺć°ä¸şĺ°čŁĺčĄ¨ă
äżŽéĽ°çŹŚććśĺŞć pre ĺ postă

    sub foo1 { ... }
    sub foo2 { ... }
    sub foo3 { ... }
    sub foo4 { ... }

    my $ref = wrap 'foo', pre=&gt;\&amp;foo1, pre=&gt;\&amp;foo2, pre=&gt;'foo3', post=&gt;\&amp;foo4;
    $ref-&gt;("Hello World");

=cut

sub wrap {
    my $func       = shift;
    my $funp       = can $func;
    my @pre_funcs  = ();
    my @post_funcs = ();
    die "$func unvalid!" unless ref $funp eq 'CODE';
    die "@_ unvalid. Perhaps not be in pair." if scalar(@_)%2;

    while (@_) {
        my $p1 = shift;
        my $p2 = shift;
        my $pf = can $p2;
        die "$p2 unvalid!" unless ref $pf eq 'CODE';
        if ($p1 eq 'pre') {
            push @pre_funcs,  $pf;
        } elsif ($p1 eq 'post') {
            push @post_funcs, $pf;
        } else {
            die "$p1 delegation error!";
        }
    }
    
    return sub {
        my $param = shift;
        map $_-&gt;(), @pre_funcs;
        $func-&gt;($param);
        map $_-&gt;(), @post_funcs;
    }
}

=back

=head1 EXAMPLE

    sub core { print "core function with param ",shift, "\n" }
    sub foo1 { print "foo1\n" }
    sub foo2 { print "foo2\n" }
    sub foo3 { print "foo3\n" }
    sub foo4 { print "foo4\n" }

    my $ref = wrap 'core', pre=&gt;'foo1', pre=&gt;\&amp;foo2, pre=&gt;\&amp;foo3, post=&gt;\&amp;foo4;
    $ref-&gt;('Hello World');

=head1 LOG

=over 4

=item Mon Feb  6 22:06:42 HKT 2012

ć¨Ąĺĺ¤ä¸ć¨ĄĺĺçŹŚĺˇčĄ¨ćˇˇäšąďźéčŚčżä¸ć­ĽFIXăĺ˝ä˝żç¨ĺ˝ć°ĺčä¸ćŻĺ˝ć°ĺźç¨ćśďźäźĺç
čŻĽçąťéŽé˘ă

FIXEDăéčŚéčż%::ĺĺ¸čĄ¨ćĽĺžĺ°ĺˇä˝ççŹŚĺˇčĄ¨ďźçśĺĺ˝˘ćç¸ĺşçĺźç¨ă

=back

=head1 AUTHOR

xiaomo(wxm4ever@gmail.com)

=cut

1;

__END__
</pre></body></html>