File Coverage

blib/lib/ExtUtils/XSpp/Node/Package.pm
Criterion Covered Total %
statement 24 25 96.0
branch 1 2 50.0
condition 2 3 66.6
subroutine 8 8 100.0
pod 5 5 100.0
total 40 43 93.0


line stmt bran cond sub pod time code
1             package ExtUtils::XSpp::Node::Package;
2 21     21   40530 use strict;
  21         136  
  21         714  
3 21     21   118 use warnings;
  21         39  
  21         641  
4 21     21   110 use base 'ExtUtils::XSpp::Node';
  21         41  
  21         1076  
5              
6             =head1 NAME
7              
8             ExtUtils::XSpp::Node::Package - Node representing a Perl package
9              
10             =head1 DESCRIPTION
11              
12             An L subclass representing a Perl package and
13             thus acting as a container for methods (cf. sub-class
14             L) or functions.
15              
16             A literal C would, for example,
17             be created from:
18              
19             %package{Some::Perl::Namespace}
20              
21             This would be compiled to a new XS line a la
22              
23             MODULE=$WhateverCurrentModule PACKAGE=Some::Perl::Namespace
24              
25             =head1 METHODS
26              
27             =head2 new
28              
29             Creates a new C.
30              
31             Named parameters: C indicating the C++ class name
32             (if any), and C indicating the name of the Perl
33             package. If C is not specified but C is,
34             C defaults to C.
35              
36             =cut
37              
38             sub init {
39 84     84 1 628 my $this = shift;
40 84         323 my %args = @_;
41              
42 84         442 $this->{CPP_NAME} = $args{cpp_name};
43 84   66     644 $this->{PERL_NAME} = $args{perl_name} || $args{cpp_name};
44             }
45              
46             =head1 ACCESSORS
47              
48             =head2 cpp_name
49              
50             Returns the C++ name for the package (will be used for namespaces).
51              
52             =head2 perl_name
53              
54             Returns the Perl name for the package.
55              
56             =head2 set_perl_name
57              
58             Setter for the Perl package name.
59              
60             =cut
61              
62 193     193 1 1013 sub cpp_name { $_[0]->{CPP_NAME} }
63 89     89 1 335 sub perl_name { $_[0]->{PERL_NAME} }
64 4     4 1 26 sub set_perl_name { $_[0]->{PERL_NAME} = $_[1] }
65              
66             sub print {
67 80     80 1 151 my $this = shift;
68 80         140 my $state = shift;
69 80         173 my $out = '';
70 80         341 my $pcname = $this->perl_name;
71              
72 80 50       280 if( !defined $state->{current_module} ) {
73 0         0 die "No current module: remember to add a %module{} directive";
74             }
75 80         309 my $cur_module = $state->{current_module}->to_string;
76              
77 80         296 $out .= <
78              
79             $cur_module PACKAGE=$pcname
80              
81             EOT
82              
83 80         267 return $out;
84             }
85              
86             1;