An example of creating decorators in Perl

perl-decorators.pl

package Profiler::Decorator;

use IO::Socket::INET;
use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep clock_gettime clock_getres clock_nanosleep clock stat );
use Data::Dumper;

# flush after every write

#  We call IO::Socket::INET->new() to create the UDP Socket
# and bind with the PeerAddr.
sub send_profile_info {
	local $| = 1;
	my (%args) = @_;
	my $h_ref = \%args;
	print Dumper( $h_ref ),"\n";

	my $socket = IO::Socket::INET->new(
		PeerAddr	=> '127.0.0.1:5000',
		Proto		=> 'udp',
	) or die( "Error creating socket: $!\n" );

	my $msg = sprintf "%s,%s,%s", $h_ref->{name}, $h_ref->{elapsed}, $h_ref->{rc};
	$socket->send( $msg );
}

sub profile_function {
	my $f = shift;
	my $fname = shift;
	my $t0 = [gettimeofday];
	return sub {
		my $rc = &$f(@_);
		$elapsed = tv_interval ( $t0 );
		send_profile_info name => $fname, 
				  elapsed => scalar $elapsed, 
				  rc => $rc ;
		($rc);
	};
}

use Filter::Util::Call ;

sub import {
	my($type, @arguments) = @_ ;
	filter_add([]) ;
}

sub filter {
	my($self) = @_ ;
	my($status) ;
	if( ($status = filter_read() ) >= 0 ){
		if( /^\s*\@profile\s+function\s+(\S+)\s+as\s+(\S+?)\;/ ){
			$_ = sprintf '*{__PACKAGE__."::%s"} = Profiler::Decorator::profile_function(\&%s,"%s");', $1,$1,$2;
		}
	}
	$status ;
}

1;

package main;

use strict;
use Profiler::Decorator;

sub hola_person {
	my $name = shift;
	print "Hi ",$name,"\n";;
}

# Call our function, vanilla style
hola_person 'pete';

# Now, create a special section for decorators
eval {
	# no strict "refs" is required
	no strict "refs";

	# List each decorator with a label at the end
	@profile function hola_person as main::hola::person;
};

print "Calling with decorator\n";
hola_person 'pete';