1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
# ToDo:
#
# - Load globs
# - Dump *foo{IO} and *foo{FORMAT}
# - Rewrite documentation
# - Copy all relevant code from YAML::Syck
# - Review YAML::Syck Changes file
# - Make YAML a prereq for YAML-LibYAML
# - Make loading regexp use code from YAML::Types
# - Make glob dumping use YAML::Node
# - Move all YAML and YAML::XS tests to YAML::Tests
# - Make YAML and YAML::XS pass all common tests
# - Add scalar dumping heuristics similar to YAML.pm
#
# Tests:
# - Abstract all tests to YAML::Tests
# - http://svn.ali.as/cpan/concept/cpan-yaml-tiny/
#
# Profiling:
# - TonyC: sprof if I can remember the way to enable shared library profiling
# - TonyC: LD_PROFILE, but that may not work on OS X
# - TonyC: sample or Sampler.app on OS X, I'd guess
package YAML::XS;
use 5.008003;
use strict;
$YAML::XS::VERSION = '0.33';
use base 'Exporter';
@YAML::XS::EXPORT = qw(Load Dump);
@YAML::XS::EXPORT_OK = qw(LoadFile DumpFile);
%YAML::XS::EXPORT_TAGS = (
all => [qw(Dump Load LoadFile DumpFile)],
);
# $YAML::XS::UseCode = 0;
# $YAML::XS::DumpCode = 0;
# $YAML::XS::LoadCode = 0;
use YAML::XS::LibYAML qw(Load Dump);
sub DumpFile {
my $OUT;
my $filename = shift;
if (ref $filename eq 'GLOB') {
$OUT = $filename;
}
else {
my $mode = '>';
if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
($mode, $filename) = ($1, $2);
}
open $OUT, $mode, $filename
or die "Can't open '$filename' for output:\n$!";
}
local $/ = "\n"; # reset special to "sane"
print $OUT YAML::XS::LibYAML::Dump(@_);
}
sub LoadFile {
my $IN;
my $filename = shift;
if (ref $filename eq 'GLOB') {
$IN = $filename;
}
else {
open $IN, $filename
or die "Can't open '$filename' for input:\n$!";
}
return YAML::XS::LibYAML::Load(do { local $/; <$IN> });
}
# XXX Figure out how to lazily load this module.
# So far I've tried using the C function:
# load_module(PERL_LOADMOD_NOIMPORT, newSVpv("B::Deparse", 0), NULL);
# But it didn't seem to work.
use B::Deparse;
# XXX The following code should be moved from Perl to C.
$YAML::XS::coderef2text = sub {
my $coderef = shift;
my $deparse = B::Deparse->new();
my $text;
eval {
local $^W = 0;
$text = $deparse->coderef2text($coderef);
};
if ($@) {
warn "YAML::XS failed to dump code ref:\n$@";
return;
}
$text =~ s[BEGIN \{\$\{\^WARNING_BITS\} = "UUUUUUUUUUUU\\001"\}]
[use warnings;]g;
return $text;
};
$YAML::XS::glob2hash = sub {
my $hash = {};
for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
my $value = *{$_[0]}{$type};
$value = $$value if $type eq 'SCALAR';
if (defined $value) {
if ($type eq 'IO') {
my @stats = qw(device inode mode links uid gid rdev size
atime mtime ctime blksize blocks);
undef $value;
$value->{stat} = {};
map {$value->{stat}{shift @stats} = $_} stat(*{$_[0]});
$value->{fileno} = fileno(*{$_[0]});
{
local $^W;
$value->{tell} = tell(*{$_[0]});
}
}
$hash->{$type} = $value;
}
}
return $hash;
};
use constant _QR_MAP => {
'' => sub { qr{$_[0]} },
x => sub { qr{$_[0]}x },
i => sub { qr{$_[0]}i },
s => sub { qr{$_[0]}s },
m => sub { qr{$_[0]}m },
ix => sub { qr{$_[0]}ix },
sx => sub { qr{$_[0]}sx },
mx => sub { qr{$_[0]}mx },
si => sub { qr{$_[0]}si },
mi => sub { qr{$_[0]}mi },
ms => sub { qr{$_[0]}sm },
six => sub { qr{$_[0]}six },
mix => sub { qr{$_[0]}mix },
msx => sub { qr{$_[0]}msx },
msi => sub { qr{$_[0]}msi },
msix => sub { qr{$_[0]}msix },
};
sub __qr_loader {
if ($_[0] =~ /\A \(\? ([ixsm]*) (?:- (?:[ixsm]*))? : (.*) \) \z/x) {
my $sub = _QR_MAP->{$1} || _QR_MAP->{''};
&$sub($2);
}
else {
qr/$_[0]/;
}
}
1;
=encoding utf8
=head1 NAME
YAML::XS - Perl YAML Serialization using XS and libyaml
=head1 SYNOPSIS
use YAML::XS;
my $yaml = Dump [ 1..4 ];
my $array = Load $yaml;
=head1 DESCRIPTION
Kirill Siminov's C<libyaml> is arguably the best YAML implementation.
The C library is written precisely to the YAML 1.1 specification. It was
originally bound to Python and was later bound to Ruby.
This module is a Perl XS binding to libyaml which offers Perl the best YAML
support to date.
This module exports the functions C<Dump> and C<Load>. These functions
are intended to work exactly like C<YAML.pm>'s corresponding functions.
=head1 SEE ALSO
* YAML.pm
* YAML::Syck
* YAML::Tiny
=head1 AUTHOR
Ingy döt Net <ingy@cpan.org>
=head1 MAINTAINERS
Yuval Kogman <nothingmuch@woobling.org>
Gisle Aas <gisle@ActiveState.com>
=head1 COPYRIGHT
Copyright (c) 2007, 2008, 2009, 2010. Ingy döt Net.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
See http://www.perl.com/perl/misc/Artistic.html
=cut
|
