File Coverage

blib/lib/Nes/Singleton.pm
Criterion Covered Total %
statement 6 54 11.1
branch 0 10 0.0
condition 0 5 0.0
subroutine 2 7 28.5
pod 3 5 60.0
total 11 81 13.5


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             # -----------------------------------------------------------------------------
4             #
5             # Nes by Skriptke
6             # Copyright 2009 - 2010 Enrique F. Castañón Barbero
7             # Licensed under the GNU GPL.
8             #
9             # CPAN:
10             # http://search.cpan.org/dist/Nes/
11             #
12             # Sample:
13             # http://nes.sourceforge.net/
14             #
15             # Repository:
16             # http://github.com/Skriptke/nes
17             #
18             # Version 1.03
19             #
20             # Singleton.pm
21             #
22             # -----------------------------------------------------------------------------
23              
24             {
25             package Nes::Singleton;
26            
27             my $instance;
28              
29             sub new {
30 0     0 1   my $class = shift;
31 0   0       my $self = $instance || bless {}, $class;
32 0           my ( $file ) = @_;
33            
34 0 0         if ( $instance ) {
35 0           $self->{'container'} = nes_container->get_obj();
36 0           $self->{'this_template_name'} = $self->{'container'}->{'file_name'};
37 0           $self->{'top_template_name'} = $self->{'top_container'}->{'file'};
38 0           return $self;
39             } else {
40 0           $instance = $self;
41             }
42              
43 0   0       $self->{'file'} = $ENV{'PATH_TRANSLATED'} || $file;
44            
45 0           my $dir = $self->{'file'};
46 0           $dir =~ s/[^\/]*$//;
47 0           chdir $dir;
48 3     3   16 use Cwd;
  3         6  
  3         838  
49 0           $dir = getcwd;
50            
51 0 0         die "No template defined: $@" if !$self->{'file'};
52              
53 0           $self->{'CFG'} = Nes::Setting->new();
54 0           $self->{'top_container'} = nes_top_container->new( $self->{'file'}, $dir );
55 0           $self->{'container'} = nes_container->get_obj();
56 0           $self->{'cookies'} = nes_cookie->get_obj();
57 0           $self->{'session'} = nes_session->get_obj();
58 0           $self->{'query'} = nes_query->get_obj();
59 0           $self->{'register'} = nes_register->get_obj();
60 0           $self->{'nes'} = $self->{'top_container'}->{'nes'};
61 0           $self->{'this_template_name'} = $self->{'container'}->{'file_name'};
62 0           $self->{'top_template_name'} = $self->{'top_container'}->{'file'};
63              
64             # todo, comprobar que existe el juego de caracteres antes
65 3     3   2882 use POSIX qw(locale_h);
  3         21590  
  3         21  
66 0 0         POSIX::setlocale(LC_ALL, "$self->{'CFG'}{'locale'}") if $self->{'CFG'}{'locale'};
67            
68 0 0         if ( $file ) {
69             # todo, implementar emulación CGI para linea de comandos
70             # $ENV{REMOTE_ADDR} = '127.0.0.1' if !$ENV{REMOTE_ADDR};
71 0           $self->run();
72 0           exit;
73             }
74            
75 0           return $self;
76             }
77              
78             sub run {
79 0     0 0   my $self = shift;
80              
81 0           $self->{'container'}->go();
82 0           $self->{'top_container'}->{'container'}->out();
83              
84 0           return;
85             }
86              
87             sub out {
88 0     0 1   my $self = shift;
89 0           my %tags;
90 0           (%tags) = @_;
91              
92 0           $self->{'container'}->set_tags(%tags);
93 0           $self->{'container'}->interpret();
94              
95 0           return;
96             }
97            
98             sub add {
99 0     0 1   my $self = shift;
100 0           my %tags;
101 0           (%tags) = @_;
102              
103 0           $self->{'container'}->add_tags(%tags);
104              
105 0           return;
106             }
107            
108             sub start {
109 0     0 0   my $class = shift;
110            
111 0 0         utl::cleanup(\$instance) if $ENV{'MOD_PERL'};
112              
113 0           return $class->new();
114             }
115              
116             }
117              
118              
119             1;