File Coverage

blib/lib/DS/Target/Proxy.pm
Criterion Covered Total %
statement 12 50 24.0
branch 0 18 0.0
condition n/a
subroutine 4 12 33.3
pod 5 8 62.5
total 21 88 23.8


line stmt bran cond sub pod time code
1             #!perl
2            
3             # ########################################################################## #
4             # Title: Data stream target proxy
5             # Creation date: 2007-04-16
6             # Author: Michael Zedeler
7             # Description: Receives data and passes it to another, underlying target
8             # Data Stream class
9             # File: $Source: /data/cvs/lib/DSlib/lib/DS/Target/Proxy.pm,v $
10             # Repository: kronhjorten
11             # State: $State: Exp $
12             # Documentation: inline
13             # Recepient: -
14             # ########################################################################## #
15            
16             package DS::Target::Proxy;
17            
18 1     1   5 use base qw{ DS::Target };
  1         1  
  1         64  
19            
20 1     1   3 use strict;
  1         2  
  1         25  
21 1     1   4 use Carp qw{ croak cluck confess carp };
  1         1  
  1         50  
22 1     1   4 use Carp::Assert;
  1         2  
  1         4  
23            
24             our ($VERSION) = $DS::VERSION;
25             our ($REVISION) = '$Revision: 1.1 $' =~ /(\d+\.\d+)/;
26            
27             my @proxy_methods = qw{ receive_row source attach_source in_type validate_source };
28            
29             sub new {
30 0     0 1   my( $class, $inner_object, $delegate ) = @_;
31            
32 0           bless my $self = {}, $class;
33 0 0         $self->inner_object( $inner_object ) if $inner_object;
34 0 0         $self->delegate( $delegate ) if $delegate;
35            
36 0           return $self;
37             }
38            
39             sub inner_object {
40 0     0 0   my( $self, $object ) = @_;
41            
42 0           my $result = 1;
43 0 0         if( $object ) {
44 0           assert($object->isa( 'DS::Target' ) );
45 0           $self->{inner_object} = $object;
46             } else {
47 0           $result = $self->{inner_object};
48             }
49 0           return $result;
50             }
51            
52             sub delegate {
53 0     0 0   my( $self, $delegate ) = @_;
54            
55 0           my $result = 1;
56 0 0         if( $delegate ) {
57 0           $self->{delegate} = $delegate;
58             } else {
59 0           $result = $self->{delegate};
60             }
61 0           return $result;
62             }
63            
64             # Create all proxy methods using eval
65             # This is not very expensive, since it is only done once - at load time
66             foreach my $method ( @proxy_methods ) {
67 0 0   0 1   eval <<"END_METHOD"; ## no critic
  0 0   0 1    
  0 0   0 1    
  0 0   0 1    
  0 0   0 0    
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
68             sub $method {
69             my( \$self, \@args ) = \@_;
70             if( \$self->{delegate}->can( 'delegate_$method' ) ) {
71             return \$self->{delegate}->delegate_invoke( '$method', \$self, \@args );
72             } else {
73             return \$self->{inner_object}->$method( \@args );
74             }
75             }
76             END_METHOD
77             }
78            
79             1;