File Coverage

blib/lib/DS/Transformer/TypePassthrough.pm
Criterion Covered Total %
statement 41 42 97.6
branch 9 10 90.0
condition 2 3 66.6
subroutine 10 10 100.0
pod 4 4 100.0
total 66 69 95.6


line stmt bran cond sub pod time code
1             #!perl
2            
3             # ########################################################################## #
4             # Title: Type pass through transformer
5             # Creation date: 2007-07-31
6             # Author: Michael Zedeler
7             # Description: Base class for transformers that does not change data type
8             # Data Stream class
9             # Data transformer
10             # File: $Source: /data/cvs/lib/DSlib/lib/DS/Transformer/TypePassthrough.pm,v $
11             # Repository: kronhjorten
12             # State: $State: Exp $
13             # Documentation: inline
14             # Recepient: -
15             # ########################################################################## #
16            
17             package DS::Transformer::TypePassthrough;
18            
19 3     3   937 use base qw{ DS::Transformer };
  3         7  
  3         1425  
20            
21 3     3   19 use strict;
  3         5  
  3         96  
22 3     3   18 use Carp;
  3         6  
  3         226  
23 3     3   17 use Carp::Assert;
  3         4  
  3         20  
24            
25             our ($VERSION) = $DS::VERSION;
26             our ($REVISION) = '$Revision: 1.1 $' =~ /(\d+\.\d+)/;
27            
28 3     3   663 use DS::TypeSpec;
  3         6  
  3         145  
29 3     3   784 use DS::TypeSpec::Any;
  3         5  
  3         974  
30            
31             sub new {
32 7     7 1 599 my( $class, $source, $target ) = @_;
33            
34 7         54 my $self = $class->SUPER::new( undef, undef, $source, $target );
35            
36 7         23 return $self;
37             }
38            
39             sub out_type {
40 11     11 1 1365 my( $self, $out_type ) = @_;
41            
42 11         14 my $result;
43 11 100       31 if( $out_type ) {
44 1         231 croak("The attribute out_type is read only");
45             } else {
46 10 100       41 if( $self->source ) {
47 8         40 $result = $self->source->out_type;
48             } else {
49 2         5 $result = $DS::TypeSpec::Any;
50             }
51             }
52 10         54 return $result;
53             }
54            
55             sub in_type {
56 5     5 1 1545 my( $self, $in_type ) = @_;
57            
58 5         7 my $result;
59 5 100       12 if( $in_type ) {
60 1         274 croak("The attribute in_type is read only");
61             } else {
62 4 50       13 if( $self->target ) {
63 4         11 $result = $self->target->in_type;
64             } else {
65 0         0 $result = $DS::TypeSpec::Any;
66             }
67             }
68 4         19 return $result;
69             }
70            
71             sub validate_source_type {
72 7     7 1 12 my( $self, $type ) = @_;
73            
74 7         12 my $result = 1;
75 7 100       42 if( $self->target ) {
76 2   66     12 $result &&= $self->target->validate_source_type( $type );
77             }
78            
79 7         41 return $result;
80             }
81            
82             1;