<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>