File Coverage

blib/lib/PHP/Var.pm
Criterion Covered Total %
statement 56 56 100.0
branch 22 22 100.0
condition 3 3 100.0
subroutine 6 6 100.0
pod 1 1 100.0
total 88 88 100.0


line stmt bran cond sub pod time code
1             package PHP::Var;
2              
3 3     3   40694 use warnings;
  3         6  
  3         112  
4 3     3   16 use strict;
  3         7  
  3         98  
5              
6 3     3   16 use Exporter;
  3         4  
  3         121  
7 3     3   16 use base qw( Exporter );
  3         6  
  3         1939  
8             our @EXPORT_OK = qw( export );
9              
10             our $Purity = 0;
11             our $Enclose = 0;
12              
13             =head1 NAME
14              
15             PHP::Var - export variable to PHP's expression.
16              
17             =head1 VERSION
18              
19             Version 0.022
20              
21             =cut
22              
23             our $VERSION = '0.022';
24              
25              
26             =head1 SYNOPSIS
27              
28             use PHP::Var qw/ export /;
29              
30             $var = {foo => 1, bar => 2};
31              
32             # export
33             $exported = export($var);
34              
35             # named variable
36             $named = export('name' => $var);
37              
38             # enclose variables with ''
39             $enclosed = export($var, enclose => 1);
40              
41             # purity print
42             $purity = export($var, purity => 1);
43              
44             =head1 EXPORT
45              
46             =head2 export
47              
48             =head1 FUNCTIONS
49              
50             =head2 export
51              
52             $var = {foo => 1, bar => 2};
53              
54             export($var);
55             # array('foo'=>'1','bar'=>'2',);
56              
57             export('name' => $var);
58             # $name=array('foo'=>'1','bar'=>'2',);
59              
60             export($var, enclose => 1);
61             #
62             # array('foo'=>'1','bar'=>'2',);
63             # ?>
64              
65             export($var, purity => 1);
66             # array(
67             # 'foo' => '1',
68             # 'bar' => '2',
69             # );
70              
71             =head1 Configuration Variables
72              
73             =head2 $PHP::Var::Purity
74              
75             When this variable is set, the expression becomes a Pretty print in default.
76              
77             {
78             local $PHP::Var::Purity = 1;
79             export($var);
80             # array(
81             # 'foo' => '1',
82             # 'bar' => '2',
83             # );
84             }
85              
86             =head2 $PHP::Var::Enclose
87              
88             When this variable is set, the expression is enclosed with '' in default.
89              
90             {
91             local $PHP::Var::Enclose = 1;
92             export($var);
93             #
94             # array('foo'=>'1','bar'=>'2',);
95             # ?>
96             }
97              
98             =cut
99              
100             sub export {
101 12     12 1 70 my %opts = (
102             purity => $Purity,
103             enclose => $Enclose,
104             );
105              
106 12         18 my @exports = ();
107 12         32 for (my $i = 0; $i < scalar(@_); $i++) {
108 15 100 100     67 if (
109             (! ref($_[$i])) && (! ref($_[$i+1]))
110             ) {
111 3         6 $opts{$_[$i]} = $_[$i+1];
112 3         9 $i++;
113             }
114             else {
115 12         14 my $key = undef;
116 12 100       29 if (! ref $_[$i]) {
117 6         9 $key = $_[$i];
118 6         10 $i++;
119             }
120 12         39 push(@exports, $key, $_[$i]);
121             }
122             }
123              
124 12         16 my $str = '';
125 12         29 for (my $i = 0; $i < scalar(@exports); $i += 2) {
126 12         37 $str .= &_dump($exports[$i+1], $exports[$i], $opts{purity}, 0) . ';';
127             }
128              
129 12 100       31 if ($opts{enclose}) {
130 1         13 "";
131             }
132             else {
133 11         55 $str;
134             }
135             }
136              
137             sub _dump {
138 39     39   91 my ($obj, $key, $purity, $indent) = @_;
139              
140 39 100       80 my $ind = $purity ? "\t" : '';
141 39 100       65 my $spc = $purity ? ' ' : '';
142 39 100       62 my $nl = $purity ? "\n" : '';
143 39         51 my $cur_indent = $ind x $indent;
144              
145 39         41 my $str = '';
146              
147 39 100       90 if ($key) {
148 6         14 $str .= '$' . $key . "$spc=$spc";
149             }
150              
151 39 100       124 if (ref $obj eq 'HASH') {
    100          
    100          
    100          
152 13         20 $str .= "array($nl";
153 13         41 foreach my $k (keys(%$obj)) {
154 17         27 $k =~ s/\\/\\\\/go;
155 17         18 $k =~ s/'/\\'/go;
156 17         79 $str .=
157             "$cur_indent$ind'" . $k . "'$spc=>$spc" .
158             &_dump($obj->{$k}, undef, $purity, $indent+1) .
159             ",$nl";
160             }
161 13         30 $str .= "$cur_indent)";
162             }
163             elsif (ref $obj eq 'ARRAY') {
164 5         10 $str .= "array($nl";
165 5         14 for (my $i = 0; $i < scalar(@$obj); $i++) {
166 10         60 $str .=
167             "$cur_indent$ind" .
168             &_dump($obj->[$i], undef, $purity, $indent+1) .
169             ",$nl";
170             }
171 5         12 $str .= "$cur_indent)";
172             }
173             elsif (ref $obj eq 'SCALAR') {
174 1         4 $$obj =~ s/\\/\\\\/go;
175 1         3 $$obj =~ s/'/\\'/go;
176 1         4 $str .= "'$$obj'";
177             }
178             elsif (defined($obj)) {
179 19         31 $obj =~ s/\\/\\\\/go;
180 19         113 $obj =~ s/'/\\'/go;
181 19         31 $str .= "'$obj'";
182             }
183             else {
184 1         2 $str .= "false";
185             }
186              
187 39         188 $str;
188             }
189              
190             =head1 NOTES
191              
192             =over 4
193              
194             =item *
195              
196             PHP::Var::export cannot export the blessed object as data that can be restored.
197              
198             =back
199              
200             =head1 AUTHOR
201              
202             Taku Amano, C<< >>
203              
204              
205             =head1 SEE ALSO
206              
207             L
208              
209              
210             =head1 SUPPORT
211              
212             You can find documentation for this module with the perldoc command.
213              
214             perldoc PHP::Var
215              
216              
217             =head1 COPYRIGHT & LICENSE
218              
219             Copyright 2009 Taku Amano.
220              
221             This program is free software; you can redistribute it and/or modify it
222             under the terms of either: the GNU General Public License as published
223             by the Free Software Foundation; or the Artistic License.
224              
225             See http://dev.perl.org/licenses/ for more information.
226              
227              
228             =cut
229              
230             1; # End of PHP::Var