Filename | /home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Data/YAML/Writer.pm |
Statements | Executed 12 statements in 516µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 11µs | 44µs | BEGIN@5 | Data::YAML::Writer::
1 | 1 | 1 | 10µs | 22µs | BEGIN@3 | Data::YAML::Writer::
1 | 1 | 1 | 8µs | 15µs | BEGIN@4 | Data::YAML::Writer::
1 | 1 | 1 | 7µs | 26µs | BEGIN@7 | Data::YAML::Writer::
1 | 1 | 1 | 6µs | 6µs | CORE:qr (opcode) | Data::YAML::Writer::
0 | 0 | 0 | 0s | 0s | __ANON__[:56] | Data::YAML::Writer::
0 | 0 | 0 | 0s | 0s | __ANON__[:59] | Data::YAML::Writer::
0 | 0 | 0 | 0s | 0s | __ANON__[:62] | Data::YAML::Writer::
0 | 0 | 0 | 0s | 0s | _enc_scalar | Data::YAML::Writer::
0 | 0 | 0 | 0s | 0s | _make_writer | Data::YAML::Writer::
0 | 0 | 0 | 0s | 0s | _put | Data::YAML::Writer::
0 | 0 | 0 | 0s | 0s | _write_obj | Data::YAML::Writer::
0 | 0 | 0 | 0s | 0s | new | Data::YAML::Writer::
0 | 0 | 0 | 0s | 0s | write | Data::YAML::Writer::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Data::YAML::Writer; | ||||
2 | |||||
3 | 2 | 19µs | 2 | 33µs | # spent 22µs (10+12) within Data::YAML::Writer::BEGIN@3 which was called:
# once (10µs+12µs) by Benchmark::Perl::Formance::BEGIN@13 at line 3 # spent 22µs making 1 call to Data::YAML::Writer::BEGIN@3
# spent 12µs making 1 call to strict::import |
4 | 2 | 18µs | 2 | 21µs | # spent 15µs (8+7) within Data::YAML::Writer::BEGIN@4 which was called:
# once (8µs+7µs) by Benchmark::Perl::Formance::BEGIN@13 at line 4 # spent 15µs making 1 call to Data::YAML::Writer::BEGIN@4
# spent 7µs making 1 call to warnings::import |
5 | 2 | 25µs | 2 | 77µs | # spent 44µs (11+33) within Data::YAML::Writer::BEGIN@5 which was called:
# once (11µs+33µs) by Benchmark::Perl::Formance::BEGIN@13 at line 5 # spent 44µs making 1 call to Data::YAML::Writer::BEGIN@5
# spent 33µs making 1 call to Exporter::import |
6 | |||||
7 | 2 | 432µs | 2 | 44µs | # spent 26µs (7+19) within Data::YAML::Writer::BEGIN@7 which was called:
# once (7µs+19µs) by Benchmark::Perl::Formance::BEGIN@13 at line 7 # spent 26µs making 1 call to Data::YAML::Writer::BEGIN@7
# spent 19µs making 1 call to vars::import |
8 | |||||
9 | 1 | 400ns | $VERSION = '0.0.6'; | ||
10 | |||||
11 | 1 | 13µs | 1 | 6µs | my $ESCAPE_CHAR = qr{ [\x00-\x1f\"] }x; # spent 6µs making 1 call to Data::YAML::Writer::CORE:qr |
12 | |||||
13 | 1 | 4µs | my @UNPRINTABLE = qw( | ||
14 | z x01 x02 x03 x04 x05 x06 a | ||||
15 | x08 t n v f r x0e x0f | ||||
16 | x10 x11 x12 x13 x14 x15 x16 x17 | ||||
17 | x18 x19 x1a e x1c x1d x1e x1f | ||||
18 | ); | ||||
19 | |||||
20 | # Create an empty Data::YAML::Writer object | ||||
21 | sub new { | ||||
22 | my $class = shift; | ||||
23 | bless {}, $class; | ||||
24 | } | ||||
25 | |||||
26 | sub write { | ||||
27 | my $self = shift; | ||||
28 | |||||
29 | croak "Need something to write" | ||||
30 | unless @_; | ||||
31 | |||||
32 | my $obj = shift; | ||||
33 | my $out = shift || \*STDOUT; | ||||
34 | |||||
35 | croak "Need a reference to something I can write to" | ||||
36 | unless ref $out; | ||||
37 | |||||
38 | $self->{writer} = $self->_make_writer( $out ); | ||||
39 | |||||
40 | $self->_write_obj( '---', $obj ); | ||||
41 | $self->_put( '...' ); | ||||
42 | |||||
43 | delete $self->{writer}; | ||||
44 | } | ||||
45 | |||||
46 | sub _make_writer { | ||||
47 | my $self = shift; | ||||
48 | my $out = shift; | ||||
49 | |||||
50 | my $ref = ref $out; | ||||
51 | |||||
52 | if ( 'CODE' eq $ref ) { | ||||
53 | return $out; | ||||
54 | } | ||||
55 | elsif ( 'ARRAY' eq $ref ) { | ||||
56 | return sub { push @$out, shift }; | ||||
57 | } | ||||
58 | elsif ( 'SCALAR' eq $ref ) { | ||||
59 | return sub { $$out .= shift() . "\n" }; | ||||
60 | } | ||||
61 | elsif ( 'GLOB' eq $ref || 'IO::Handle' eq $ref ) { | ||||
62 | return sub { print $out shift(), "\n" }; | ||||
63 | } | ||||
64 | |||||
65 | croak "Can't write to $out"; | ||||
66 | } | ||||
67 | |||||
68 | sub _put { | ||||
69 | my $self = shift; | ||||
70 | $self->{writer}->( join '', @_ ); | ||||
71 | } | ||||
72 | |||||
73 | sub _enc_scalar { | ||||
74 | my $self = shift; | ||||
75 | my $val = shift; | ||||
76 | |||||
77 | return '~' unless defined $val; | ||||
78 | |||||
79 | if ( $val =~ /$ESCAPE_CHAR/ ) { | ||||
80 | $val =~ s/\\/\\\\/g; | ||||
81 | $val =~ s/"/\\"/g; | ||||
82 | $val =~ s/ ( [\x00-\x1f] ) / '\\' . $UNPRINTABLE[ ord($1) ] /gex; | ||||
83 | return qq{"$val"}; | ||||
84 | } | ||||
85 | |||||
86 | if ( length( $val ) == 0 or $val =~ /\s/ ) { | ||||
87 | $val =~ s/'/''/; | ||||
88 | return "'$val'"; | ||||
89 | } | ||||
90 | |||||
91 | return $val; | ||||
92 | } | ||||
93 | |||||
94 | sub _write_obj { | ||||
95 | my $self = shift; | ||||
96 | my $prefix = shift; | ||||
97 | my $obj = shift; | ||||
98 | my $indent = shift || 0; | ||||
99 | |||||
100 | if ( my $ref = ref $obj ) { | ||||
101 | my $pad = ' ' x $indent; | ||||
102 | $self->_put( $prefix ); | ||||
103 | if ( 'HASH' eq $ref ) { | ||||
104 | for my $key ( sort keys %$obj ) { | ||||
105 | my $value = $obj->{$key}; | ||||
106 | $self->_write_obj( $pad . $self->_enc_scalar( $key ) . ':', | ||||
107 | $value, $indent + 1 ); | ||||
108 | } | ||||
109 | } | ||||
110 | elsif ( 'ARRAY' eq $ref ) { | ||||
111 | for my $value ( @$obj ) { | ||||
112 | $self->_write_obj( $pad . '-', $value, $indent + 1 ); | ||||
113 | } | ||||
114 | } | ||||
115 | else { | ||||
116 | croak "Don't know how to encode $ref"; | ||||
117 | } | ||||
118 | } | ||||
119 | else { | ||||
120 | $self->_put( $prefix, ' ', $self->_enc_scalar( $obj ) ); | ||||
121 | } | ||||
122 | } | ||||
123 | |||||
124 | 1 | 5µs | 1; | ||
125 | |||||
126 | __END__ | ||||
# spent 6µs within Data::YAML::Writer::CORE:qr which was called:
# once (6µs+0s) by Benchmark::Perl::Formance::BEGIN@13 at line 11 |