├── .github └── workflows │ └── linux.yaml ├── Changes ├── Meta ├── ReadMe.pod ├── doc ├── YAML.swim └── YAML │ ├── Any.swim │ ├── Dumper.swim │ ├── Dumper │ └── Base.swim │ ├── Error.swim │ ├── Loader.swim │ ├── Loader │ └── Base.swim │ ├── Marshall.swim │ ├── Node.swim │ ├── Tag.swim │ └── Types.swim ├── lib ├── YAML.pm └── YAML │ ├── Any.pm │ ├── Dumper.pm │ ├── Dumper │ └── Base.pm │ ├── Error.pm │ ├── Loader.pm │ ├── Loader │ └── Base.pm │ ├── Marshall.pm │ ├── Mo.pm │ ├── Node.pm │ ├── Tag.pm │ └── Types.pm └── test ├── 2-scalars.t ├── TestYAML.pm ├── TestYAMLBase.pm ├── basic-tests.t ├── bugs-emailed.t ├── bugs-rt.t ├── changes.t ├── dump-basics.t ├── dump-blessed-glob.t ├── dump-blessed.t ├── dump-code.t ├── dump-file-utf8.t ├── dump-file.t ├── dump-nested.t ├── dump-opts.t ├── dump-perl-types-512.t ├── dump-perl-types-514.t ├── dump-perl-types.t ├── dump-stringify.t ├── dump-stringy-numbers.t ├── dump-synopsis.t ├── dump-tests-512.t ├── dump-tests-514.t ├── dump-tests.t ├── dump-works.t ├── errors.t ├── export.t ├── extra ├── meta.t ├── pmv.t └── pod.t ├── freeze-thaw.t ├── global-api.t ├── inbox.t ├── io-handle.t ├── issue-149.t ├── issue-69.t ├── load-code.t ├── load-fails.t ├── load-passes.t ├── load-slides.t ├── load-spec.t ├── load-tests.t ├── load-works.t ├── long-quoted-value.yaml ├── marshall.t ├── no-load-blessed.t ├── node-info.t ├── numify.t ├── preserve.t ├── pugs-objects.t ├── references.t ├── regexp.t ├── roundtrip.t ├── rt-90593.t ├── svk-config.yaml ├── svk.t ├── test.t ├── trailing-comments-content.t └── trailing-comments-non-content.t /.github/workflows/linux.yaml: -------------------------------------------------------------------------------- 1 | name: linux 2 | 3 | on: 4 | push: 5 | branches: [ '*' ] 6 | pull_request: 7 | branches: [ master ] 8 | workflow_dispatch: 9 | branches: [ '*' ] 10 | 11 | jobs: 12 | 13 | perl: 14 | runs-on: ubuntu-latest 15 | strategy: 16 | matrix: 17 | perl-version: 18 | # - '5.10' Test::Deep wants 5.12 19 | - '5.12' 20 | - '5.14' 21 | - '5.16' 22 | - '5.18' 23 | - '5.20' 24 | - '5.22' 25 | - '5.24' 26 | - '5.26' 27 | - '5.28' 28 | - '5.30' 29 | - '5.32' 30 | - '5.34' 31 | - '5.36' 32 | - '5.38' 33 | 34 | container: 35 | image: perl:${{ matrix.perl-version }} 36 | 37 | steps: 38 | - uses: actions/checkout@v3 39 | - run: env | sort 40 | - run: perl -V 41 | - name: Install deps 42 | run: > 43 | cpanm --quiet --notest 44 | Encode 45 | Test::Deep 46 | Test::More 47 | Test::YAML 48 | - name: Run Tests 49 | run: prove -lv test/ 50 | 51 | 52 | cover: 53 | runs-on: ubuntu-latest 54 | container: 55 | image: perl:5.38 56 | 57 | steps: 58 | - uses: actions/checkout@v3 59 | - run: env | sort 60 | - run: perl -V 61 | 62 | - name: Install deps 63 | run: > 64 | cpanm --quiet --notest --skip-satisfied 65 | Devel::Cover::Report::Coveralls 66 | Encode 67 | Test::Deep 68 | Test::More 69 | Test::YAML 70 | 71 | - name: Run Tests 72 | run: | 73 | PERL5OPT=-MDevel::Cover=-coverage,statement,branch,condition,path,subroutine prove -l test/ 74 | # cover -report coveralls 75 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | --- 2 | version: 1.31 3 | date: Wed Dec 27 07:10:56 AM PST 2023 4 | changes: 5 | - Update docs to recommend YAML::PP 6 | --- 7 | version: 1.30 8 | date: Mon 27 Jan 2020 11:09:46 PM CET 9 | changes: 10 | - 'Breaking Change: Set $YAML::LoadBlessed default to false to make it more secure' 11 | --- 12 | version: 1.29 13 | date: Sat 11 May 2019 10:26:54 AM CEST 14 | changes: 15 | - Fix regex for alias to match the one for anchors (PR#214 TINITA) 16 | --- 17 | version: 1.28 18 | date: Sun 28 Apr 2019 11:46:21 AM CEST 19 | changes: 20 | - 'Security fix: only enable loading globs when $LoadCode is set (PR#213 TINITA)' 21 | --- 22 | version: 1.27 23 | date: Sat Nov 3 14:01:26 CET 2018 24 | changes: 25 | - Remove a warning about uninitialized value for perl <= 5.10 26 | --- 27 | version: 1.26 28 | date: Fri May 18 21:57:20 CEST 2018 29 | changes: 30 | - Fix bug introduced in 1.25 - loading of quoted string with colon as sequence element (tinita, fixes issue#208) 31 | - Support zero indented block sequences (PR#207 tinita) 32 | --- 33 | version: 1.25 34 | date: Fri May 11 19:58:58 CEST 2018 35 | changes: 36 | - Applied several pull requests by tinita 37 | - Support trailing comments (PR#189, PR#190, PR#191) 38 | - Remove unused code (PR#192) 39 | - Use Test::Deep to actually test correctly for class names (PR#193) 40 | - Fix loading of mapping key which starts with `= ` (PR#194) 41 | - Fix loading strings with multiple spaces (PR#172) 42 | - Allow more characters in anchor name (PR#196) 43 | - Add $YAML::LoadBlessed for disabling loading objects (PR#197) 44 | - Disable test with long string under certain conditions (PR#201) 45 | - Quote scalar if it equals '=' (PR#202) 46 | - Multiple regexp roundtrip does not grow (PR#203) 47 | - Add support for compact nested block sequences (PR#204) 48 | - Support reverse order of block scalar indicators (PR#205) 49 | - Support nested mappings in sequences (PR#206) 50 | - Fix parsing of quoted strings (PR#188) 51 | --- 52 | version: 1.24 53 | date: Mon Oct 30 20:31:53 CET 2017 54 | changes: 55 | - Fix $LoadCode (PR#180, PR#181, PR#182 by @mohawk2++) 56 | --- 57 | version: 1.23 58 | date: Sun Feb 19 22:07:57 CET 2017 59 | changes: 60 | - Fix $YAML::Numify (empty values were converted to 0) 61 | --- 62 | version: 1.22 63 | date: Tue Feb 14 23:23:08 CET 2017 64 | changes: 65 | - Add $YAML::Numify @perlpunk++ 66 | --- 67 | version: 1.21 68 | date: Fri Dec 23 21:19:15 CET 2016 69 | changes: 70 | - No more "used only once" warnings for $YAML::Indent etc. PR#171, Issue#109 @perlpunk++ 71 | - Empty mapping value at the end resolves to null (was becoming empty string) PR#170, Issue#131 hiratara@cpan.org++ 72 | - Output key in warning when duplicate key was found PR#169, PR#119 patrick.allen.higgins@gmail.com++ 73 | - Allow reading and writing to IO::Handle PR#157, PR#168 @lameventanas++ @perlpunk++ 74 | --- 75 | version: 1.20 76 | date: Fri Dec 2 13:20:33 PST 2016 77 | changes: 78 | - Apply and amend PR#146 (quoted map keys) @preaction++ 79 | - B::Deparse is loaded at runtime now 80 | - New Feature $YAML::Preserve (Apply PR#9 @fmenabe++) 81 | --- 82 | version: 1.19 83 | date: Fri Nov 18 19:46:44 CET 2016 84 | changes: 85 | - Apply PR#164 pod (link to YAML::Shell) 86 | - Apply PR#151 Fix infinite loop for aliases without a name @bubaflub++ 87 | - Apply PR#142 Improve error messages @werekraken++ 88 | - Apply PR#162 Improve error messages 89 | - Apply PR#163 Trailing spaces after inline seq/map work now 90 | - Apply PR#154 Add test case for trailing comments @Varadinsky++ 91 | --- 92 | version: 1.18 93 | date: Fri Jul 8 14:52:26 UTC 2016 94 | changes: 95 | - List Test::More as a prereq PR#161 @perlpunk++ 96 | --- 97 | version: 1.17 98 | date: Tue Jul 5 20:20:55 UTC 2016 99 | changes: 100 | - Use Mo 0.40 101 | --- 102 | version: 1.16 103 | date: Sun Jul 3 10:53:06 PDT 2016 104 | changes: 105 | - Fix VERSION issue. PR#158 by @bgruening++ 106 | --- 107 | version: 1.15 108 | date: Sat Apr 18 17:03:09 CEST 2015 109 | changes: 110 | - Don't require newlines at end of YAML. Issue#149 111 | --- 112 | version: 1.14 113 | date: Sat Jan 17 15:32:18 PST 2015 114 | changes: 115 | - Support for QuoteNumericStrings Global Setting. PR#145 @kentnl++ 116 | --- 117 | version: 1.13 118 | date: Sat Oct 11 18:05:45 CEST 2014 119 | changes: 120 | - Disable some warnings in YAML::Any. PR#140 @nfg++ 121 | --- 122 | version: 1.12 123 | date: Mon Sep 22 08:24:43 PDT 2014 124 | changes: 125 | - Fix https://rt.cpan.org/Ticket/Display.html?id=97870 126 | --- 127 | version: 1.11 128 | date: Fri Aug 29 20:08:20 PDT 2014 129 | changes: 130 | - Remove unreachable code. PR#139. @ehuelsmann++ 131 | --- 132 | version: 1.10 133 | date: Thu Aug 28 22:53:26 PDT 2014 134 | changes: 135 | - Improve error message about indendation. PR#138. @ehuelsmann++ 136 | --- 137 | version: 1.09 138 | date: Tue Aug 19 16:41:13 PDT 2014 139 | changes: 140 | - Replace tabs with spaces 141 | --- 142 | version: 1.08 143 | date: Mon Aug 18 10:21:48 PDT 2014 144 | changes: 145 | - Dep on Test::YAML 1.05 146 | --- 147 | version: 1.07 148 | date: Mon Aug 18 08:40:01 PDT 2014 149 | changes: 150 | - Add doc examples for YAML::Any. PR#8 from shlomif++ 151 | --- 152 | version: 1.06 153 | date: Sat Aug 16 16:51:08 PDT 2014 154 | changes: 155 | - Change testdir to t 156 | --- 157 | version: 1.05 158 | date: Sat Aug 16 13:03:28 PDT 2014 159 | changes: 160 | - Meta 0.0.2 161 | --- 162 | version: 1.04 163 | date: Sat Aug 16 04:28:10 PDT 2014 164 | changes: 165 | - Eliminate spurious trailing whitespace 166 | --- 167 | version: 1.03 168 | date: Sat Aug 16 03:32:35 PDT 2014 169 | changes: 170 | - Eliminate File::Basename from test/ 171 | --- 172 | version: 1.02 173 | date: Fri Aug 15 21:09:54 PDT 2014 174 | changes: 175 | - Add t/000-compile-modules.t 176 | --- 177 | version: 1.01 178 | date: Thu Aug 7 14:48:24 PDT 2014 179 | changes: 180 | - Dep on patched Test::YAML 181 | --- 182 | version: 1.00 183 | date: Thu Aug 7 00:35:21 PDT 2014 184 | changes: 185 | - Fix bad encoding in Pod 186 | --- 187 | version: 0.99 188 | date: Wed Aug 6 17:55:42 PDT 2014 189 | changes: 190 | - Switch to external Test::Base 191 | --- 192 | version: 0.98 193 | date: Wed Jul 30 12:32:25 PDT 2014 194 | changes: 195 | - Fix indexing of YAML::Any 196 | - Change IRC to irc.perl.org#yaml 197 | --- 198 | version: 0.97 199 | date: Wed Jul 16 23:37:04 PDT 2014 200 | changes: 201 | - Move remaining docs to Swim 202 | --- 203 | version: 0.96 204 | date: Sun Jul 13 22:54:08 PDT 2014 205 | changes: 206 | - Fix Metadata and add Contributing file 207 | - Change Kwim to Swim 208 | --- 209 | version: 0.95 210 | date: Sat Jun 14 10:32:08 PDT 2014 211 | changes: 212 | - Fix dumping blessed globs. Issue 26. mcast++ 213 | --- 214 | version: 0.94 215 | date: Sat Jun 14 10:32:08 PDT 2014 216 | changes: 217 | - Skip a failing test on 5.8 introduced in 0.93 218 | --- 219 | version: 0.93 220 | date: Fri Jun 13 22:32:18 PDT 2014 221 | changes: 222 | - Switch to Zilla::Dist 223 | - Add badges to doc 224 | - '@thorsteneckel++ fixed #18' 225 | - '@karenetheridge++ fixed #19' 226 | --- 227 | version: 0.92 228 | date: Wed May 28 23:04:26 EDT 2014 229 | changes: 230 | - https://github.com/ingydotnet/yaml-pm/pull/23 231 | --- 232 | version: 0.91 233 | date: Tue May 27 17:14:12 EDT 2014 234 | changes: 235 | - https://github.com/ingydotnet/yaml-pm/pull/22 236 | --- 237 | version: 0.90 238 | date: Mon Feb 10 08:42:31 PST 2014 239 | changes: 240 | - Revert Mo from 0.38 to 0.31 - zefram++ reported it breaking cpan client 241 | --- 242 | version: 0.89 243 | date: Sat Nov 8 12:51:48 PST 2014 244 | changes: 245 | - Fixed tests to work under parallel testing -- kentnl 246 | - Switched to dzil release process 247 | --- 248 | version: 0.88 249 | date: Tue Dec 3 05:29:34 UTC 2013 250 | changes: 251 | - Fixed YAML loading on perl 5.8 (broken in YAML 0.85) by removing 252 | 5.10-specific regex construct. -- hobbs++ 253 | --- 254 | version: 0.87 255 | date: Sat Nov 30 21:51:48 PST 2013 256 | changes: 257 | - Using latest Test::Builder tp fix https://rt.cpan.org/Public/Bug/Display.html?id=90847 258 | --- 259 | version: 0.86 260 | date: Tue Nov 26 16:43:27 UTC 2013 261 | changes: 262 | - Revert YAML::Mo for https://rt.cpan.org/Public/Bug/Display.html?id=90817 263 | --- 264 | version: 0.85 265 | date: Sun Nov 24 07:43:13 PST 2013 266 | changes: 267 | - Fix for https://rt.cpan.org/Ticket/Display.html?id=19838 where synopsis in YAML::Dumper doesn't work as exptected. 268 | - Thorsten++ https://rt.cpan.org/Public/Bug/Display.html?id=90593 269 | - Upgrade to latest Mo 270 | --- 271 | version: 0.84 272 | date: Fri Jul 13 18:17:27 GMT 2012 273 | changes: 274 | - Resolve distribution error that caused .git to be shipped in the .tar.gz 275 | --- 276 | version: 0.83 277 | date: Fri Jul 13 15:44:03 GMT 2012 278 | changes: 279 | - Only call stat() and tell() on a filehandle if fileno existed 280 | - Explicit tied() call on globs to avoid a 5.16 deprecation warning 281 | --- 282 | version: 0.82 283 | date: Thu Jul 12 18:49:45 GMT 2012 284 | changes: 285 | - Test scalar @array rather than deprecated defined @array (Sebastian Stumpf) 286 | --- 287 | version: 0.81 288 | date: Thu Apr 19 11:03:38 PDT 2012 289 | changes: 290 | - Patch from https://rt.cpan.org/Public/Bug/Display.html?id=74826 291 | - YAML::Mo uses Safe Mo https://rt.cpan.org/Public/Bug/Display.html?id=76664 292 | --- 293 | version: 0.80 294 | date: Fri Feb 10 12:56:08 PST 2012 295 | changes: 296 | - Patch from https://rt.cpan.org/Ticket/Display.html?id=73702 297 | - Make YAML::Node subclass YAML::Mo::Object as well as Exporter (MSTROUT) 298 | --- 299 | version: 0.79 300 | date: Wed Feb 8 17:25:55 PST 2012 301 | changes: 302 | - Peter Scott and others noticed Mo::xxx causing problems on newer perls. 303 | Removed xxx for now. 304 | --- 305 | version: 0.78 306 | date: Sun Jan 1 23:53:57 PST 2012 307 | changes: 308 | - Apply patch from ANDK++ to deal with B::Deparse changes. 309 | --- 310 | version: 0.77 311 | date: Thu Sep 29 18:28:25 CEST 2011 312 | changes: 313 | - Add $VERSION back to all modules. 314 | - Released from Liz++ and Wendy++ garage attic! 315 | --- 316 | version: 0.76 317 | date: Wed Sep 28 12:05:08 CEST 2011 318 | changes: 319 | - Removed YAML::import per mst. 320 | --- 321 | version: 0.75 322 | date: Tue Sep 27 00:46:19 CEST 2011 323 | changes: 324 | - Switch to Mo for OO (YAML::Mo) 325 | - use_test_base in Makefile.PL. 326 | --- 327 | version: 0.74 328 | date: Sun Sep 25 22:05:05 CEST 2011 329 | changes: 330 | - Switch to Module::Package 331 | - Removed extra $VERSION lines from submodules 332 | - Released from Liz++ and Wendy++'s Tool Basement! 333 | 334 | --- 335 | version: 0.73 336 | date: Tue Apr 19 20:14:59 EST 2011 337 | changes: 338 | - Apply ANDK's patch for 5.14.0 339 | 340 | --- 341 | version: 0.72 342 | date: Wed Sep 1 11:54:00 AEST 2010 343 | changes: 344 | - Upgrade to Module::Install 1.00 345 | - Upgraded author tests via new ADAMK release automation 346 | - Normalise Ingy's name to ASCII in Makefile.PL so that we don't have Unicode in our own META.yml 347 | 348 | --- 349 | version: 0.71 350 | date: Sun Jan 3 12:25:00 AEST 2010 351 | changes: 352 | - Set file encoding to UTF-8 in LoadFile/DumpFile (RT#25434) by Olivier Mengue 353 | - We shouldn't have to care about 5.8.0. Since it's causing CPAN Testers 354 | failures, bump the minimum Perl to 5.8.1 355 | 356 | --- 357 | version: 0.70 358 | date: Tue Aug 11 02:52:10 AEST 2009 359 | changes: 360 | - Updated Module::Install dependency to 0.91 361 | - Bumping dependency to 5.8.0 but I think it's only in the test suite. 362 | However, I can't prove it. So if anyone wants 5.6 compatibility back 363 | you need to fix or rewrite the test suite. 364 | 365 | --- 366 | version: 0.69_02 367 | date: Mon Aug 10 22:37:37 AEST 2009 368 | changes: 369 | - Developer $VERSION now has eval correction 370 | 371 | --- 372 | version: 0.69_01 373 | date: Sun Jul 9 02:01:12 AEST 2009 374 | changes: 375 | - Added $VERSION to all modules 376 | - Removed the use of use base 377 | - Imported into the svn.ali.as repo 378 | 379 | --- 380 | version: 0.68 381 | date: Thu Dec 4 01:00:44 PST 2008 382 | changes: 383 | - Used update Test::Base to ensure Filter::Util::Call 384 | 385 | --- 386 | version: 0.67 387 | date: Mon Dec 1 02:34:21 PST 2008 388 | changes: 389 | - Add YAML::Any 390 | - Move ysh to YAML::Shell 391 | - Add doc section explaining YAML::Old 392 | 393 | --- 394 | version: 0.66 395 | date: Thu Sep 27 01:37:16 PDT 2007 396 | changes: 397 | - Blessed code refs with LoadCode=0 still get blessed. rafl++ 398 | 399 | --- 400 | version: 0.65 401 | date: Thu Jun 21 17:37:32 PDT 2007 402 | changes: 403 | - \z is really \0 404 | - Speed up regexp loading. audreyt++ 405 | 406 | --- 407 | version: 0.64 408 | date: Thu Jun 21 14:31:20 PDT 2007 409 | changes: 410 | - Better support for loading regexps. audreyt++ 411 | 412 | --- 413 | version: 0.63 414 | date: Wed Jun 20 16:03:22 PDT 2007 415 | changes: 416 | - Don't emit nodes blessed into '' in the new tag scheme, and improve semantics 417 | of loading such nodes. 418 | - New support for dumping/loading regexps. 419 | 420 | --- 421 | version: 0.62 422 | date: Mon Jul 3 15:41:20 PDT 2006 423 | changes: 424 | - Patch from rgs for Catalyst users 425 | 426 | --- 427 | version: 0.61 428 | date: Sun Jul 2 15:25:08 CDT 2006 429 | changes: 430 | - New CGI.pm made test fail. 431 | 432 | --- 433 | version: 0.60 434 | date: Fri Jun 30 21:55:55 CDT 2006 435 | changes: 436 | - Changed object tag format in non backwards compatible way 437 | - Removed support for folded scalar emission 438 | - Added new tests 439 | - Sync with YAML::Syck 440 | 441 | --- 442 | version: 0.58 443 | date: Tue Feb 14 12:42:34 PST 2006 444 | changes: 445 | - Fixed bug reported by Slaven Rezic on 5.8.0 446 | - Fixed a ysh bug reported on rt. 17589 447 | 448 | --- 449 | version: 0.57 450 | date: Wed Feb 1 23:06:25 PST 2006 451 | changes: 452 | - Add obligatory '1;' to end of each module. 453 | 454 | --- 455 | version: 0.56 456 | date: Mon Jan 30 10:26:33 PST 2006 457 | changes: 458 | - Add Module::Install::TestBase support 459 | 460 | --- 461 | version: 0.55 462 | date: Sun Jan 29 19:03:35 PST 2006 463 | changes: 464 | - Load YAML::Node because Module::Build expects it to be loaded. 465 | We can undo this when Module::Build starts loading it for itself. 466 | 467 | --- 468 | version: 0.54 469 | date: Sun Jan 29 17:28:46 PST 2006 470 | changes: 471 | - Remove dependency on Class::Spiffy (and/or Spiffy). 472 | 473 | --- 474 | version: 0.53 475 | date: Thu Jan 19 06:03:17 PST 2006 476 | changes: 477 | - Depend on Class::Spiffy instead of Spiffy. No source filtering. 478 | 479 | --- 480 | version: 0.52 481 | date: Wed Jan 18 14:25:24 PST 2006 482 | changes: 483 | - Error in Spiffy-0.26 causing problems. Require 0.27 484 | 485 | --- 486 | version: 0.51 487 | date: Sat Jan 14 17:09:09 GMT 2006 488 | changes: 489 | - Tests pass on win32 and cygwin 490 | - Don't gpg sign the distribution tarball 491 | 492 | --- 493 | version: 0.50 494 | date: Sun Dec 25 11:09:18 PST 2005 495 | changes: 496 | - Major refactoring of YAML.pm 497 | - Completely OO with same old functional UI 498 | - Support the $YAML::Stringify option which most be on for objects to get 499 | stringified. Otherwise dump the object. 500 | - Can dump overloaded objects now. 501 | - Completely refactor test suite using Test::Base 502 | - Create Test::YAML 503 | - Make test framework compatible with YAML::Syck - Test-Base-0.45 504 | - Reviewed all rt bugs. fixed many 505 | - Reviewed all emailed bugs. Fixed many. 506 | - Helped audrey complete YAML::Syck and worked on interoperability issues 507 | - Test well known yaml docs like svk and META.yml 508 | - Eliminate unsafe string evals 509 | - Can use with autouse. Spiffy-0.25 510 | - Support YAML::Marshall to help classes that want to do their own marshalling 511 | - Make objects tags configurable 512 | - -M option for ysh to test other implementations like YAML::Syck 513 | 514 | --- 515 | version: 0.39 516 | date: Tue Apr 12 15:28:40 PDT 2005 517 | changes: 518 | - Need newer Test::More or tests hang. 519 | 520 | --- 521 | version: 0.38 522 | date: Thu Mar 31 01:43:21 PST 2005 523 | changes: 524 | - Deleted Spiffy -XXX artifact :( 525 | 526 | --- 527 | version: 0.37 528 | date: Thu Mar 31 01:56:24 CST 2005 529 | changes: 530 | - All the edge cases with hash key dumping (commas, [], {}, etc) 531 | should now be covered 532 | 533 | --- 534 | version: 0.36 535 | date: Sun Jan 30 21:00:28 PST 2005 536 | changes: 537 | - Slight changes to the way things are dumped. 538 | - Fixed bugs dumping "foo\nbar" for svk acceptance 539 | 540 | --- 541 | version: 0.32 542 | date: Sat May 11 19:54:52 EDT 2002 543 | changes: 544 | - Moved error handling into YAML::Error 545 | - Enabled UseAliases=0 to mean skip Dump checking of alias nodes. 546 | - Changed Defaults. Indent=2. CompressSeries=1. 547 | - Deprecated Store() in favor of Dump() 548 | - Refactored test suite 549 | - Added key list to SortKeys 550 | - Added ForceBlock option 551 | - CONTROL-D can be used to terminate ysh. Ryan King will be happy. 552 | - Added the ability to direct STDIN to the ysh. 553 | 554 | --- 555 | version: 0.27 556 | date: Tue Jan 15 01:46:18 PST 2002 557 | changes: 558 | - Make '-' chomp all trailing newlines 559 | - Change folded indicator from '^' to ']'. 560 | - YAC-010 Allow a map as a sequence entry to be collapsed to one line. 561 | - Changed the nextline scalar indicators. '^' means folded, and escaping 562 | ('\') can be applied to folded or blocks. Chomping is now '-'. 563 | - YAC-013. Generic indentation. This change was big, ugly, hard and it really 564 | made my brain hurt. But look. It works! :) 565 | - YAC-012. Added ability to put comments anywhere, at any indentation level. 566 | - Added $YAML::UseBlock and $YAML::UseFold 567 | - Changed $YAML::PerlCode to $YAML::UseCode 568 | - Added $YAML::Indent config option 569 | - YAC-012. Handled all Throwaway Issues. Blank lines and comments can be used 570 | anywhere, and they will work appropriately. 571 | - Converted Changes file (this file) to use YAML 572 | - 'AC-016. Support "assumed header" (--- #YAML:1.0) if no header.' 573 | - Added $YAML::UseBlock option 574 | - YAC-015. Support Top Level Inline nodes 575 | - Added testing for Store to test suite. (Now there's no excuse not to 576 | create lot's of new tests. :) 577 | 578 | --- 579 | version: 0.26 580 | date: Wed Jan 9 21:13:45 PST 2002 581 | changes: 582 | - Detect implicit scalars more correctly 583 | - Refactor test suite 584 | - Proofed documentation 585 | - Fix ysh doc. Document flags in the pod. 586 | - Move test code out of YAML.pm and into testlib 587 | - 'Change directives to use #' 588 | - Parse regexes 589 | - YAC-017. Change !perl/ syntax 590 | - Emit regexes 591 | - support 'ysh -v' and 'ysh -V' and 'ysh -h' 592 | - Support blessed globs 593 | - Make ysh installable 594 | - Parse CODE leaves 595 | - Support blessed scalars 596 | - Test warnings as well as errors 597 | - Use B::Deparse to serialize code 598 | - Change 'implicit' to 'simple' 599 | 600 | --- 601 | version: 0.25 602 | date: Wed Dec 19 02:34:38 PST 2001 603 | changes: 604 | - Initial module shipped to CPAN 605 | 606 | --- 607 | version: 0.01 608 | date: Mon Oct 15 19:18:49 2001 609 | changes: 610 | - original version; created by h2xs 1.19 611 | -------------------------------------------------------------------------------- /Meta: -------------------------------------------------------------------------------- 1 | =meta: 0.0.2 2 | 3 | name: YAML 4 | version: 1.31 5 | abstract: YAML Ain't Markup Language™ 6 | homepage: http://yaml.org 7 | language: perl 8 | license: perl 9 | copyright: 2001-2023 10 | 11 | author: 12 | name: Ingy döt Net 13 | email: ingy@cpan.org 14 | homepage: http://ingy.net 15 | github: ingydotnet 16 | twitter: ingydotnet 17 | freenode: ingy 18 | 19 | devel: 20 | git: https://github.com/ingydotnet/yaml-pm 21 | bug: https://github.com/ingydotnet/yaml-pm/issues 22 | irc: irc.perl.org#yaml 23 | 24 | requires: 25 | perl: 5.8.1 26 | 27 | test: 28 | requires: 29 | Test::YAML: 1.05 30 | Test::More: 0.88 31 | Test::Deep: 0 32 | Encode: 0 33 | 34 | =zild: 35 | no-about: true 36 | no-travis: true 37 | -------------------------------------------------------------------------------- /doc/YAML/Any.swim: -------------------------------------------------------------------------------- 1 | YAML::Any 2 | ========= 3 | 4 | Pick a YAML implementation and use it. 5 | 6 | = Status 7 | 8 | WARNING: This module will soon be deprecated. The plan is that YAML.pm itself 9 | will act like an /Any/ module. 10 | 11 | = Synopsis 12 | 13 | use YAML::Any; 14 | $YAML::Indent = 3; 15 | my $yaml = Dump(@objects); 16 | 17 | = Description 18 | 19 | There are several YAML implementations that support the Dump/Load API. This 20 | module selects the best one available and uses it. 21 | 22 | = Order 23 | 24 | Currently, YAML::Any will choose the first one of these YAML implementations 25 | that is installed on your system: 26 | 27 | * YAML::XS 28 | * YAML::Syck 29 | * YAML::Old 30 | * YAML 31 | * YAML::Tiny 32 | 33 | = Options 34 | 35 | If you specify an option like: 36 | 37 | $YAML::Indent = 4; 38 | 39 | And YAML::Any is using YAML::XS, it will use the proper variable: 40 | $YAML::XS::Indent. 41 | 42 | = Subroutines 43 | 44 | Like all the YAML modules that YAML::Any uses, the following subroutines are 45 | exported by default: 46 | 47 | * Dump 48 | * Load 49 | 50 | and the following subroutines are exportable by request: 51 | 52 | * DumpFile 53 | * LoadFile 54 | 55 | = Methods 56 | 57 | YAML::Any provides the following class methods. 58 | 59 | - `YAML::Any->order` 60 | 61 | This method returns a list of the current possible implementations that 62 | YAML::Any will search for. 63 | 64 | - `YAML::Any->implementation` 65 | 66 | This method returns the implementation the YAML::Any will use. This result 67 | is obtained by finding the first member of YAML::Any->order that is either 68 | already loaded in `%INC` or that can be loaded using `require`. If no 69 | implementation is found, an error will be thrown. 70 | 71 | = Examples 72 | 73 | == DumpFile and LoadFile 74 | 75 | Here is an example for `DumpFile`: 76 | 77 | #!/usr/bin/perl 78 | 79 | use strict; 80 | use warnings; 81 | 82 | use YAML::Any qw(DumpFile); 83 | 84 | my $ds = 85 | { 86 | array => [5,6,100], 87 | string => "Hello", 88 | }; 89 | 90 | DumpFile("hello.yml", $ds); 91 | 92 | When run, this creates a file called `hello.yml` in the current working 93 | directory, with the following contents. 94 | 95 | --- 96 | array: 97 | - 5 98 | - 6 99 | - 100 100 | string: Hello 101 | 102 | In turn, the following `LoadFile` example, loads the contents from there and 103 | accesses them: 104 | 105 | #!/usr/bin/perl 106 | 107 | use strict; 108 | use warnings; 109 | 110 | use YAML::Any qw(LoadFile); 111 | 112 | my ($ds) = LoadFile("hello.yml"); 113 | 114 | print "String == '", $ds->{string}, "'\n"; 115 | 116 | Assuming `hello.yml` exists, and is as created by the `DumpFile` example, it 117 | prints: 118 | 119 | $ perl load.pl 120 | String == 'Hello' 121 | $ 122 | 123 | = Author 124 | 125 | Ingy döt Net 126 | 127 | = Copyright 128 | 129 | Copyright 2001-2014. Ingy döt Net 130 | 131 | This program is free software; you can redistribute it and/or modify it under 132 | the same terms as Perl itself. 133 | 134 | See http://www.perl.com/perl/misc/Artistic.html 135 | -------------------------------------------------------------------------------- /doc/YAML/Dumper.swim: -------------------------------------------------------------------------------- 1 | YAML::Dumper 2 | ============ 3 | 4 | YAML class for dumping Perl objects to YAML 5 | 6 | = Synopsis 7 | 8 | use YAML::Dumper; 9 | my $dumper = YAML::Dumper->new; 10 | $dumper->indent_width(4); 11 | print $dumper->dump({foo => 'bar'}); 12 | 13 | = Description 14 | 15 | YAML::Dumper is the module that YAML.pm used to serialize Perl objects to 16 | YAML. It is fully object oriented and usable on its own. 17 | 18 | = Author 19 | 20 | Ingy döt Net 21 | 22 | = Copyright 23 | 24 | Copyright 2001-2014. Ingy döt Net 25 | 26 | This program is free software; you can redistribute it and/or modify it under 27 | the same terms as Perl itself. 28 | 29 | See http://www.perl.com/perl/misc/Artistic.html 30 | -------------------------------------------------------------------------------- /doc/YAML/Dumper/Base.swim: -------------------------------------------------------------------------------- 1 | YAML::Dumper::Base 2 | ================== 3 | 4 | Base class for YAML Dumper classes 5 | 6 | = Synopsis 7 | 8 | package YAML::Dumper::Something; 9 | use YAML::Dumper::Base -base; 10 | 11 | = Description 12 | 13 | YAML::Dumper::Base is a base class for creating YAML dumper classes. 14 | 15 | = Author 16 | 17 | Ingy döt Net 18 | 19 | = Copyright 20 | 21 | Copyright 2001-2014. Ingy döt Net 22 | 23 | This program is free software; you can redistribute it and/or modify it under 24 | the same terms as Perl itself. 25 | 26 | See http://www.perl.com/perl/misc/Artistic.html 27 | -------------------------------------------------------------------------------- /doc/YAML/Error.swim: -------------------------------------------------------------------------------- 1 | YAML::Error 2 | =========== 3 | 4 | Error formatting class for YAML modules 5 | 6 | = Synopsis 7 | 8 | $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias); 9 | $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY'); 10 | 11 | = Description 12 | 13 | This module provides a `die` and a `warn` facility. 14 | 15 | = Author 16 | 17 | Ingy döt Net 18 | 19 | = Copyright 20 | 21 | Copyright 2001-2014. Ingy döt Net 22 | 23 | This program is free software; you can redistribute it and/or modify it under 24 | the same terms as Perl itself. 25 | 26 | See http://www.perl.com/perl/misc/Artistic.html 27 | -------------------------------------------------------------------------------- /doc/YAML/Loader.swim: -------------------------------------------------------------------------------- 1 | YAML::Loader 2 | ============ 3 | 4 | YAML class for loading Perl objects to YAML 5 | 6 | = Synopsis 7 | 8 | use YAML::Loader; 9 | my $loader = YAML::Loader->new; 10 | my $hash = $loader->load(<<'...'); 11 | foo: bar 12 | ... 13 | 14 | = Description 15 | 16 | YAML::Loader is the module that YAML.pm used to deserialize YAML to Perl 17 | objects. It is fully object oriented and usable on its own. 18 | 19 | = Author 20 | 21 | Ingy döt Net 22 | 23 | = Copyright 24 | 25 | Copyright 2001-2014. Ingy döt Net 26 | 27 | This program is free software; you can redistribute it and/or modify it under 28 | the same terms as Perl itself. 29 | 30 | See http://www.perl.com/perl/misc/Artistic.html 31 | -------------------------------------------------------------------------------- /doc/YAML/Loader/Base.swim: -------------------------------------------------------------------------------- 1 | YAML::Loader::Base 2 | ================== 3 | 4 | Base class for YAML Loader classes 5 | 6 | = Synopsis 7 | 8 | package YAML::Loader::Something; 9 | use YAML::Loader::Base -base; 10 | 11 | = Description 12 | 13 | YAML::Loader::Base is a base class for creating YAML loader classes. 14 | 15 | = Author 16 | 17 | Ingy döt Net 18 | 19 | = Copyright 20 | 21 | Copyright 2001-2014. Ingy döt Net 22 | 23 | This program is free software; you can redistribute it and/or modify it under 24 | the same terms as Perl itself. 25 | 26 | See http://www.perl.com/perl/misc/Artistic.html 27 | -------------------------------------------------------------------------------- /doc/YAML/Marshall.swim: -------------------------------------------------------------------------------- 1 | YAML::Marshall 2 | ============== 3 | 4 | YAML marshalling class you can mixin to your classes 5 | 6 | = Synopsis 7 | 8 | package Bar; 9 | use Foo -base; 10 | use YAML::Marshall -mixin; 11 | 12 | = Description 13 | 14 | For classes that want to handle their own YAML serialization. 15 | 16 | = Author 17 | 18 | ingy döt Net 19 | 20 | = Copyright 21 | 22 | Copyright 2001-2014. Ingy döt Net 23 | 24 | This program is free software; you can redistribute it and/or modify it under 25 | the same terms as Perl itself. 26 | 27 | See http://www.perl.com/perl/misc/Artistic.html 28 | -------------------------------------------------------------------------------- /doc/YAML/Node.swim: -------------------------------------------------------------------------------- 1 | YAML::Node 2 | ========== 3 | 4 | A generic data node that encapsulates YAML information 5 | 6 | = Synopsis 7 | 8 | use YAML; 9 | use YAML::Node; 10 | 11 | my $ynode = YAML::Node->new({}, 'ingerson.com/fruit'); 12 | %$ynode = qw(orange orange apple red grape green); 13 | print Dump $ynode; 14 | 15 | yields: 16 | 17 | --- !ingerson.com/fruit 18 | orange: orange 19 | apple: red 20 | grape: green 21 | 22 | = Description 23 | 24 | A generic node in YAML is similar to a plain hash, array, or scalar node in 25 | Perl except that it must also keep track of its type. The type is a URI called 26 | the YAML type tag. 27 | 28 | YAML::Node is a class for generating and manipulating these containers. A 29 | YAML node (or ynode) is a tied hash, array or scalar. In most ways it behaves 30 | just like the plain thing. But you can assign and retrieve and YAML type tag 31 | URI to it. For the hash flavor, you can also assign the order that the keys 32 | will be retrieved in. By default a ynode will offer its keys in the same order 33 | that they were assigned. 34 | 35 | YAML::Node has a class method call new() that will return a ynode. You pass it 36 | a regular node and an optional type tag. After that you can use it like a 37 | normal Perl node, but when you YAML::Dump it, the magical properties will be 38 | honored. 39 | 40 | This is how you can control the sort order of hash keys during a YAML 41 | serialization. By default, YAML sorts keys alphabetically. But notice in the 42 | above example that the keys were Dumped in the same order they were assigned. 43 | 44 | YAML::Node exports a function called ynode(). This function returns the tied 45 | object so that you can call special methods on it like ->keys(). 46 | 47 | keys() works like this: 48 | 49 | use YAML; 50 | use YAML::Node; 51 | 52 | %$node = qw(orange orange apple red grape green); 53 | $ynode = YAML::Node->new($node); 54 | ynode($ynode)->keys(['grape', 'apple']); 55 | print Dump $ynode; 56 | 57 | produces: 58 | 59 | --- 60 | grape: green 61 | apple: red 62 | 63 | It tells the ynode which keys and what order to use. 64 | 65 | ynodes will play a very important role in how programs use YAML. They are the 66 | foundation of how a Perl class can marshall the Loading and Dumping of its 67 | objects. 68 | 69 | The upcoming versions of YAML.pm will have much more information on this. 70 | 71 | = Author 72 | 73 | Ingy döt Net 74 | 75 | = Copyright 76 | 77 | Copyright 2001-2014. Ingy döt Net 78 | 79 | This program is free software; you can redistribute it and/or modify it under 80 | the same terms as Perl itself. 81 | 82 | See http://www.perl.com/perl/misc/Artistic.html 83 | -------------------------------------------------------------------------------- /doc/YAML/Tag.swim: -------------------------------------------------------------------------------- 1 | YAML::Tag 2 | ========= 3 | 4 | Tag URI object class for YAML 5 | 6 | = Synopsis 7 | 8 | use YAML::Tag; 9 | 10 | = Description 11 | 12 | Used by YAML::Node. 13 | 14 | = Author 15 | 16 | ingy döt Net 17 | 18 | = Copyright 19 | 20 | Copyright 2001-2014. Ingy döt Net 21 | 22 | This program is free software; you can redistribute it and/or modify it under 23 | the same terms as Perl itself. 24 | 25 | See http://www.perl.com/perl/misc/Artistic.html 26 | -------------------------------------------------------------------------------- /doc/YAML/Types.swim: -------------------------------------------------------------------------------- 1 | YAML::Types 2 | =========== 3 | 4 | Marshall Perl internal data types to/from YAML 5 | 6 | = Synopsis 7 | 8 | $::foo = 42; 9 | print YAML::Dump(*::foo); 10 | 11 | print YAML::Dump(qr{match me}); 12 | 13 | = Description 14 | 15 | This module has the helper classes for transferring objects, subroutines, 16 | references, globs, regexps and file handles to and from YAML. 17 | 18 | = Author 19 | 20 | ingy döt Net 21 | 22 | = Copyright 23 | 24 | Copyright 2001-2014. Ingy döt Net 25 | 26 | This program is free software; you can redistribute it and/or modify it under 27 | the same terms as Perl itself. 28 | 29 | See http://www.perl.com/perl/misc/Artistic.html 30 | -------------------------------------------------------------------------------- /lib/YAML.pm: -------------------------------------------------------------------------------- 1 | package YAML; 2 | our $VERSION = '1.31'; 3 | 4 | use YAML::Mo; 5 | 6 | use Exporter; 7 | push @YAML::ISA, 'Exporter'; 8 | our @EXPORT = qw{ Dump Load }; 9 | our @EXPORT_OK = qw{ freeze thaw DumpFile LoadFile Bless Blessed }; 10 | our ( 11 | $UseCode, $DumpCode, $LoadCode, 12 | $SpecVersion, 13 | $UseHeader, $UseVersion, $UseBlock, $UseFold, $UseAliases, 14 | $Indent, $SortKeys, $Preserve, 15 | $AnchorPrefix, $CompressSeries, $InlineSeries, $Purity, 16 | $Stringify, $Numify, $LoadBlessed, $QuoteNumericStrings, 17 | $DumperClass, $LoaderClass 18 | ); 19 | 20 | use YAML::Node; # XXX This is a temp fix for Module::Build 21 | use Scalar::Util qw/ openhandle /; 22 | 23 | # XXX This VALUE nonsense needs to go. 24 | use constant VALUE => "\x07YAML\x07VALUE\x07"; 25 | 26 | # YAML Object Properties 27 | has dumper_class => default => sub {'YAML::Dumper'}; 28 | has loader_class => default => sub {'YAML::Loader'}; 29 | has dumper_object => default => sub {$_[0]->init_action_object("dumper")}; 30 | has loader_object => default => sub {$_[0]->init_action_object("loader")}; 31 | 32 | sub Dump { 33 | my $yaml = YAML->new; 34 | $yaml->dumper_class($YAML::DumperClass) 35 | if $YAML::DumperClass; 36 | return $yaml->dumper_object->dump(@_); 37 | } 38 | 39 | sub Load { 40 | my $yaml = YAML->new; 41 | $yaml->loader_class($YAML::LoaderClass) 42 | if $YAML::LoaderClass; 43 | return $yaml->loader_object->load(@_); 44 | } 45 | 46 | { 47 | no warnings 'once'; 48 | # freeze/thaw is the API for Storable string serialization. Some 49 | # modules make use of serializing packages on if they use freeze/thaw. 50 | *freeze = \ &Dump; 51 | *thaw = \ &Load; 52 | } 53 | 54 | sub DumpFile { 55 | my $OUT; 56 | my $filename = shift; 57 | if (openhandle $filename) { 58 | $OUT = $filename; 59 | } 60 | else { 61 | my $mode = '>'; 62 | if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) { 63 | ($mode, $filename) = ($1, $2); 64 | } 65 | open $OUT, $mode, $filename 66 | or YAML::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT', $filename, "$!"); 67 | } 68 | binmode $OUT, ':utf8'; # if $Config{useperlio} eq 'define'; 69 | local $/ = "\n"; # reset special to "sane" 70 | print $OUT Dump(@_); 71 | unless (ref $filename eq 'GLOB') { 72 | close $OUT 73 | or do { 74 | my $errsav = $!; 75 | YAML::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT_CLOSE', $filename, $errsav); 76 | } 77 | } 78 | } 79 | 80 | sub LoadFile { 81 | my $IN; 82 | my $filename = shift; 83 | if (openhandle $filename) { 84 | $IN = $filename; 85 | } 86 | else { 87 | open $IN, '<', $filename 88 | or YAML::Mo::Object->die('YAML_LOAD_ERR_FILE_INPUT', $filename, "$!"); 89 | } 90 | binmode $IN, ':utf8'; # if $Config{useperlio} eq 'define'; 91 | return Load(do { local $/; <$IN> }); 92 | } 93 | 94 | sub init_action_object { 95 | my $self = shift; 96 | my $object_class = (shift) . '_class'; 97 | my $module_name = $self->$object_class; 98 | eval "require $module_name"; 99 | $self->die("Error in require $module_name - $@") 100 | if $@ and "$@" !~ /Can't locate/; 101 | my $object = $self->$object_class->new; 102 | $object->set_global_options; 103 | return $object; 104 | } 105 | 106 | my $global = {}; 107 | sub Bless { 108 | require YAML::Dumper::Base; 109 | YAML::Dumper::Base::bless($global, @_) 110 | } 111 | sub Blessed { 112 | require YAML::Dumper::Base; 113 | YAML::Dumper::Base::blessed($global, @_) 114 | } 115 | sub global_object { $global } 116 | 117 | 1; 118 | -------------------------------------------------------------------------------- /lib/YAML/Any.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package YAML::Any; 3 | our $VERSION = '1.31'; 4 | 5 | use Exporter (); 6 | 7 | @YAML::Any::ISA = 'Exporter'; 8 | @YAML::Any::EXPORT = qw(Dump Load); 9 | @YAML::Any::EXPORT_OK = qw(DumpFile LoadFile); 10 | 11 | my @dump_options = qw( 12 | UseCode 13 | DumpCode 14 | SpecVersion 15 | Indent 16 | UseHeader 17 | UseVersion 18 | SortKeys 19 | AnchorPrefix 20 | UseBlock 21 | UseFold 22 | CompressSeries 23 | InlineSeries 24 | UseAliases 25 | Purity 26 | Stringify 27 | ); 28 | 29 | my @load_options = qw( 30 | UseCode 31 | LoadCode 32 | Preserve 33 | ); 34 | 35 | my @implementations = qw( 36 | YAML::XS 37 | YAML::Syck 38 | YAML::Old 39 | YAML 40 | YAML::Tiny 41 | ); 42 | 43 | sub import { 44 | __PACKAGE__->implementation; 45 | goto &Exporter::import; 46 | } 47 | 48 | sub Dump { 49 | no strict 'refs'; 50 | no warnings 'once'; 51 | my $implementation = __PACKAGE__->implementation; 52 | for my $option (@dump_options) { 53 | my $var = "$implementation\::$option"; 54 | my $value = $$var; 55 | local $$var; 56 | $$var = defined $value ? $value : ${"YAML::$option"}; 57 | } 58 | return &{"$implementation\::Dump"}(@_); 59 | } 60 | 61 | sub DumpFile { 62 | no strict 'refs'; 63 | no warnings 'once'; 64 | my $implementation = __PACKAGE__->implementation; 65 | for my $option (@dump_options) { 66 | my $var = "$implementation\::$option"; 67 | my $value = $$var; 68 | local $$var; 69 | $$var = defined $value ? $value : ${"YAML::$option"}; 70 | } 71 | return &{"$implementation\::DumpFile"}(@_); 72 | } 73 | 74 | sub Load { 75 | no strict 'refs'; 76 | no warnings 'once'; 77 | my $implementation = __PACKAGE__->implementation; 78 | for my $option (@load_options) { 79 | my $var = "$implementation\::$option"; 80 | my $value = $$var; 81 | local $$var; 82 | $$var = defined $value ? $value : ${"YAML::$option"}; 83 | } 84 | return &{"$implementation\::Load"}(@_); 85 | } 86 | 87 | sub LoadFile { 88 | no strict 'refs'; 89 | no warnings 'once'; 90 | my $implementation = __PACKAGE__->implementation; 91 | for my $option (@load_options) { 92 | my $var = "$implementation\::$option"; 93 | my $value = $$var; 94 | local $$var; 95 | $$var = defined $value ? $value : ${"YAML::$option"}; 96 | } 97 | return &{"$implementation\::LoadFile"}(@_); 98 | } 99 | 100 | sub order { 101 | return @YAML::Any::_TEST_ORDER 102 | if @YAML::Any::_TEST_ORDER; 103 | return @implementations; 104 | } 105 | 106 | sub implementation { 107 | my @order = __PACKAGE__->order; 108 | for my $module (@order) { 109 | my $path = $module; 110 | $path =~ s/::/\//g; 111 | $path .= '.pm'; 112 | return $module if exists $INC{$path}; 113 | eval "require $module; 1" and return $module; 114 | } 115 | croak("YAML::Any couldn't find any of these YAML implementations: @order"); 116 | } 117 | 118 | sub croak { 119 | require Carp; 120 | Carp::croak(@_); 121 | } 122 | 123 | 1; 124 | -------------------------------------------------------------------------------- /lib/YAML/Dumper.pm: -------------------------------------------------------------------------------- 1 | package YAML::Dumper; 2 | 3 | use YAML::Mo; 4 | extends 'YAML::Dumper::Base'; 5 | 6 | use YAML::Dumper::Base; 7 | use YAML::Node; 8 | use YAML::Types; 9 | use Scalar::Util qw(); 10 | use B (); 11 | use Carp (); 12 | 13 | # Context constants 14 | use constant KEY => 3; 15 | use constant BLESSED => 4; 16 | use constant FROMARRAY => 5; 17 | use constant VALUE => "\x07YAML\x07VALUE\x07"; 18 | 19 | # Common YAML character sets 20 | my $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]'; 21 | my $LIT_CHAR = '|'; 22 | 23 | #============================================================================== 24 | # OO version of Dump. YAML->new->dump($foo); 25 | sub dump { 26 | my $self = shift; 27 | $self->stream(''); 28 | $self->document(0); 29 | for my $document (@_) { 30 | $self->{document}++; 31 | $self->transferred({}); 32 | $self->id_refcnt({}); 33 | $self->id_anchor({}); 34 | $self->anchor(1); 35 | $self->level(0); 36 | $self->offset->[0] = 0 - $self->indent_width; 37 | $self->_prewalk($document); 38 | $self->_emit_header($document); 39 | $self->_emit_node($document); 40 | } 41 | return $self->stream; 42 | } 43 | 44 | # Every YAML document in the stream must begin with a YAML header, unless 45 | # there is only a single document and the user requests "no header". 46 | sub _emit_header { 47 | my $self = shift; 48 | my ($node) = @_; 49 | if (not $self->use_header and 50 | $self->document == 1 51 | ) { 52 | $self->die('YAML_DUMP_ERR_NO_HEADER') 53 | unless ref($node) =~ /^(HASH|ARRAY)$/; 54 | $self->die('YAML_DUMP_ERR_NO_HEADER') 55 | if ref($node) eq 'HASH' and keys(%$node) == 0; 56 | $self->die('YAML_DUMP_ERR_NO_HEADER') 57 | if ref($node) eq 'ARRAY' and @$node == 0; 58 | # XXX Also croak if aliased, blessed, or ynode 59 | $self->headless(1); 60 | return; 61 | } 62 | $self->{stream} .= '---'; 63 | # XXX Consider switching to 1.1 style 64 | if ($self->use_version) { 65 | # $self->{stream} .= " #YAML:1.0"; 66 | } 67 | } 68 | 69 | # Walk the tree to be dumped and keep track of its reference counts. 70 | # This function is where the Dumper does all its work. All type 71 | # transfers happen here. 72 | sub _prewalk { 73 | my $self = shift; 74 | my $stringify = $self->stringify; 75 | my ($class, $type, $node_id) = $self->node_info(\$_[0], $stringify); 76 | 77 | # Handle typeglobs 78 | if ($type eq 'GLOB') { 79 | $self->transferred->{$node_id} = 80 | YAML::Type::glob->yaml_dump($_[0]); 81 | $self->_prewalk($self->transferred->{$node_id}); 82 | return; 83 | } 84 | 85 | # Handle regexps 86 | if (ref($_[0]) eq 'Regexp') { 87 | return; 88 | } 89 | 90 | # Handle Purity for scalars. 91 | # XXX can't find a use case yet. Might be YAGNI. 92 | if (not ref $_[0]) { 93 | $self->{id_refcnt}{$node_id}++ if $self->purity; 94 | return; 95 | } 96 | 97 | # Make a copy of original 98 | my $value = $_[0]; 99 | ($class, $type, $node_id) = $self->node_info($value, $stringify); 100 | 101 | # Must be a stringified object. 102 | return if (ref($value) and not $type); 103 | 104 | # Look for things already transferred. 105 | if ($self->transferred->{$node_id}) { 106 | (undef, undef, $node_id) = (ref $self->transferred->{$node_id}) 107 | ? $self->node_info($self->transferred->{$node_id}, $stringify) 108 | : $self->node_info(\ $self->transferred->{$node_id}, $stringify); 109 | $self->{id_refcnt}{$node_id}++; 110 | return; 111 | } 112 | 113 | # Handle code refs 114 | if ($type eq 'CODE') { 115 | $self->transferred->{$node_id} = 'placeholder'; 116 | YAML::Type::code->yaml_dump( 117 | $self->dump_code, 118 | $_[0], 119 | $self->transferred->{$node_id} 120 | ); 121 | ($class, $type, $node_id) = 122 | $self->node_info(\ $self->transferred->{$node_id}, $stringify); 123 | $self->{id_refcnt}{$node_id}++; 124 | return; 125 | } 126 | 127 | # Handle blessed things 128 | if (defined $class) { 129 | if ($value->can('yaml_dump')) { 130 | $value = $value->yaml_dump; 131 | } 132 | elsif ($type eq 'SCALAR') { 133 | $self->transferred->{$node_id} = 'placeholder'; 134 | YAML::Type::blessed->yaml_dump 135 | ($_[0], $self->transferred->{$node_id}); 136 | ($class, $type, $node_id) = 137 | $self->node_info(\ $self->transferred->{$node_id}, $stringify); 138 | $self->{id_refcnt}{$node_id}++; 139 | return; 140 | } 141 | else { 142 | $value = YAML::Type::blessed->yaml_dump($value); 143 | } 144 | $self->transferred->{$node_id} = $value; 145 | (undef, $type, $node_id) = $self->node_info($value, $stringify); 146 | } 147 | 148 | # Handle YAML Blessed things 149 | require YAML; 150 | if (defined YAML->global_object()->{blessed_map}{$node_id}) { 151 | $value = YAML->global_object()->{blessed_map}{$node_id}; 152 | $self->transferred->{$node_id} = $value; 153 | ($class, $type, $node_id) = $self->node_info($value, $stringify); 154 | $self->_prewalk($value); 155 | return; 156 | } 157 | 158 | # Handle hard refs 159 | if ($type eq 'REF' or $type eq 'SCALAR') { 160 | $value = YAML::Type::ref->yaml_dump($value); 161 | $self->transferred->{$node_id} = $value; 162 | (undef, $type, $node_id) = $self->node_info($value, $stringify); 163 | } 164 | 165 | # Handle ref-to-glob's 166 | elsif ($type eq 'GLOB') { 167 | my $ref_ynode = $self->transferred->{$node_id} = 168 | YAML::Type::ref->yaml_dump($value); 169 | 170 | my $glob_ynode = $ref_ynode->{&VALUE} = 171 | YAML::Type::glob->yaml_dump($$value); 172 | 173 | (undef, undef, $node_id) = $self->node_info($glob_ynode, $stringify); 174 | $self->transferred->{$node_id} = $glob_ynode; 175 | $self->_prewalk($glob_ynode); 176 | return; 177 | } 178 | 179 | # Increment ref count for node 180 | return if ++($self->{id_refcnt}{$node_id}) > 1; 181 | 182 | # Keep on walking 183 | if ($type eq 'HASH') { 184 | $self->_prewalk($value->{$_}) 185 | for keys %{$value}; 186 | return; 187 | } 188 | elsif ($type eq 'ARRAY') { 189 | $self->_prewalk($_) 190 | for @{$value}; 191 | return; 192 | } 193 | 194 | # Unknown type. Need to know about it. 195 | $self->warn(<<"..."); 196 | YAML::Dumper can't handle dumping this type of data. 197 | Please report this to the author. 198 | 199 | id: $node_id 200 | type: $type 201 | class: $class 202 | value: $value 203 | 204 | ... 205 | 206 | return; 207 | } 208 | 209 | # Every data element and sub data element is a node. 210 | # Everything emitted goes through this function. 211 | sub _emit_node { 212 | my $self = shift; 213 | my ($type, $node_id); 214 | my $ref = ref($_[0]); 215 | if ($ref) { 216 | if ($ref eq 'Regexp') { 217 | $self->_emit(' !!perl/regexp'); 218 | $self->_emit_str("$_[0]"); 219 | return; 220 | } 221 | (undef, $type, $node_id) = $self->node_info($_[0], $self->stringify); 222 | } 223 | else { 224 | $type = $ref || 'SCALAR'; 225 | (undef, undef, $node_id) = $self->node_info(\$_[0], $self->stringify); 226 | } 227 | 228 | my ($ynode, $tag) = ('') x 2; 229 | my ($value, $context) = (@_, 0); 230 | 231 | if (defined $self->transferred->{$node_id}) { 232 | $value = $self->transferred->{$node_id}; 233 | $ynode = ynode($value); 234 | if (ref $value) { 235 | $tag = defined $ynode ? $ynode->tag->short : ''; 236 | (undef, $type, $node_id) = 237 | $self->node_info($value, $self->stringify); 238 | } 239 | else { 240 | $ynode = ynode($self->transferred->{$node_id}); 241 | $tag = defined $ynode ? $ynode->tag->short : ''; 242 | $type = 'SCALAR'; 243 | (undef, undef, $node_id) = 244 | $self->node_info( 245 | \ $self->transferred->{$node_id}, 246 | $self->stringify 247 | ); 248 | } 249 | } 250 | elsif ($ynode = ynode($value)) { 251 | $tag = $ynode->tag->short; 252 | } 253 | 254 | if ($self->use_aliases) { 255 | $self->{id_refcnt}{$node_id} ||= 0; 256 | if ($self->{id_refcnt}{$node_id} > 1) { 257 | if (defined $self->{id_anchor}{$node_id}) { 258 | $self->{stream} .= ' *' . $self->{id_anchor}{$node_id} . "\n"; 259 | return; 260 | } 261 | my $anchor = $self->anchor_prefix . $self->{anchor}++; 262 | $self->{stream} .= ' &' . $anchor; 263 | $self->{id_anchor}{$node_id} = $anchor; 264 | } 265 | } 266 | 267 | return $self->_emit_str("$value") # Stringified object 268 | if ref($value) and not $type; 269 | return $self->_emit_scalar($value, $tag) 270 | if $type eq 'SCALAR' and $tag; 271 | return $self->_emit_str($value) 272 | if $type eq 'SCALAR'; 273 | return $self->_emit_mapping($value, $tag, $node_id, $context) 274 | if $type eq 'HASH'; 275 | return $self->_emit_sequence($value, $tag) 276 | if $type eq 'ARRAY'; 277 | $self->warn('YAML_DUMP_WARN_BAD_NODE_TYPE', $type); 278 | return $self->_emit_str("$value"); 279 | } 280 | 281 | # A YAML mapping is akin to a Perl hash. 282 | sub _emit_mapping { 283 | my $self = shift; 284 | my ($value, $tag, $node_id, $context) = @_; 285 | $self->{stream} .= " !$tag" if $tag; 286 | 287 | # Sometimes 'keys' fails. Like on a bad tie implementation. 288 | my $empty_hash = not(eval {keys %$value}); 289 | $self->warn('YAML_EMIT_WARN_KEYS', $@) if $@; 290 | return ($self->{stream} .= " {}\n") if $empty_hash; 291 | 292 | # If CompressSeries is on (default) and legal is this context, then 293 | # use it and make the indent level be 2 for this node. 294 | if ($context == FROMARRAY and 295 | $self->compress_series and 296 | not (defined $self->{id_anchor}{$node_id} or $tag or $empty_hash) 297 | ) { 298 | $self->{stream} .= ' '; 299 | $self->offset->[$self->level+1] = $self->offset->[$self->level] + 2; 300 | } 301 | else { 302 | $context = 0; 303 | $self->{stream} .= "\n" 304 | unless $self->headless && not($self->headless(0)); 305 | $self->offset->[$self->level+1] = 306 | $self->offset->[$self->level] + $self->indent_width; 307 | } 308 | 309 | $self->{level}++; 310 | my @keys; 311 | if ($self->sort_keys == 1) { 312 | if (ynode($value)) { 313 | @keys = keys %$value; 314 | } 315 | else { 316 | @keys = sort keys %$value; 317 | } 318 | } 319 | elsif ($self->sort_keys == 2) { 320 | @keys = sort keys %$value; 321 | } 322 | # XXX This is hackish but sometimes handy. Not sure whether to leave it in. 323 | elsif (ref($self->sort_keys) eq 'ARRAY') { 324 | my $i = 1; 325 | my %order = map { ($_, $i++) } @{$self->sort_keys}; 326 | @keys = sort { 327 | (defined $order{$a} and defined $order{$b}) 328 | ? ($order{$a} <=> $order{$b}) 329 | : ($a cmp $b); 330 | } keys %$value; 331 | } 332 | else { 333 | @keys = keys %$value; 334 | } 335 | # Force the YAML::VALUE ('=') key to sort last. 336 | if (exists $value->{&VALUE}) { 337 | for (my $i = 0; $i < @keys; $i++) { 338 | if ($keys[$i] eq &VALUE) { 339 | splice(@keys, $i, 1); 340 | push @keys, &VALUE; 341 | last; 342 | } 343 | } 344 | } 345 | 346 | for my $key (@keys) { 347 | $self->_emit_key($key, $context); 348 | $context = 0; 349 | $self->{stream} .= ':'; 350 | $self->_emit_node($value->{$key}); 351 | } 352 | $self->{level}--; 353 | } 354 | 355 | # A YAML series is akin to a Perl array. 356 | sub _emit_sequence { 357 | my $self = shift; 358 | my ($value, $tag) = @_; 359 | $self->{stream} .= " !$tag" if $tag; 360 | 361 | return ($self->{stream} .= " []\n") if @$value == 0; 362 | 363 | $self->{stream} .= "\n" 364 | unless $self->headless && not($self->headless(0)); 365 | 366 | # XXX Really crufty feature. Better implemented by ynodes. 367 | if ($self->inline_series and 368 | @$value <= $self->inline_series and 369 | not (scalar grep {ref or /\n/} @$value) 370 | ) { 371 | $self->{stream} =~ s/\n\Z/ /; 372 | $self->{stream} .= '['; 373 | for (my $i = 0; $i < @$value; $i++) { 374 | $self->_emit_str($value->[$i], KEY); 375 | last if $i == $#{$value}; 376 | $self->{stream} .= ', '; 377 | } 378 | $self->{stream} .= "]\n"; 379 | return; 380 | } 381 | 382 | $self->offset->[$self->level + 1] = 383 | $self->offset->[$self->level] + $self->indent_width; 384 | $self->{level}++; 385 | for my $val (@$value) { 386 | $self->{stream} .= ' ' x $self->offset->[$self->level]; 387 | $self->{stream} .= '-'; 388 | $self->_emit_node($val, FROMARRAY); 389 | } 390 | $self->{level}--; 391 | } 392 | 393 | # Emit a mapping key 394 | sub _emit_key { 395 | my $self = shift; 396 | my ($value, $context) = @_; 397 | $self->{stream} .= ' ' x $self->offset->[$self->level] 398 | unless $context == FROMARRAY; 399 | $self->_emit_str($value, KEY); 400 | } 401 | 402 | # Emit a blessed SCALAR 403 | sub _emit_scalar { 404 | my $self = shift; 405 | my ($value, $tag) = @_; 406 | $self->{stream} .= " !$tag"; 407 | $self->_emit_str($value, BLESSED); 408 | } 409 | 410 | sub _emit { 411 | my $self = shift; 412 | $self->{stream} .= join '', @_; 413 | } 414 | 415 | # Emit a string value. YAML has many scalar styles. This routine attempts to 416 | # guess the best style for the text. 417 | sub _emit_str { 418 | my $self = shift; 419 | my $type = $_[1] || 0; 420 | 421 | # Use heuristics to find the best scalar emission style. 422 | $self->offset->[$self->level + 1] = 423 | $self->offset->[$self->level] + $self->indent_width; 424 | $self->{level}++; 425 | 426 | my $sf = $type == KEY ? '' : ' '; 427 | my $sb = $type == KEY ? '? ' : ' '; 428 | my $ef = $type == KEY ? '' : "\n"; 429 | my $eb = "\n"; 430 | 431 | while (1) { 432 | $self->_emit($sf), 433 | $self->_emit_plain($_[0]), 434 | $self->_emit($ef), last 435 | if not defined $_[0]; 436 | $self->_emit($sf, '=', $ef), last 437 | if $_[0] eq VALUE; 438 | $self->_emit($sf), 439 | $self->_emit_double($_[0]), 440 | $self->_emit($ef), last 441 | if $_[0] =~ /$ESCAPE_CHAR/; 442 | if ($_[0] =~ /\n/) { 443 | $self->_emit($sb), 444 | $self->_emit_block($LIT_CHAR, $_[0]), 445 | $self->_emit($eb), last 446 | if $self->use_block; 447 | Carp::cluck "[YAML] \$UseFold is no longer supported" 448 | if $self->use_fold; 449 | $self->_emit($sf), 450 | $self->_emit_double($_[0]), 451 | $self->_emit($ef), last 452 | if length $_[0] <= 30; 453 | $self->_emit($sf), 454 | $self->_emit_double($_[0]), 455 | $self->_emit($ef), last 456 | if $_[0] !~ /\n\s*\S/; 457 | $self->_emit($sb), 458 | $self->_emit_block($LIT_CHAR, $_[0]), 459 | $self->_emit($eb), last; 460 | } 461 | $self->_emit($sf), 462 | $self->_emit_number($_[0]), 463 | $self->_emit($ef), last 464 | if $self->is_literal_number($_[0]); 465 | $self->_emit($sf), 466 | $self->_emit_plain($_[0]), 467 | $self->_emit($ef), last 468 | if $self->is_valid_plain($_[0]); 469 | $self->_emit($sf), 470 | $self->_emit_double($_[0]), 471 | $self->_emit($ef), last 472 | if $_[0] =~ /'/; 473 | $self->_emit($sf), 474 | $self->_emit_single($_[0]), 475 | $self->_emit($ef); 476 | last; 477 | } 478 | 479 | $self->{level}--; 480 | 481 | return; 482 | } 483 | 484 | sub is_literal_number { 485 | my $self = shift; 486 | # Stolen from JSON::Tiny 487 | return B::svref_2object(\$_[0])->FLAGS & (B::SVp_IOK | B::SVp_NOK) 488 | && 0 + $_[0] eq $_[0]; 489 | } 490 | 491 | sub _emit_number { 492 | my $self = shift; 493 | return $self->_emit_plain($_[0]); 494 | } 495 | 496 | # Check whether or not a scalar should be emitted as an plain scalar. 497 | sub is_valid_plain { 498 | my $self = shift; 499 | return 0 unless length $_[0]; 500 | return 0 if $self->quote_numeric_strings and Scalar::Util::looks_like_number($_[0]); 501 | # refer to YAML::Loader::parse_inline_simple() 502 | return 0 if $_[0] =~ /^[\s\{\[\~\`\'\"\!\@\#\>\|\%\&\?\*\^]/; 503 | return 0 if $_[0] =~ /[\{\[\]\},]/; 504 | return 0 if $_[0] =~ /[:\-\?]\s/; 505 | return 0 if $_[0] =~ /\s#/; 506 | return 0 if $_[0] =~ /\:(\s|$)/; 507 | return 0 if $_[0] =~ /[\s\|\>]$/; 508 | return 0 if $_[0] eq '-'; 509 | return 0 if $_[0] eq '='; 510 | return 1; 511 | } 512 | 513 | sub _emit_block { 514 | my $self = shift; 515 | my ($indicator, $value) = @_; 516 | $self->{stream} .= $indicator; 517 | $value =~ /(\n*)\Z/; 518 | my $chomp = length $1 ? (length $1 > 1) ? '+' : '' : '-'; 519 | $value = '~' if not defined $value; 520 | $self->{stream} .= $chomp; 521 | $self->{stream} .= $self->indent_width if $value =~ /^\s/; 522 | $self->{stream} .= $self->indent($value); 523 | } 524 | 525 | # Plain means that the scalar is unquoted. 526 | sub _emit_plain { 527 | my $self = shift; 528 | $self->{stream} .= defined $_[0] ? $_[0] : '~'; 529 | } 530 | 531 | # Double quoting is for single lined escaped strings. 532 | sub _emit_double { 533 | my $self = shift; 534 | (my $escaped = $self->escape($_[0])) =~ s/"/\\"/g; 535 | $self->{stream} .= qq{"$escaped"}; 536 | } 537 | 538 | # Single quoting is for single lined unescaped strings. 539 | sub _emit_single { 540 | my $self = shift; 541 | my $item = shift; 542 | $item =~ s{'}{''}g; 543 | $self->{stream} .= "'$item'"; 544 | } 545 | 546 | #============================================================================== 547 | # Utility subroutines. 548 | #============================================================================== 549 | 550 | # Indent a scalar to the current indentation level. 551 | sub indent { 552 | my $self = shift; 553 | my ($text) = @_; 554 | return $text unless length $text; 555 | $text =~ s/\n\Z//; 556 | my $indent = ' ' x $self->offset->[$self->level]; 557 | $text =~ s/^/$indent/gm; 558 | $text = "\n$text"; 559 | return $text; 560 | } 561 | 562 | # Escapes for unprintable characters 563 | my @escapes = qw(\0 \x01 \x02 \x03 \x04 \x05 \x06 \a 564 | \x08 \t \n \v \f \r \x0e \x0f 565 | \x10 \x11 \x12 \x13 \x14 \x15 \x16 \x17 566 | \x18 \x19 \x1a \e \x1c \x1d \x1e \x1f 567 | ); 568 | 569 | # Escape the unprintable characters 570 | sub escape { 571 | my $self = shift; 572 | my ($text) = @_; 573 | $text =~ s/\\/\\\\/g; 574 | $text =~ s/([\x00-\x1f])/$escapes[ord($1)]/ge; 575 | return $text; 576 | } 577 | 578 | 1; 579 | -------------------------------------------------------------------------------- /lib/YAML/Dumper/Base.pm: -------------------------------------------------------------------------------- 1 | package YAML::Dumper::Base; 2 | 3 | use YAML::Mo; 4 | 5 | use YAML::Node; 6 | 7 | # YAML Dumping options 8 | has spec_version => default => sub {'1.0'}; 9 | has indent_width => default => sub {2}; 10 | has use_header => default => sub {1}; 11 | has use_version => default => sub {0}; 12 | has sort_keys => default => sub {1}; 13 | has anchor_prefix => default => sub {''}; 14 | has dump_code => default => sub {0}; 15 | has use_block => default => sub {0}; 16 | has use_fold => default => sub {0}; 17 | has compress_series => default => sub {1}; 18 | has inline_series => default => sub {0}; 19 | has use_aliases => default => sub {1}; 20 | has purity => default => sub {0}; 21 | has stringify => default => sub {0}; 22 | has quote_numeric_strings => default => sub {0}; 23 | 24 | # Properties 25 | has stream => default => sub {''}; 26 | has document => default => sub {0}; 27 | has transferred => default => sub {{}}; 28 | has id_refcnt => default => sub {{}}; 29 | has id_anchor => default => sub {{}}; 30 | has anchor => default => sub {1}; 31 | has level => default => sub {0}; 32 | has offset => default => sub {[]}; 33 | has headless => default => sub {0}; 34 | has blessed_map => default => sub {{}}; 35 | 36 | # Global Options are an idea taken from Data::Dumper. Really they are just 37 | # sugar on top of real OO properties. They make the simple Dump/Load API 38 | # easy to configure. 39 | sub set_global_options { 40 | my $self = shift; 41 | $self->spec_version($YAML::SpecVersion) 42 | if defined $YAML::SpecVersion; 43 | $self->indent_width($YAML::Indent) 44 | if defined $YAML::Indent; 45 | $self->use_header($YAML::UseHeader) 46 | if defined $YAML::UseHeader; 47 | $self->use_version($YAML::UseVersion) 48 | if defined $YAML::UseVersion; 49 | $self->sort_keys($YAML::SortKeys) 50 | if defined $YAML::SortKeys; 51 | $self->anchor_prefix($YAML::AnchorPrefix) 52 | if defined $YAML::AnchorPrefix; 53 | $self->dump_code($YAML::DumpCode || $YAML::UseCode) 54 | if defined $YAML::DumpCode or defined $YAML::UseCode; 55 | $self->use_block($YAML::UseBlock) 56 | if defined $YAML::UseBlock; 57 | $self->use_fold($YAML::UseFold) 58 | if defined $YAML::UseFold; 59 | $self->compress_series($YAML::CompressSeries) 60 | if defined $YAML::CompressSeries; 61 | $self->inline_series($YAML::InlineSeries) 62 | if defined $YAML::InlineSeries; 63 | $self->use_aliases($YAML::UseAliases) 64 | if defined $YAML::UseAliases; 65 | $self->purity($YAML::Purity) 66 | if defined $YAML::Purity; 67 | $self->stringify($YAML::Stringify) 68 | if defined $YAML::Stringify; 69 | $self->quote_numeric_strings($YAML::QuoteNumericStrings) 70 | if defined $YAML::QuoteNumericStrings; 71 | } 72 | 73 | sub dump { 74 | my $self = shift; 75 | $self->die('dump() not implemented in this class.'); 76 | } 77 | 78 | sub blessed { 79 | my $self = shift; 80 | my ($ref) = @_; 81 | $ref = \$_[0] unless ref $ref; 82 | my (undef, undef, $node_id) = YAML::Mo::Object->node_info($ref); 83 | $self->{blessed_map}->{$node_id}; 84 | } 85 | 86 | sub bless { 87 | my $self = shift; 88 | my ($ref, $blessing) = @_; 89 | my $ynode; 90 | $ref = \$_[0] unless ref $ref; 91 | my (undef, undef, $node_id) = YAML::Mo::Object->node_info($ref); 92 | if (not defined $blessing) { 93 | $ynode = YAML::Node->new($ref); 94 | } 95 | elsif (ref $blessing) { 96 | $self->die() unless ynode($blessing); 97 | $ynode = $blessing; 98 | } 99 | else { 100 | no strict 'refs'; 101 | my $transfer = $blessing . "::yaml_dump"; 102 | $self->die() unless defined &{$transfer}; 103 | $ynode = &{$transfer}($ref); 104 | $self->die() unless ynode($ynode); 105 | } 106 | $self->{blessed_map}->{$node_id} = $ynode; 107 | my $object = ynode($ynode) or $self->die(); 108 | return $object; 109 | } 110 | 111 | 1; 112 | -------------------------------------------------------------------------------- /lib/YAML/Error.pm: -------------------------------------------------------------------------------- 1 | package YAML::Error; 2 | 3 | use YAML::Mo; 4 | 5 | has 'code'; 6 | has 'type' => default => sub {'Error'}; 7 | has 'line'; 8 | has 'document'; 9 | has 'arguments' => default => sub {[]}; 10 | 11 | my ($error_messages, %line_adjust); 12 | 13 | sub format_message { 14 | my $self = shift; 15 | my $output = 'YAML ' . $self->type . ': '; 16 | my $code = $self->code; 17 | if ($error_messages->{$code}) { 18 | $code = sprintf($error_messages->{$code}, @{$self->arguments}); 19 | } 20 | $output .= $code . "\n"; 21 | 22 | $output .= ' Code: ' . $self->code . "\n" 23 | if defined $self->code; 24 | $output .= ' Line: ' . $self->line . "\n" 25 | if defined $self->line; 26 | $output .= ' Document: ' . $self->document . "\n" 27 | if defined $self->document; 28 | return $output; 29 | } 30 | 31 | sub error_messages { 32 | $error_messages; 33 | } 34 | 35 | %$error_messages = map {s/^\s+//;s/\\n/\n/;$_} split "\n", <<'...'; 36 | YAML_PARSE_ERR_BAD_CHARS 37 | Invalid characters in stream. This parser only supports printable ASCII 38 | YAML_PARSE_ERR_BAD_MAJOR_VERSION 39 | Can't parse a %s document with a 1.0 parser 40 | YAML_PARSE_WARN_BAD_MINOR_VERSION 41 | Parsing a %s document with a 1.0 parser 42 | YAML_PARSE_WARN_MULTIPLE_DIRECTIVES 43 | '%s directive used more than once' 44 | YAML_PARSE_ERR_TEXT_AFTER_INDICATOR 45 | No text allowed after indicator 46 | YAML_PARSE_ERR_NO_ANCHOR 47 | No anchor for alias '*%s' 48 | YAML_PARSE_ERR_NO_SEPARATOR 49 | Expected separator '---' 50 | YAML_PARSE_ERR_SINGLE_LINE 51 | Couldn't parse single line value 52 | YAML_PARSE_ERR_BAD_ANCHOR 53 | Invalid anchor 54 | YAML_DUMP_ERR_INVALID_INDENT 55 | Invalid Indent width specified: '%s' 56 | YAML_LOAD_USAGE 57 | usage: YAML::Load($yaml_stream_scalar) 58 | YAML_PARSE_ERR_BAD_NODE 59 | Can't parse node 60 | YAML_PARSE_ERR_BAD_EXPLICIT 61 | Unsupported explicit transfer: '%s' 62 | YAML_DUMP_USAGE_DUMPCODE 63 | Invalid value for DumpCode: '%s' 64 | YAML_LOAD_ERR_FILE_INPUT 65 | Couldn't open %s for input:\n%s 66 | YAML_DUMP_ERR_FILE_CONCATENATE 67 | Can't concatenate to YAML file %s 68 | YAML_DUMP_ERR_FILE_OUTPUT 69 | Couldn't open %s for output:\n%s 70 | YAML_DUMP_ERR_FILE_OUTPUT_CLOSE 71 | Error closing %s:\n%s 72 | YAML_DUMP_ERR_NO_HEADER 73 | With UseHeader=0, the node must be a plain hash or array 74 | YAML_DUMP_WARN_BAD_NODE_TYPE 75 | Can't perform serialization for node type: '%s' 76 | YAML_EMIT_WARN_KEYS 77 | Encountered a problem with 'keys':\n%s 78 | YAML_DUMP_WARN_DEPARSE_FAILED 79 | Deparse failed for CODE reference 80 | YAML_DUMP_WARN_CODE_DUMMY 81 | Emitting dummy subroutine for CODE reference 82 | YAML_PARSE_ERR_MANY_EXPLICIT 83 | More than one explicit transfer 84 | YAML_PARSE_ERR_MANY_IMPLICIT 85 | More than one implicit request 86 | YAML_PARSE_ERR_MANY_ANCHOR 87 | More than one anchor 88 | YAML_PARSE_ERR_ANCHOR_ALIAS 89 | Can't define both an anchor and an alias 90 | YAML_PARSE_ERR_BAD_ALIAS 91 | Invalid alias 92 | YAML_PARSE_ERR_MANY_ALIAS 93 | More than one alias 94 | YAML_LOAD_ERR_NO_CONVERT 95 | Can't convert implicit '%s' node to explicit '%s' node 96 | YAML_LOAD_ERR_NO_DEFAULT_VALUE 97 | No default value for '%s' explicit transfer 98 | YAML_LOAD_ERR_NON_EMPTY_STRING 99 | Only the empty string can be converted to a '%s' 100 | YAML_LOAD_ERR_BAD_MAP_TO_SEQ 101 | Can't transfer map as sequence. Non numeric key '%s' encountered. 102 | YAML_DUMP_ERR_BAD_GLOB 103 | '%s' is an invalid value for Perl glob 104 | YAML_DUMP_ERR_BAD_REGEXP 105 | '%s' is an invalid value for Perl Regexp 106 | YAML_LOAD_ERR_BAD_MAP_ELEMENT 107 | Invalid element in map 108 | YAML_LOAD_WARN_DUPLICATE_KEY 109 | Duplicate map key '%s' found. Ignoring. 110 | YAML_LOAD_ERR_BAD_SEQ_ELEMENT 111 | Invalid element in sequence 112 | YAML_PARSE_ERR_INLINE_MAP 113 | Can't parse inline map 114 | YAML_PARSE_ERR_INLINE_SEQUENCE 115 | Can't parse inline sequence 116 | YAML_PARSE_ERR_BAD_DOUBLE 117 | Can't parse double quoted string 118 | YAML_PARSE_ERR_BAD_SINGLE 119 | Can't parse single quoted string 120 | YAML_PARSE_ERR_BAD_INLINE_IMPLICIT 121 | Can't parse inline implicit value '%s' 122 | YAML_PARSE_ERR_BAD_IMPLICIT 123 | Unrecognized implicit value '%s' 124 | YAML_PARSE_ERR_INDENTATION 125 | Error. Invalid indentation level 126 | YAML_PARSE_ERR_INCONSISTENT_INDENTATION 127 | Inconsistent indentation level 128 | YAML_LOAD_WARN_UNRESOLVED_ALIAS 129 | Can't resolve alias *%s 130 | YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP 131 | No 'REGEXP' element for Perl regexp 132 | YAML_LOAD_WARN_BAD_REGEXP_ELEM 133 | Unknown element '%s' in Perl regexp 134 | YAML_LOAD_WARN_GLOB_NAME 135 | No 'NAME' element for Perl glob 136 | YAML_LOAD_WARN_PARSE_CODE 137 | Couldn't parse Perl code scalar: %s 138 | YAML_LOAD_WARN_CODE_DEPARSE 139 | Won't parse Perl code unless $YAML::LoadCode is set 140 | YAML_EMIT_ERR_BAD_LEVEL 141 | Internal Error: Bad level detected 142 | YAML_PARSE_WARN_AMBIGUOUS_TAB 143 | Amibiguous tab converted to spaces 144 | YAML_LOAD_WARN_BAD_GLOB_ELEM 145 | Unknown element '%s' in Perl glob 146 | YAML_PARSE_ERR_ZERO_INDENT 147 | Can't use zero as an indentation width 148 | YAML_LOAD_WARN_GLOB_IO 149 | Can't load an IO filehandle. Yet!!! 150 | ... 151 | 152 | %line_adjust = map {($_, 1)} 153 | qw(YAML_PARSE_ERR_BAD_MAJOR_VERSION 154 | YAML_PARSE_WARN_BAD_MINOR_VERSION 155 | YAML_PARSE_ERR_TEXT_AFTER_INDICATOR 156 | YAML_PARSE_ERR_NO_ANCHOR 157 | YAML_PARSE_ERR_MANY_EXPLICIT 158 | YAML_PARSE_ERR_MANY_IMPLICIT 159 | YAML_PARSE_ERR_MANY_ANCHOR 160 | YAML_PARSE_ERR_ANCHOR_ALIAS 161 | YAML_PARSE_ERR_BAD_ALIAS 162 | YAML_PARSE_ERR_MANY_ALIAS 163 | YAML_LOAD_ERR_NO_CONVERT 164 | YAML_LOAD_ERR_NO_DEFAULT_VALUE 165 | YAML_LOAD_ERR_NON_EMPTY_STRING 166 | YAML_LOAD_ERR_BAD_MAP_TO_SEQ 167 | YAML_LOAD_ERR_BAD_STR_TO_INT 168 | YAML_LOAD_ERR_BAD_STR_TO_DATE 169 | YAML_LOAD_ERR_BAD_STR_TO_TIME 170 | YAML_LOAD_WARN_DUPLICATE_KEY 171 | YAML_PARSE_ERR_INLINE_MAP 172 | YAML_PARSE_ERR_INLINE_SEQUENCE 173 | YAML_PARSE_ERR_BAD_DOUBLE 174 | YAML_PARSE_ERR_BAD_SINGLE 175 | YAML_PARSE_ERR_BAD_INLINE_IMPLICIT 176 | YAML_PARSE_ERR_BAD_IMPLICIT 177 | YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP 178 | YAML_LOAD_WARN_BAD_REGEXP_ELEM 179 | YAML_LOAD_WARN_REGEXP_CREATE 180 | YAML_LOAD_WARN_GLOB_NAME 181 | YAML_LOAD_WARN_PARSE_CODE 182 | YAML_LOAD_WARN_CODE_DEPARSE 183 | YAML_LOAD_WARN_BAD_GLOB_ELEM 184 | YAML_PARSE_ERR_ZERO_INDENT 185 | ); 186 | 187 | package YAML::Warning; 188 | 189 | our @ISA = 'YAML::Error'; 190 | 191 | 1; 192 | -------------------------------------------------------------------------------- /lib/YAML/Loader/Base.pm: -------------------------------------------------------------------------------- 1 | package YAML::Loader::Base; 2 | 3 | use YAML::Mo; 4 | 5 | has load_code => default => sub {0}; 6 | has preserve => default => sub {0}; 7 | has stream => default => sub {''}; 8 | has document => default => sub {0}; 9 | has line => default => sub {0}; 10 | has documents => default => sub {[]}; 11 | has lines => default => sub {[]}; 12 | has eos => default => sub {0}; 13 | has done => default => sub {0}; 14 | has anchor2node => default => sub {{}}; 15 | has level => default => sub {0}; 16 | has offset => default => sub {[]}; 17 | has preface => default => sub {''}; 18 | has content => default => sub {''}; 19 | has indent => default => sub {0}; 20 | has major_version => default => sub {0}; 21 | has minor_version => default => sub {0}; 22 | has inline => default => sub {''}; 23 | has numify => default => sub {0}; 24 | has zero_indent => default => sub {[]}; 25 | 26 | sub set_global_options { 27 | my $self = shift; 28 | $self->load_code($YAML::LoadCode || $YAML::UseCode) 29 | if defined $YAML::LoadCode or defined $YAML::UseCode; 30 | $self->preserve($YAML::Preserve) if defined $YAML::Preserve; 31 | $self->numify($YAML::Numify) if defined $YAML::Numify; 32 | } 33 | 34 | sub load { 35 | die 'load() not implemented in this class.'; 36 | } 37 | 38 | 1; 39 | -------------------------------------------------------------------------------- /lib/YAML/Marshall.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package YAML::Marshall; 3 | 4 | use YAML::Node (); 5 | 6 | sub import { 7 | my $class = shift; 8 | no strict 'refs'; 9 | my $package = caller; 10 | unless (grep { $_ eq $class} @{$package . '::ISA'}) { 11 | push @{$package . '::ISA'}, $class; 12 | } 13 | 14 | my $tag = shift; 15 | if ( $tag ) { 16 | no warnings 'once'; 17 | $YAML::TagClass->{$tag} = $package; 18 | ${$package . "::YamlTag"} = $tag; 19 | } 20 | } 21 | 22 | sub yaml_dump { 23 | my $self = shift; 24 | no strict 'refs'; 25 | my $tag = ${ref($self) . "::YamlTag"} || 'perl/' . ref($self); 26 | $self->yaml_node($self, $tag); 27 | } 28 | 29 | sub yaml_load { 30 | my ($class, $node) = @_; 31 | if (my $ynode = $class->yaml_ynode($node)) { 32 | $node = $ynode->{NODE}; 33 | } 34 | bless $node, $class; 35 | } 36 | 37 | sub yaml_node { 38 | shift; 39 | YAML::Node->new(@_); 40 | } 41 | 42 | sub yaml_ynode { 43 | shift; 44 | YAML::Node::ynode(@_); 45 | } 46 | 47 | 1; 48 | -------------------------------------------------------------------------------- /lib/YAML/Mo.pm: -------------------------------------------------------------------------------- 1 | package YAML::Mo; 2 | # use Mo qw[builder default import]; 3 | # The following line of code was produced from the previous line by 4 | # Mo::Inline version 0.4 5 | no warnings;my$M=__PACKAGE__.'::';*{$M.Object::new}=sub{my$c=shift;my$s=bless{@_},$c;my%n=%{$c.'::'.':E'};map{$s->{$_}=$n{$_}->()if!exists$s->{$_}}keys%n;$s};*{$M.import}=sub{import warnings;$^H|=1538;my($P,%e,%o)=caller.'::';shift;eval"no Mo::$_",&{$M.$_.::e}($P,\%e,\%o,\@_)for@_;return if$e{M};%e=(extends,sub{eval"no $_[0]()";@{$P.ISA}=$_[0]},has,sub{my$n=shift;my$m=sub{$#_?$_[0]{$n}=$_[1]:$_[0]{$n}};@_=(default,@_)if!($#_%2);$m=$o{$_}->($m,$n,@_)for sort keys%o;*{$P.$n}=$m},%e,);*{$P.$_}=$e{$_}for keys%e;@{$P.ISA}=$M.Object};*{$M.'builder::e'}=sub{my($P,$e,$o)=@_;$o->{builder}=sub{my($m,$n,%a)=@_;my$b=$a{builder}or return$m;my$i=exists$a{lazy}?$a{lazy}:!${$P.':N'};$i or ${$P.':E'}{$n}=\&{$P.$b}and return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$_[0]->$b:$m->(@_)}}};*{$M.'default::e'}=sub{my($P,$e,$o)=@_;$o->{default}=sub{my($m,$n,%a)=@_;exists$a{default}or return$m;my($d,$r)=$a{default};my$g='HASH'eq($r=ref$d)?sub{+{%$d}}:'ARRAY'eq$r?sub{[@$d]}:'CODE'eq$r?$d:sub{$d};my$i=exists$a{lazy}?$a{lazy}:!${$P.':N'};$i or ${$P.':E'}{$n}=$g and return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$g->(@_):$m->(@_)}}};my$i=\&import;*{$M.import}=sub{(@_==2 and not$_[1])?pop@_:@_==1?push@_,grep!/import/,@f:();goto&$i};@f=qw[builder default import];use strict;use warnings; 6 | 7 | our $DumperModule = 'Data::Dumper'; 8 | 9 | my ($_new_error, $_info, $_scalar_info); 10 | 11 | no strict 'refs'; 12 | *{$M.'Object::die'} = sub { 13 | my $self = shift; 14 | my $error = $self->$_new_error(@_); 15 | $error->type('Error'); 16 | Carp::croak($error->format_message); 17 | }; 18 | 19 | *{$M.'Object::warn'} = sub { 20 | my $self = shift; 21 | return unless $^W; 22 | my $error = $self->$_new_error(@_); 23 | $error->type('Warning'); 24 | Carp::cluck($error->format_message); 25 | }; 26 | 27 | # This code needs to be refactored to be simpler and more precise, and no, 28 | # Scalar::Util doesn't DWIM. 29 | # 30 | # Can't handle: 31 | # * blessed regexp 32 | *{$M.'Object::node_info'} = sub { 33 | my $self = shift; 34 | my $stringify = $_[1] || 0; 35 | my ($class, $type, $id) = 36 | ref($_[0]) 37 | ? $stringify 38 | ? &$_info("$_[0]") 39 | : do { 40 | require overload; 41 | my @info = &$_info(overload::StrVal($_[0])); 42 | if (ref($_[0]) eq 'Regexp') { 43 | @info[0, 1] = (undef, 'REGEXP'); 44 | } 45 | @info; 46 | } 47 | : &$_scalar_info($_[0]); 48 | ($class, $type, $id) = &$_scalar_info("$_[0]") 49 | unless $id; 50 | return wantarray ? ($class, $type, $id) : $id; 51 | }; 52 | 53 | #------------------------------------------------------------------------------- 54 | $_info = sub { 55 | return (($_[0]) =~ qr{^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$}o); 56 | }; 57 | 58 | $_scalar_info = sub { 59 | my $id = 'undef'; 60 | if (defined $_[0]) { 61 | \$_[0] =~ /\((\w+)\)$/o or CORE::die(); 62 | $id = "$1-S"; 63 | } 64 | return (undef, undef, $id); 65 | }; 66 | 67 | $_new_error = sub { 68 | require Carp; 69 | my $self = shift; 70 | require YAML::Error; 71 | 72 | my $code = shift || 'unknown error'; 73 | my $error = YAML::Error->new(code => $code); 74 | $error->line($self->line) if $self->can('line'); 75 | $error->document($self->document) if $self->can('document'); 76 | $error->arguments([@_]); 77 | return $error; 78 | }; 79 | 80 | 1; 81 | -------------------------------------------------------------------------------- /lib/YAML/Node.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package YAML::Node; 3 | 4 | use YAML::Tag; 5 | require YAML::Mo; 6 | 7 | use Exporter; 8 | our @ISA = qw(Exporter YAML::Mo::Object); 9 | our @EXPORT = qw(ynode); 10 | 11 | sub ynode { 12 | my $self; 13 | if (ref($_[0]) eq 'HASH') { 14 | $self = tied(%{$_[0]}); 15 | } 16 | elsif (ref($_[0]) eq 'ARRAY') { 17 | $self = tied(@{$_[0]}); 18 | } 19 | elsif (ref(\$_[0]) eq 'GLOB') { 20 | $self = tied(*{$_[0]}); 21 | } 22 | else { 23 | $self = tied($_[0]); 24 | } 25 | return (ref($self) =~ /^yaml_/) ? $self : undef; 26 | } 27 | 28 | sub new { 29 | my ($class, $node, $tag) = @_; 30 | my $self; 31 | $self->{NODE} = $node; 32 | my (undef, $type) = YAML::Mo::Object->node_info($node); 33 | $self->{KIND} = (not defined $type) ? 'scalar' : 34 | ($type eq 'ARRAY') ? 'sequence' : 35 | ($type eq 'HASH') ? 'mapping' : 36 | $class->die("Can't create YAML::Node from '$type'"); 37 | tag($self, ($tag || '')); 38 | if ($self->{KIND} eq 'scalar') { 39 | yaml_scalar->new($self, $_[1]); 40 | return \ $_[1]; 41 | } 42 | my $package = "yaml_" . $self->{KIND}; 43 | $package->new($self) 44 | } 45 | 46 | sub node { $_->{NODE} } 47 | sub kind { $_->{KIND} } 48 | sub tag { 49 | my ($self, $value) = @_; 50 | if (defined $value) { 51 | $self->{TAG} = YAML::Tag->new($value); 52 | return $self; 53 | } 54 | else { 55 | return $self->{TAG}; 56 | } 57 | } 58 | sub keys { 59 | my ($self, $value) = @_; 60 | if (defined $value) { 61 | $self->{KEYS} = $value; 62 | return $self; 63 | } 64 | else { 65 | return $self->{KEYS}; 66 | } 67 | } 68 | 69 | #============================================================================== 70 | package yaml_scalar; 71 | 72 | @yaml_scalar::ISA = qw(YAML::Node); 73 | 74 | sub new { 75 | my ($class, $self) = @_; 76 | tie $_[2], $class, $self; 77 | } 78 | 79 | sub TIESCALAR { 80 | my ($class, $self) = @_; 81 | bless $self, $class; 82 | $self 83 | } 84 | 85 | sub FETCH { 86 | my ($self) = @_; 87 | $self->{NODE} 88 | } 89 | 90 | sub STORE { 91 | my ($self, $value) = @_; 92 | $self->{NODE} = $value 93 | } 94 | 95 | #============================================================================== 96 | package yaml_sequence; 97 | 98 | @yaml_sequence::ISA = qw(YAML::Node); 99 | 100 | sub new { 101 | my ($class, $self) = @_; 102 | my $new; 103 | tie @$new, $class, $self; 104 | $new 105 | } 106 | 107 | sub TIEARRAY { 108 | my ($class, $self) = @_; 109 | bless $self, $class 110 | } 111 | 112 | sub FETCHSIZE { 113 | my ($self) = @_; 114 | scalar @{$self->{NODE}}; 115 | } 116 | 117 | sub FETCH { 118 | my ($self, $index) = @_; 119 | $self->{NODE}[$index] 120 | } 121 | 122 | sub STORE { 123 | my ($self, $index, $value) = @_; 124 | $self->{NODE}[$index] = $value 125 | } 126 | 127 | sub undone { 128 | die "Not implemented yet"; # XXX 129 | } 130 | 131 | *STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS = 132 | *STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS = 133 | *undone; # XXX Must implement before release 134 | 135 | #============================================================================== 136 | package yaml_mapping; 137 | 138 | @yaml_mapping::ISA = qw(YAML::Node); 139 | 140 | sub new { 141 | my ($class, $self) = @_; 142 | @{$self->{KEYS}} = sort keys %{$self->{NODE}}; 143 | my $new; 144 | tie %$new, $class, $self; 145 | $new 146 | } 147 | 148 | sub TIEHASH { 149 | my ($class, $self) = @_; 150 | bless $self, $class 151 | } 152 | 153 | sub FETCH { 154 | my ($self, $key) = @_; 155 | if (exists $self->{NODE}{$key}) { 156 | return (grep {$_ eq $key} @{$self->{KEYS}}) 157 | ? $self->{NODE}{$key} : undef; 158 | } 159 | return $self->{HASH}{$key}; 160 | } 161 | 162 | sub STORE { 163 | my ($self, $key, $value) = @_; 164 | if (exists $self->{NODE}{$key}) { 165 | $self->{NODE}{$key} = $value; 166 | } 167 | elsif (exists $self->{HASH}{$key}) { 168 | $self->{HASH}{$key} = $value; 169 | } 170 | else { 171 | if (not grep {$_ eq $key} @{$self->{KEYS}}) { 172 | push(@{$self->{KEYS}}, $key); 173 | } 174 | $self->{HASH}{$key} = $value; 175 | } 176 | $value 177 | } 178 | 179 | sub DELETE { 180 | my ($self, $key) = @_; 181 | my $return; 182 | if (exists $self->{NODE}{$key}) { 183 | $return = $self->{NODE}{$key}; 184 | } 185 | elsif (exists $self->{HASH}{$key}) { 186 | $return = delete $self->{NODE}{$key}; 187 | } 188 | for (my $i = 0; $i < @{$self->{KEYS}}; $i++) { 189 | if ($self->{KEYS}[$i] eq $key) { 190 | splice(@{$self->{KEYS}}, $i, 1); 191 | } 192 | } 193 | return $return; 194 | } 195 | 196 | sub CLEAR { 197 | my ($self) = @_; 198 | @{$self->{KEYS}} = (); 199 | %{$self->{HASH}} = (); 200 | } 201 | 202 | sub FIRSTKEY { 203 | my ($self) = @_; 204 | $self->{ITER} = 0; 205 | $self->{KEYS}[0] 206 | } 207 | 208 | sub NEXTKEY { 209 | my ($self) = @_; 210 | $self->{KEYS}[++$self->{ITER}] 211 | } 212 | 213 | sub EXISTS { 214 | my ($self, $key) = @_; 215 | exists $self->{NODE}{$key} 216 | } 217 | 218 | 1; 219 | -------------------------------------------------------------------------------- /lib/YAML/Tag.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package YAML::Tag; 3 | 4 | use overload '""' => sub { ${$_[0]} }; 5 | 6 | sub new { 7 | my ($class, $self) = @_; 8 | bless \$self, $class 9 | } 10 | 11 | sub short { 12 | ${$_[0]} 13 | } 14 | 15 | sub canonical { 16 | ${$_[0]} 17 | } 18 | 19 | 1; 20 | -------------------------------------------------------------------------------- /lib/YAML/Types.pm: -------------------------------------------------------------------------------- 1 | package YAML::Types; 2 | 3 | use YAML::Mo; 4 | use YAML::Node; 5 | 6 | # XXX These classes and their APIs could still use some refactoring, 7 | # but at least they work for now. 8 | #------------------------------------------------------------------------------- 9 | package YAML::Type::blessed; 10 | 11 | use YAML::Mo; # XXX 12 | 13 | sub yaml_dump { 14 | my $self = shift; 15 | my ($value) = @_; 16 | my ($class, $type) = YAML::Mo::Object->node_info($value); 17 | no strict 'refs'; 18 | my $kind = lc($type) . ':'; 19 | my $tag = ${$class . '::ClassTag'} || 20 | "!perl/$kind$class"; 21 | if ($type eq 'REF') { 22 | YAML::Node->new( 23 | {(&YAML::VALUE, ${$_[0]})}, $tag 24 | ); 25 | } 26 | elsif ($type eq 'SCALAR') { 27 | $_[1] = $$value; 28 | YAML::Node->new($_[1], $tag); 29 | } 30 | elsif ($type eq 'GLOB') { 31 | # blessed glob support is minimal, and will not round-trip 32 | # initial aim: to not cause an error 33 | return YAML::Type::glob->yaml_dump($value, $tag); 34 | } else { 35 | YAML::Node->new($value, $tag); 36 | } 37 | } 38 | 39 | #------------------------------------------------------------------------------- 40 | package YAML::Type::undef; 41 | 42 | sub yaml_dump { 43 | my $self = shift; 44 | } 45 | 46 | sub yaml_load { 47 | my $self = shift; 48 | } 49 | 50 | #------------------------------------------------------------------------------- 51 | package YAML::Type::glob; 52 | 53 | sub yaml_dump { 54 | my $self = shift; 55 | # $_[0] remains as the glob 56 | my $tag = pop @_ if 2==@_; 57 | 58 | $tag = '!perl/glob:' unless defined $tag; 59 | my $ynode = YAML::Node->new({}, $tag); 60 | for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) { 61 | my $value = *{$_[0]}{$type}; 62 | $value = $$value if $type eq 'SCALAR'; 63 | if (defined $value) { 64 | if ($type eq 'IO') { 65 | my @stats = qw(device inode mode links uid gid rdev size 66 | atime mtime ctime blksize blocks); 67 | undef $value; 68 | $value->{stat} = YAML::Node->new({}); 69 | if ($value->{fileno} = fileno(*{$_[0]})) { 70 | local $^W; 71 | map {$value->{stat}{shift @stats} = $_} stat(*{$_[0]}); 72 | $value->{tell} = tell(*{$_[0]}); 73 | } 74 | } 75 | $ynode->{$type} = $value; 76 | } 77 | } 78 | return $ynode; 79 | } 80 | 81 | sub yaml_load { 82 | my $self = shift; 83 | my ($node, $class, $loader) = @_; 84 | my ($name, $package); 85 | if (defined $node->{NAME}) { 86 | $name = $node->{NAME}; 87 | delete $node->{NAME}; 88 | } 89 | else { 90 | $loader->warn('YAML_LOAD_WARN_GLOB_NAME'); 91 | return undef; 92 | } 93 | if (defined $node->{PACKAGE}) { 94 | $package = $node->{PACKAGE}; 95 | delete $node->{PACKAGE}; 96 | } 97 | else { 98 | $package = 'main'; 99 | } 100 | no strict 'refs'; 101 | if (exists $node->{SCALAR}) { 102 | if ($YAML::LoadBlessed and $loader->load_code) { 103 | *{"${package}::$name"} = \$node->{SCALAR}; 104 | } 105 | delete $node->{SCALAR}; 106 | } 107 | for my $elem (qw(ARRAY HASH CODE IO)) { 108 | if (exists $node->{$elem}) { 109 | if ($elem eq 'IO') { 110 | $loader->warn('YAML_LOAD_WARN_GLOB_IO'); 111 | delete $node->{IO}; 112 | next; 113 | } 114 | if ($YAML::LoadBlessed and $loader->load_code) { 115 | *{"${package}::$name"} = $node->{$elem}; 116 | } 117 | delete $node->{$elem}; 118 | } 119 | } 120 | for my $elem (sort keys %$node) { 121 | $loader->warn('YAML_LOAD_WARN_BAD_GLOB_ELEM', $elem); 122 | } 123 | return *{"${package}::$name"}; 124 | } 125 | 126 | #------------------------------------------------------------------------------- 127 | package YAML::Type::code; 128 | 129 | my $dummy_warned = 0; 130 | my $default = '{ "DUMMY" }'; 131 | 132 | sub yaml_dump { 133 | my $self = shift; 134 | my $code; 135 | my ($dumpflag, $value) = @_; 136 | my ($class, $type) = YAML::Mo::Object->node_info($value); 137 | my $tag = "!perl/code"; 138 | $tag .= ":$class" if defined $class; 139 | if (not $dumpflag) { 140 | $code = $default; 141 | } 142 | else { 143 | bless $value, "CODE" if $class; 144 | eval { require B::Deparse }; 145 | return if $@; 146 | my $deparse = B::Deparse->new(); 147 | eval { 148 | local $^W = 0; 149 | $code = $deparse->coderef2text($value); 150 | }; 151 | if ($@) { 152 | warn YAML::YAML_DUMP_WARN_DEPARSE_FAILED() if $^W; 153 | $code = $default; 154 | } 155 | bless $value, $class if $class; 156 | chomp $code; 157 | $code .= "\n"; 158 | } 159 | $_[2] = $code; 160 | YAML::Node->new($_[2], $tag); 161 | } 162 | 163 | sub yaml_load { 164 | my $self = shift; 165 | my ($node, $class, $loader) = @_; 166 | if ($loader->load_code) { 167 | my $code = eval "package main; sub $node"; 168 | if ($@) { 169 | $loader->warn('YAML_LOAD_WARN_PARSE_CODE', $@); 170 | return sub {}; 171 | } 172 | else { 173 | CORE::bless $code, $class if ($class and $YAML::LoadBlessed); 174 | return $code; 175 | } 176 | } 177 | else { 178 | return CORE::bless sub {}, $class if ($class and $YAML::LoadBlessed); 179 | return sub {}; 180 | } 181 | } 182 | 183 | #------------------------------------------------------------------------------- 184 | package YAML::Type::ref; 185 | 186 | sub yaml_dump { 187 | my $self = shift; 188 | YAML::Node->new({(&YAML::VALUE, ${$_[0]})}, '!perl/ref') 189 | } 190 | 191 | sub yaml_load { 192 | my $self = shift; 193 | my ($node, $class, $loader) = @_; 194 | $loader->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE', 'ptr') 195 | unless exists $node->{&YAML::VALUE}; 196 | return \$node->{&YAML::VALUE}; 197 | } 198 | 199 | #------------------------------------------------------------------------------- 200 | package YAML::Type::regexp; 201 | 202 | # XXX Be sure to handle blessed regexps (if possible) 203 | sub yaml_dump { 204 | die "YAML::Type::regexp::yaml_dump not currently implemented"; 205 | } 206 | 207 | use constant _QR_TYPES => { 208 | '' => sub { qr{$_[0]} }, 209 | x => sub { qr{$_[0]}x }, 210 | i => sub { qr{$_[0]}i }, 211 | s => sub { qr{$_[0]}s }, 212 | m => sub { qr{$_[0]}m }, 213 | ix => sub { qr{$_[0]}ix }, 214 | sx => sub { qr{$_[0]}sx }, 215 | mx => sub { qr{$_[0]}mx }, 216 | si => sub { qr{$_[0]}si }, 217 | mi => sub { qr{$_[0]}mi }, 218 | ms => sub { qr{$_[0]}sm }, 219 | six => sub { qr{$_[0]}six }, 220 | mix => sub { qr{$_[0]}mix }, 221 | msx => sub { qr{$_[0]}msx }, 222 | msi => sub { qr{$_[0]}msi }, 223 | msix => sub { qr{$_[0]}msix }, 224 | }; 225 | 226 | sub yaml_load { 227 | my $self = shift; 228 | my ($node, $class) = @_; 229 | return qr{$node} unless $node =~ /^\(\?([\^\-uxism]*):(.*)\)\z/s; 230 | my ($flags, $re) = ($1, $2); 231 | $flags =~ s/-.*//; 232 | $flags =~ s/^\^//; 233 | $flags =~ tr/u//d; 234 | my $sub = _QR_TYPES->{$flags} || sub { qr{$_[0]} }; 235 | my $qr = &$sub($re); 236 | bless $qr, $class if (length $class and $YAML::LoadBlessed); 237 | return $qr; 238 | } 239 | 240 | 1; 241 | -------------------------------------------------------------------------------- /test/2-scalars.t: -------------------------------------------------------------------------------- 1 | # This test modified from YAML::Syck suite 2 | use strict; 3 | use Test::More; 4 | 5 | use Config; 6 | require YAML; 7 | YAML->import; 8 | 9 | is(Dump(42), "--- 42\n"); 10 | is(Load("--- 42\n"), 42); 11 | 12 | is(Dump(undef), "--- ~\n"); 13 | is(Load("--- ~\n"), undef); 14 | is(Load("---\n"), undef); 15 | is(Load("--- ''\n"), ''); 16 | 17 | is(Load("--- true\n"), "true"); 18 | is(Load("--- false\n"), "false"); 19 | 20 | # $YAML::Syck::ImplicitTyping = $YAML::Syck::ImplicitTyping = 1; 21 | # 22 | # is(Load("--- true\n"), 1); 23 | # is(Load("--- false\n"), ''); 24 | 25 | my $Data = { 26 | Test => ' 27 | Test Drive D:\\', 28 | }; 29 | 30 | is_deeply(Load(Dump($Data)), $Data); 31 | 32 | if ($^V ge v5.9.0) { 33 | # see https://github.com/ingydotnet/yaml-pm/issues/186 34 | unless ($Config{config_args} =~ / \-fsanitize \= (?: address | undefined ) \b /x) { 35 | # Large data tests. See also https://bugzilla.redhat.com/show_bug.cgi?id=192400. 36 | $Data = ' äø<> " \' " \'' x 40_000; 37 | is(Load(Dump($Data)), $Data); 38 | } 39 | } 40 | 41 | { 42 | my $yaml1 = <<'EOM'; 43 | a: 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 44 | b: 2 45 | EOM 46 | my $yaml2 = <<'EOM'; 47 | a: "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 48 | b: 2 49 | EOM 50 | my $error; 51 | eval { 52 | my @data = Load($yaml1); 53 | }; 54 | $error = $@; 55 | cmp_ok($error, '=~', "Can't parse single", "Single quoted without end"); 56 | 57 | eval { 58 | my @data = Load($yaml2); 59 | }; 60 | $error = $@; 61 | cmp_ok($error, '=~', "Can't parse double", "Double quoted without end"); 62 | } 63 | 64 | done_testing; 65 | -------------------------------------------------------------------------------- /test/TestYAML.pm: -------------------------------------------------------------------------------- 1 | package TestYAML; 2 | use lib 'inc'; 3 | use Test::YAML -Base; 4 | 5 | $Test::YAML::YAML = 'YAML'; 6 | 7 | $^W = 1; 8 | -------------------------------------------------------------------------------- /test/TestYAMLBase.pm: -------------------------------------------------------------------------------- 1 | package TestYAMLBase; 2 | 3 | sub new { 4 | my $self = bless {}, shift; 5 | while (my ($k, $v) = splice @_, 0, 2) { 6 | $self->{$k} = $v; 7 | } 8 | return $self; 9 | } 10 | 11 | 1; 12 | -------------------------------------------------------------------------------- /test/basic-tests.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 4; 4 | 5 | filters { 6 | yaml => [yaml => 'dumper'], 7 | perl => [strict => eval => 'dumper'], 8 | }; 9 | 10 | run_is yaml => 'perl'; 11 | 12 | __END__ 13 | === A simple map 14 | +++ yaml 15 | --- 16 | one: foo 17 | two: bar 18 | three: baz 19 | +++ perl 20 | +{qw(one foo two bar three baz)} 21 | 22 | 23 | === Common String Types 24 | +++ yaml 25 | --- 26 | one: simple string 27 | two: 42 28 | three: '1 Single Quoted String' 29 | four: "YAML's Double Quoted String" 30 | five: | 31 | A block 32 | with several 33 | lines. 34 | six: |- 35 | A "chomped" block 36 | seven: > 37 | A 38 | folded 39 | string 40 | +++ perl 41 | { 42 | one => "simple string", 43 | two => '42', 44 | three => "1 Single Quoted String", 45 | four => "YAML's Double Quoted String", 46 | five => "A block\n with several\n lines.\n", 47 | six => 'A "chomped" block', 48 | seven => "A folded\n string\n", 49 | } 50 | 51 | 52 | === Multiple documents 53 | +++ yaml 54 | --- 55 | foo: bar 56 | --- 57 | bar: two 58 | +++ perl 59 | +{qw(foo bar)}, {qw(bar two)}; 60 | 61 | 62 | === Comments 63 | +++ yaml 64 | # Leading Comment 65 | --- 66 | # Preceding Comment 67 | foo: bar 68 | # Two 69 | # Comments 70 | --- 71 | # Indented comment 72 | bar: two 73 | bee: three 74 | # Intermediate comment 75 | bore: four 76 | +++ perl 77 | +{qw(foo bar)}, {qw(bar two bee three bore four)} 78 | -------------------------------------------------------------------------------- /test/bugs-emailed.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 25; 4 | 5 | no_diff; 6 | run_yaml_tests; 7 | 8 | __DATA__ 9 | 10 | === Date: Tue, 03 Jan 2006 18:04:56 11 | +++ perl: { key1 => '>value1' } 12 | +++ yaml 13 | --- 14 | key1: '>value1' 15 | 16 | 17 | 18 | === Date: Wed, 04 Jan 2006 10:23:18 19 | +++ perl: { key1 => '|value' } 20 | +++ yaml 21 | --- 22 | key1: '|value' 23 | 24 | 25 | 26 | === Date: Thu, 3 Mar 2005 14:12:10 27 | +++ perl: { "foo,bar" => "baz"} 28 | +++ yaml 29 | --- 30 | 'foo,bar': baz 31 | 32 | 33 | 34 | === Date: Wed, 9 Mar 2005 09:16:19 35 | +++ perl: {'a,v' => 'c'} 36 | +++ yaml 37 | --- 38 | 'a,v': c 39 | 40 | 41 | 42 | === Date: Fri, 18 Mar 2005 15:08:57 43 | +++ perl: {'foo[bar', 'baz'} 44 | +++ yaml 45 | --- 46 | 'foo[bar': baz 47 | 48 | 49 | 50 | === Date: Sun, 20 Mar 2005 16:32:50 51 | +++ subject: Argument "E5" isn't numeric in multiplication (*) 52 | +++ function: load_passes 53 | +++ yaml 54 | --- #YAML:1.0 !!perl/Blam::Game 55 | board: 56 | E5: R1 57 | history: 58 | - 1E5 59 | 60 | 61 | 62 | === Date: Sat, 26 Mar 2005 22:55:55 63 | +++ perl: {"a - a" => 1} 64 | +++ yaml 65 | --- 66 | 'a - a': 1 67 | 68 | 69 | 70 | === Date: Sun, 8 May 2005 15:42:04 71 | +++ skip_this_for_now 72 | +++ perl: [{q => {any_key => { } }}] 73 | +++ yaml 74 | --- 75 | - /.*/: 76 | any_key: {} 77 | 78 | 79 | 80 | === Date: Thu, 12 May 2005 14:57:20 81 | +++ function: load_passes 82 | +++ yaml 83 | --- #YAML:1.0 84 | 85 | WilsonSereno1998: 86 | authors: 87 | - Wilson, Jeffrey. A 88 | - Paul C. Sereno 89 | title: Early evolution and Higher-level phylogeny of sauropod dinosaurs 90 | year: 1998 91 | journal: Journal of Vertebrate Paleontology, memoir 92 | volume: 5 93 | pages: 1-68 94 | 95 | WedelEtAl2000: 96 | authors: 97 | - Wedel, M. J. 98 | - R. L. Cifelli 99 | - R. K. Sanders 100 | year: 2000 101 | title: _Sauroposeidon proteles_, a new sauropod from the Early Cretaceous of Oklahoma. 102 | journal: Journal of Vertebrate Paleontology 103 | volume: 20 104 | issue: 1 105 | pages: 109-114 106 | 107 | 108 | 109 | === Date: Thu, 09 Jun 2005 18:49:01 110 | +++ perl: {'test' => '|testing'} 111 | +++ yaml 112 | --- 113 | test: '|testing' 114 | 115 | 116 | 117 | === Date: Mon, 22 Aug 2005 16:52:47 118 | +++ skip_this_for_now 119 | +++ perl 120 | my $y = { 121 | 122 | ok_list_of_hashes => [ 123 | {one => 1}, 124 | {two => 2}, 125 | ], 126 | 127 | error_list_of_hashes => [ 128 | {-one => 1}, 129 | {-two => 2}, 130 | ], 131 | 132 | }; 133 | +++ yaml 134 | --- 135 | error_list_of_hashes: 136 | - -one: 1 137 | - -two: 2 138 | ok_list_of_hashes: 139 | - one: 1 140 | - two: 2 141 | 142 | 143 | 144 | === Date: Wed, 12 Oct 2005 17:16:48 145 | +++ skip_this_for_now 146 | +++ function: load_passes 147 | +++ yaml 148 | fontsize_small: '9px' # labelsmall 149 | fontsize: '11px' # maintext, etc 150 | fontsize_big: '12px' # largetext, button 151 | fontsize_header: '13px' # sectionheaders 152 | fontsize_banner: '16px' # title 153 | 154 | 155 | 156 | === Date: Mon, 07 Nov 2005 15:49:07 157 | +++ perl: \ '|something' 158 | +++ yaml 159 | --- !!perl/ref 160 | =: '|something' 161 | 162 | 163 | 164 | === Date: Thu, 24 Nov 2005 10:49:06 165 | +++ perl: { url => 'http://www.test.com/product|1|2|333333', zzz => '' } 166 | +++ yaml 167 | --- 168 | url: http://www.test.com/product|1|2|333333 169 | zzz: '' 170 | 171 | 172 | 173 | === Date: Sat, 3 Dec 2005 14:26:23 174 | +++ perl 175 | my @keys = qw/001 002 300 400 500/; 176 | my $h = {}; 177 | map {$h->{$_} = 1} @keys; 178 | $h; 179 | +++ yaml 180 | --- 181 | 001: 1 182 | 002: 1 183 | 300: 1 184 | 400: 1 185 | 500: 1 186 | 187 | -------------------------------------------------------------------------------- /test/bugs-rt.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 42; 4 | 5 | run_yaml_tests; 6 | 7 | __DATA__ 8 | 9 | === Ticket #105-A YAML doesn't serialize odd objects very well 10 | +++ skip_this_for_now 11 | +++ skip_unless_modules: FileHandle 12 | +++ perl: FileHandle->new( ">/tmp/yaml_bugs_rt_$$" ); 13 | +++ yaml 14 | --- !!perl/io:FileHandle 15 | - xxx 16 | 17 | === Ticket #105-B YAML doesn't serialize odd objects very well 18 | +++ skip_unless_modules: URI 19 | +++ no_round_trip 20 | +++ perl: URI->new( "http://localhost/" ) 21 | +++ yaml 22 | --- !!perl/scalar:URI::http http://localhost/ 23 | 24 | === Ticket #105-C YAML doesn't serialize odd objects very well 25 | +++ skip_unless_modules: URI 26 | +++ perl: +{ names => ['james','alexander','duncan'], } 27 | +++ yaml 28 | --- 29 | names: 30 | - james 31 | - alexander 32 | - duncan 33 | 34 | === Ticket #105-D YAML doesn't serialize odd objects very well 35 | +++ perl 36 | # CGI->new() 37 | bless { 38 | '.charset' => 'ISO-8859-1', 39 | '.fieldnames' => {}, 40 | '.parameters' => [], 41 | escape => 1, 42 | }, 'CGI'; 43 | +++ yaml 44 | --- !!perl/hash:CGI 45 | .charset: ISO-8859-1 46 | .fieldnames: {} 47 | .parameters: [] 48 | escape: 1 49 | 50 | === Ticket #105-E YAML doesn't serialize odd objects very well 51 | +++ perl 52 | package MyObj::Class; 53 | sub new { return bless ['one','two','three'], $_[0]; } 54 | package main; 55 | MyObj::Class->new(); 56 | +++ yaml 57 | --- !!perl/array:MyObj::Class 58 | - one 59 | - two 60 | - three 61 | 62 | 63 | 64 | === Ticket #2957 Serializing array-elements with dashes 65 | [github #36] The problem is quoted map keys in array elements 66 | +++ perl: [ { "test - " => 23 } ]; 67 | +++ yaml 68 | --- 69 | - 'test - ': 23 70 | 71 | 72 | === Ticket #3015 wish: folding length option for YAML 73 | +++ skip_this_for_now 74 | > YAML.pm, line 557, currently has a folding value of 50 hard-coded. 75 | > It would be great if this value became an option... for those who 76 | > prefer not to fold, or fold less. 77 | 78 | I wanted that too. The attached patch adds in the $YAML::FoldLimit 79 | config variable to achieve this. I've also got a doc patch which 80 | describes this, but 'RT' only has one file-upload field so that'll be in 81 | the next comment ... 82 | 83 | Smylers 84 | 85 | 86 | === Ticket #4066 Number vs. string heuristics for dump 87 | +++ perl: { 'version' => '1.10' }; 88 | +++ yaml 89 | --- 90 | version: 1.10 91 | 92 | 93 | 94 | === Ticket #4784 Can't create YAML::Node from 'REF' 95 | +++ skip_this_for_now 96 | +++ perl: my $bar = 1; my $foo = \\\$bar; bless $foo, "bar" 97 | +++ yaml 98 | 99 | 100 | 101 | === Ticket #4866 Text with embedded newlines 102 | +++ perl 103 | {'text' => 'Bla: 104 | 105 | - Foo 106 | - Bar 107 | '}; 108 | +++ yaml 109 | --- 110 | text: "Bla:\n\n- Foo\n- Bar\n" 111 | 112 | 113 | 114 | === Ticket #5299 Load(Dump({"hi, world" => 1})) fails 115 | +++ perl: {"hi, world" => 1} 116 | +++ yaml 117 | --- 118 | 'hi, world': 1 119 | 120 | 121 | 122 | === Ticket #5691 Minor doc error in YAML.pod 123 | +++ perl: "YAML:1.0" 124 | +++ yaml 125 | --- YAML:1.0 126 | 127 | 128 | 129 | === Ticket #6095 Hash keys are not always escaped 130 | +++ perl: { 'AVE,' => { '??' => { '??' => 1 } } } 131 | +++ yaml 132 | --- 133 | 'AVE,': 134 | '??': 135 | '??': 1 136 | 137 | 138 | 139 | === Ticket #6139 0.35 can't deserialize blessed scalars 140 | +++ perl: my $x = "abc"; bless \ $x, "ABCD"; 141 | +++ yaml 142 | --- !!perl/scalar:ABCD abc 143 | 144 | 145 | 146 | === Ticket #7146 scalar with many spaces doesn't round trip 147 | +++ skip_this_for_now 148 | Can't get this to work yet. 149 | +++ perl: "A".(" "x200)."B" 150 | +++ yaml 151 | --- 'A B' 152 | 153 | 154 | 155 | 156 | === Ticket #8795 !!perl/code blocks are evaluated in package main 157 | +++ skip_this_for_now 158 | This test passes but not sure if this totally represents what was being 159 | reported. Check back later. 160 | +++ perl: $YAML::UseCode = 1; package Food; sub { 42; } 161 | +++ no_round_trip 162 | +++ yaml 163 | --- !!perl/code | 164 | sub { 165 | package Food; 166 | use warnings; 167 | use strict 'refs'; 168 | 42; 169 | } 170 | 171 | 172 | === Ticket #8818 YAML::Load fails if the last value in the stream ends with '|' 173 | +++ perl: ['o|'] 174 | +++ yaml 175 | --- 176 | - 'o|' 177 | 178 | 179 | 180 | === Ticket #12729 < and > need to be quoted ? 181 | +++ perl: { a => q(>a), b => q( q()} 182 | +++ yaml 183 | --- 184 | a: '>a' 185 | b: ' 187 | 188 | 189 | 190 | === Ticket #12770 YAML crashes when tab used for indenting 191 | +++ skip_this_for_now 192 | Even in the latest version, 0.39, YAML fails when tabulator characters are used for 193 | indenting. This is expected since the YAML spec forbids this use of tab characters. 194 | However, there is no error message; YAML.pm just dies. Here's an example: 195 | 196 | perl -MYAML -e "Load(\"Testing:\n\t- Item1\n\")" 197 | 198 | fails with 199 | 200 | Died at U:\perl-lib\lib/YAML.pm line 1417. 201 | 202 | It should at least fail with a message like it does when there's no newline at the 203 | end: 204 | +++ perl 205 | 206 | 207 | 208 | === Ticket #12959-a bug - nested inline collections with extra blanks 209 | +++ function: load_passes 210 | +++ yaml 211 | --- { a: {k: v} } 212 | 213 | === Ticket #12959-b bug - nested inline collections with extra blanks 214 | +++ function: load_passes 215 | +++ yaml 216 | --- { a: [1] } 217 | 218 | === Ticket #12959-c bug - nested inline collections with extra blanks 219 | +++ function: load_passes 220 | +++ yaml 221 | --- [ {k: v} ] 222 | 223 | === Ticket #12959-d bug - nested inline collections with extra blanks 224 | +++ function: load_passes 225 | +++ yaml 226 | --- [ [1] ] 227 | 228 | 229 | 230 | === Ticket #13016 Plain Multiline Support 231 | +++ skip_this_for_now 232 | Fix in upcoming release 233 | +++ function: load_passes 234 | +++ yaml 235 | quoted: "So does this 236 | quoted scalar.\n" 237 | 238 | 239 | 240 | === #13500 Load(Dump("|foo")) fails 241 | +++ perl: "|foo" 242 | +++ yaml 243 | --- '|foo' 244 | 245 | 246 | 247 | === Ticket #13510 Another roundtrip fails 248 | [github #48] The problem is quoted map keys in array elements 249 | +++ perl 250 | [{'RR1 (Schloflplatz - Wannsee)'=> 1, 251 | 'm‰fliges Kopfsteinpflaster (Teilstrecke)' => 1}, 252 | undef, 253 | ] 254 | +++ yaml 255 | --- 256 | - 'RR1 (Schloflplatz - Wannsee)': 1 257 | m‰fliges Kopfsteinpflaster (Teilstrecke): 1 258 | - ~ 259 | 260 | 261 | 262 | === Ticket #14938 Load(Dump(">=")) fails 263 | +++ perl: ">=" 264 | +++ yaml 265 | --- '>=' 266 | -------------------------------------------------------------------------------- /test/changes.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 1; 4 | 5 | SKIP: { 6 | skip("Can't parse Changes file yet :(", 1); 7 | } 8 | 9 | # my @values = LoadFile("Changes"); 10 | -------------------------------------------------------------------------------- /test/dump-basics.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 7; 4 | 5 | filters { 6 | perl => [qw'eval yaml_dump'], 7 | }; 8 | 9 | run_is; 10 | 11 | __DATA__ 12 | === A map 13 | +++ perl 14 | +{ foo => 'bar', baz => 'boo' } 15 | +++ yaml 16 | --- 17 | baz: boo 18 | foo: bar 19 | 20 | === A list 21 | +++ perl 22 | [ qw'foo bar baz' ] 23 | +++ yaml 24 | --- 25 | - foo 26 | - bar 27 | - baz 28 | 29 | === A List of maps 30 | +++ perl 31 | [{ foo => 42, bar => 44}, {one => 'two', three => 'four'}] 32 | +++ yaml 33 | --- 34 | - bar: 44 35 | foo: 42 36 | - one: two 37 | three: four 38 | 39 | === A map of lists 40 | +++ perl 41 | +{numbers => [ 5..7 ], words => [qw'five six seven']} 42 | +++ yaml 43 | --- 44 | numbers: 45 | - 5 46 | - 6 47 | - 7 48 | words: 49 | - five 50 | - six 51 | - seven 52 | 53 | === Top level scalar 54 | +++ perl: 'The eagle has landed' 55 | +++ yaml 56 | --- The eagle has landed 57 | 58 | === Top level literal scalar 59 | +++ perl 60 | <<'...' 61 | sub foo { 62 | return "Don't eat the foo"; 63 | } 64 | ... 65 | +++ yaml 66 | --- | 67 | sub foo { 68 | return "Don't eat the foo"; 69 | } 70 | 71 | === Single Dash 72 | +++ perl: {foo => '-'} 73 | +++ yaml 74 | --- 75 | foo: '-' 76 | -------------------------------------------------------------------------------- /test/dump-blessed-glob.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 3; 4 | 5 | package Foo::Bar; 6 | 7 | sub new { 8 | my ($class) = @_; 9 | my $ref = globref(); 10 | my $self = bless $ref, $class; 11 | return $self; 12 | } 13 | 14 | my $globnum = 0; 15 | sub globref { 16 | my $symbolname = "Foo::Glob::glob$globnum"; 17 | $globnum ++; 18 | no strict 'refs'; 19 | return \*{ $symbolname }; 20 | } 21 | 22 | 23 | package main; 24 | 25 | is(Test::YAML::Dump({ globref => Foo::Bar::globref() }), < Foo::Bar->new }), <new; 42 | ${ *$val } = 'wag'; 43 | %{ *$val } = qw( key value hash pairs ); 44 | @{ *$val } = qw( a b c ); 45 | open *$val, '>&', \*STDERR or die "Can't dup STDERR: $!"; 46 | *{$val} = sub { 2 + 2 }; 47 | 48 | my $dump_tricks = Test::YAML::Dump({ blessglob => $val }); 49 | 50 | # Redact some highly variable stuff from the IO 51 | my $changekeys = join '|', 52 | qw( fileno device inode mode links uid gid rdev size atime mtime ), 53 | qw( ctime blksize blocks tell ); 54 | $dump_tricks =~ s{($changekeys): \S+$}{$1: redact}mg; 55 | 56 | is($dump_tricks, < 2; 4 | 5 | package Foo::Bar; 6 | 7 | use TestYAMLBase; 8 | 9 | our @ISA = 'TestYAMLBase'; 10 | 11 | sub yaml_dump { 12 | my $self = shift; 13 | my $node = YAML::Node->new({ 14 | two => $self->{two} - 1, 15 | one => $self->{one} + 1, 16 | }, 'perl/Foo::Bar'); 17 | YAML::Node::ynode($node)->keys(['two', 'one']); 18 | return $node; 19 | } 20 | 21 | sub yaml_load { 22 | my $class = shift; 23 | my $node = shift; 24 | my $self = $class->new; 25 | $self->{one} = ($node->{one} - 1); 26 | $self->{two} = ($node->{two} + 1); 27 | return $self; 28 | } 29 | 30 | package main; 31 | 32 | no_diff; 33 | run_roundtrip_nyn; 34 | 35 | __END__ 36 | 37 | === Object class handles marshalling 38 | +++ perl 39 | my $fb = Foo::Bar->new(); 40 | $fb->{one} = 5; 41 | $fb->{two} = 3; 42 | $fb; 43 | +++ yaml 44 | --- !perl/Foo::Bar 45 | two: 2 46 | one: 6 47 | -------------------------------------------------------------------------------- /test/dump-code.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 7; 4 | use YAML (); # [CPAN #74687] must load before B::Deparse for B::Deparse < 0.71 5 | 6 | use B::Deparse; 7 | if (new B::Deparse -> coderef2text ( sub { no strict; 1; use strict; 1; }) 8 | =~ 'refs') { 9 | local $/; 10 | (my $data = ) =~ s/use strict/use strict 'refs'/g if $] < 5.015; 11 | if ($B::Deparse::VERSION > 0.67 and $B::Deparse::VERSION < 0.71) { # [CPAN #73702] 12 | $data =~ s/use warnings;/BEGIN {\${^WARNING_BITS} = "UUUUUUUUUUUU\\001"}/g; 13 | } 14 | open DATA, '<', \$data; 15 | } 16 | 17 | no_diff; 18 | run_roundtrip_nyn('dumper'); 19 | 20 | __DATA__ 21 | 22 | === a code ref 23 | +++ config 24 | local $YAML::DumpCode = 1; 25 | +++ perl 26 | package main; 27 | return sub { 'Something at least 30 chars' }; 28 | +++ yaml 29 | --- !!perl/code | 30 | { 31 | use warnings; 32 | use strict; 33 | 'Something at least 30 chars'; 34 | } 35 | 36 | === an array of the same code ref 37 | +++ config 38 | local $YAML::DumpCode = 1; 39 | +++ perl 40 | package main; 41 | my $joe_random_global = sub { 'Something at least 30 chars' }; 42 | [$joe_random_global, $joe_random_global, $joe_random_global]; 43 | +++ yaml 44 | --- 45 | - &1 !!perl/code | 46 | { 47 | use warnings; 48 | use strict; 49 | 'Something at least 30 chars'; 50 | } 51 | - *1 52 | - *1 53 | 54 | === dummy code ref 55 | +++ config 56 | local $YAML::DumpCode = 0; 57 | +++ perl 58 | sub { 'Something at least 30 chars' } 59 | +++ yaml 60 | --- !!perl/code '{ "DUMMY" }' 61 | 62 | === blessed code ref 63 | +++ config 64 | local $YAML::DumpCode = 1; 65 | +++ perl 66 | package main; 67 | bless sub { 'Something at least 30 chars' }, "Foo::Bar"; 68 | +++ no_round_trip 69 | +++ yaml 70 | --- !!perl/code:Foo::Bar | 71 | { 72 | use warnings; 73 | use strict; 74 | 'Something at least 30 chars'; 75 | } 76 | -------------------------------------------------------------------------------- /test/dump-file-utf8.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | my $t = -e 't' ? 't' : 'test'; 4 | 5 | use utf8; 6 | use lib 'inc'; 7 | use Test::YAML(); 8 | BEGIN { 9 | @Test::YAML::EXPORT = 10 | grep { not /^(Dump|Load)(File)?$/ } @Test::YAML::EXPORT; 11 | } 12 | use TestYAML tests => 6; 13 | 14 | use YAML qw/DumpFile LoadFile/; 15 | 16 | ok defined &DumpFile, 17 | 'DumpFile exported'; 18 | 19 | ok defined &LoadFile, 20 | 'LoadFile exported'; 21 | 22 | my $file = "$t/dump-file-utf8-$$.yaml"; 23 | 24 | # A scalar containing non-ASCII characters 25 | my $data = 'Olivier Mengué'; 26 | is length($data), 14, 'Test source is correctly encoded'; 27 | 28 | DumpFile($file, $data); 29 | 30 | ok -e $file, 31 | 'Output file exists'; 32 | 33 | open IN, '<:utf8', $file or die $!; 34 | my $yaml = do { local $/; }; 35 | close IN; 36 | 37 | is $yaml, "--- $data\n", 'DumpFile YAML encoding is correct'; 38 | 39 | 40 | my $read = LoadFile($file); 41 | is $read, $data, 'LoadFile is ok'; 42 | 43 | unlink $file; 44 | -------------------------------------------------------------------------------- /test/dump-file.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | my $t = -e 't' ? 't' : 'test'; 4 | 5 | use lib 'inc'; 6 | use Test::YAML(); 7 | BEGIN { 8 | @Test::YAML::EXPORT = 9 | grep { not /^(Dump|Load)(File)?$/ } @Test::YAML::EXPORT; 10 | } 11 | use TestYAML tests => 3; 12 | 13 | use YAML 'DumpFile'; 14 | 15 | ok defined &DumpFile, 16 | 'Dumpfile exported'; 17 | 18 | my $file = "$t/dump-file-$$.yaml"; 19 | 20 | DumpFile($file, [1..3]); 21 | 22 | ok -e $file, 23 | 'Output file exists'; 24 | 25 | open IN, $file or die $!; 26 | my $yaml = join '', ; 27 | close IN; 28 | 29 | is $yaml, <<'...', 'DumpFile YAML is correct'; 30 | --- 31 | - 1 32 | - 2 33 | - 3 34 | ... 35 | 36 | unlink $file; 37 | -------------------------------------------------------------------------------- /test/dump-nested.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 20; 4 | 5 | no_diff(); 6 | run_roundtrip_nyn(); 7 | 8 | __DATA__ 9 | === 10 | +++ perl 11 | ['foo ' x 20] 12 | +++ yaml 13 | --- 14 | - 'foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo ' 15 | === 16 | +++ perl 17 | [q{YAML(tm) (rhymes with "camel") is a straightforward machine parsable data serialization format designed for human readability and interaction with scripting languages such as Perl and Python. YAML is optimized for data serialization, configuration settings, log files, Internet messaging and filtering. YAML(tm) is a balance of the following design goals:}] 18 | +++ yaml 19 | --- 20 | - 'YAML(tm) (rhymes with "camel") is a straightforward machine parsable data serialization format designed for human readability and interaction with scripting languages such as Perl and Python. YAML is optimized for data serialization, configuration settings, log files, Internet messaging and filtering. YAML(tm) is a balance of the following design goals:' 21 | === 22 | +++ perl 23 | [q{It reads one character at a time, with the ability to push back any number of characters up to a maximum, and with nested mark() / reset() / unmark() functions. The input of the stream reader is any java.io.Reader. The output are characters. 24 | The parser (and event generator) 25 | 26 | The input of the parser are characters. These characters are directly fed into the functions that implement the different productions. The output of the parser are events, a well defined and small set of events.}] 27 | +++ yaml 28 | --- 29 | - |- 30 | It reads one character at a time, with the ability to push back any number of characters up to a maximum, and with nested mark() / reset() / unmark() functions. The input of the stream reader is any java.io.Reader. The output are characters. 31 | The parser (and event generator) 32 | 33 | The input of the parser are characters. These characters are directly fed into the functions that implement the different productions. The output of the parser are events, a well defined and small set of events. 34 | === 35 | +++ perl 36 | < 19; 4 | 5 | run_roundtrip_nyn(); 6 | 7 | __DATA__ 8 | === 9 | +++ config 10 | local $YAML::UseHeader = 0 11 | +++ perl 12 | (['34', '45'], ['56', '67']) 13 | +++ yaml 14 | - 34 15 | - 45 16 | --- 17 | - 56 18 | - 67 19 | === 20 | +++ no_round_trip 21 | +++ config 22 | local $YAML::UseAliases = 0 23 | +++ perl 24 | my $ref = {foo => 'bar'}; 25 | [$ref, $ref] 26 | +++ yaml 27 | --- 28 | - foo: bar 29 | - foo: bar 30 | === 31 | +++ config 32 | local $YAML::CompressSeries = 1 33 | +++ perl 34 | [ 35 | {foo => 'bar'}, 36 | {lips => 'red', crown => 'head'}, 37 | {trix => [ 'foo', {silly => 'rabbit', bratty => 'kids', } ] }, 38 | ] 39 | +++ yaml 40 | --- 41 | - foo: bar 42 | - crown: head 43 | lips: red 44 | - trix: 45 | - foo 46 | - bratty: kids 47 | silly: rabbit 48 | === 49 | +++ config 50 | local $YAML::CompressSeries = 0; 51 | local $YAML::Indent = 5 52 | +++ perl 53 | [ 54 | {one => 'fun', pun => 'none'}, 55 | two => 'foo', 56 | {three => [ {free => 'willy', dally => 'dilly'} ]}, 57 | ] 58 | +++ yaml 59 | --- 60 | - 61 | one: fun 62 | pun: none 63 | - two 64 | - foo 65 | - 66 | three: 67 | - 68 | dally: dilly 69 | free: willy 70 | === 71 | +++ config 72 | local $YAML::CompressSeries = 1; 73 | local $YAML::Indent = 5 74 | +++ perl 75 | [ 76 | {one => 'fun', pun => 'none'}, 77 | two => {foo => {true => 'blue'}}, 78 | {three => [ {free => 'willy', dally => 'dilly'} ]}, 79 | ] 80 | +++ yaml 81 | --- 82 | - one: fun 83 | pun: none 84 | - two 85 | - foo: 86 | true: blue 87 | - three: 88 | - dally: dilly 89 | free: willy 90 | === 91 | +++ config 92 | local $YAML::Indent = 3 93 | +++ perl 94 | [{ one => 'two', three => 'four' }, { foo => 'bar' }, ] 95 | +++ yaml 96 | --- 97 | - one: two 98 | three: four 99 | - foo: bar 100 | === 101 | +++ config 102 | local $YAML::CompressSeries = 1 103 | +++ perl 104 | [ 105 | 'The', 106 | {speed => 'quick', color => 'brown', &YAML::VALUE => 'fox'}, 107 | 'jumped over the', 108 | {speed => 'lazy', &YAML::VALUE, 'dog'}, 109 | ] 110 | +++ yaml 111 | --- 112 | - The 113 | - color: brown 114 | speed: quick 115 | =: fox 116 | - jumped over the 117 | - speed: lazy 118 | =: dog 119 | === 120 | +++ config 121 | local $YAML::InlineSeries = 3 122 | +++ perl 123 | [ 124 | ['10', '20', '30'], 125 | ['foo', 'bar'], 126 | ['thank', 'god', "it's", 'friday'], 127 | ] 128 | +++ yaml 129 | --- 130 | - [10, 20, 30] 131 | - [foo, bar] 132 | - 133 | - thank 134 | - god 135 | - it's 136 | - friday 137 | === 138 | +++ config 139 | local $YAML::SortKeys = [qw(foo bar baz)] 140 | +++ perl 141 | {foo=>'42',bar=>'99',baz=>'4'} 142 | +++ yaml 143 | --- 144 | foo: 42 145 | bar: 99 146 | baz: 4 147 | === 148 | +++ perl 149 | {foo => '42', bar => 'baz'} 150 | +++ yaml 151 | --- 152 | bar: baz 153 | foo: 42 154 | -------------------------------------------------------------------------------- /test/dump-perl-types-512.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More; 4 | BEGIN { 5 | if ( qr/x/ =~ /\(\?\^/ ){ 6 | plan skip_all => "test only for perls before v5.13.5-11-gfb85c04"; 7 | } 8 | } 9 | use TestYAML tests => 2; 10 | 11 | filters { perl => ['eval', 'yaml_dump'] }; 12 | 13 | no_diff; 14 | run_is ( perl => 'yaml' ); 15 | 16 | __DATA__ 17 | === Regular Expression 18 | +++ perl: qr{perfect match}; 19 | +++ yaml 20 | --- !!perl/regexp (?-xism:perfect match) 21 | 22 | === Regular Expression with newline 23 | +++ perl 24 | qr{perfect 25 | match}x; 26 | +++ yaml 27 | --- !!perl/regexp "(?x-ism:perfect\nmatch)" 28 | 29 | -------------------------------------------------------------------------------- /test/dump-perl-types-514.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More; 4 | BEGIN { 5 | unless ( qr/x/ =~ /\(\?\^/ ){ 6 | plan skip_all => "test only for perls v5.13.5-11-gfb85c04 or later"; 7 | } 8 | } 9 | use TestYAML tests => 2; 10 | 11 | filters { perl => ['eval', 'yaml_dump'] }; 12 | 13 | no_diff; 14 | run_is ( perl => 'yaml' ); 15 | 16 | __DATA__ 17 | === Regular Expression 18 | +++ perl: qr{perfect match}; 19 | +++ yaml 20 | --- !!perl/regexp (?^:perfect match) 21 | 22 | === Regular Expression with newline 23 | +++ perl 24 | qr{perfect 25 | match}x; 26 | +++ yaml 27 | --- !!perl/regexp "(?^x:perfect\nmatch)" 28 | 29 | -------------------------------------------------------------------------------- /test/dump-perl-types.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 14; 4 | 5 | filters { perl => ['eval', 'yaml_dump'] }; 6 | 7 | use YAML (); # [CPAN #74687] must load before B::Deparse for B::Deparse < 0.71 8 | use B::Deparse; 9 | if (new B::Deparse -> coderef2text ( sub { no strict; 1; use strict; 1; }) 10 | =~ 'refs') { 11 | local $/; 12 | (my $data = ) =~ s/use strict/use strict 'refs'/g; 13 | if ($B::Deparse::VERSION > 0.67 and $B::Deparse::VERSION < 0.71) { # [CPAN #73702] 14 | $data =~ s/use warnings;/BEGIN {\${^WARNING_BITS} = "UUUUUUUUUUUU\\001"}/g; 15 | } 16 | open DATA, '<', \$data; 17 | } 18 | 19 | no_diff; 20 | run_is perl => 'yaml'; 21 | 22 | __DATA__ 23 | 24 | === Scalar 25 | +++ perl: 'Hello' 26 | +++ yaml 27 | --- Hello 28 | 29 | === Hash 30 | +++ perl: +{bar => 'foo', foo => 'bar'} 31 | +++ yaml 32 | --- 33 | bar: foo 34 | foo: bar 35 | 36 | === Array 37 | +++ perl: [qw(W O W)] 38 | +++ yaml 39 | --- 40 | - W 41 | - O 42 | - W 43 | 44 | === Code 45 | +++ perl 46 | $YAML::DumpCode = 1; 47 | package main; 48 | sub { print "Hello, world\n"; } 49 | +++ yaml 50 | --- !!perl/code | 51 | { 52 | use warnings; 53 | use strict; 54 | print "Hello, world\n"; 55 | } 56 | 57 | === Scalar Reference 58 | +++ perl: \ 'Goodbye' 59 | +++ yaml 60 | --- !!perl/ref 61 | =: Goodbye 62 | 63 | === Scalar Glob 64 | +++ perl 65 | $::var = 'Hola'; 66 | *::var; 67 | +++ yaml 68 | --- !!perl/glob: 69 | PACKAGE: main 70 | NAME: var 71 | SCALAR: Hola 72 | 73 | === Array Glob 74 | +++ perl 75 | @::var2 = (qw(xxx yyy zzz)); 76 | *::var2; 77 | +++ yaml 78 | --- !!perl/glob: 79 | PACKAGE: main 80 | NAME: var2 81 | ARRAY: 82 | - xxx 83 | - yyy 84 | - zzz 85 | 86 | === Code Glob 87 | +++ perl 88 | $YAML::DumpCode = 1; 89 | package main; 90 | sub main::var3 { print "Hello, world\n"; } 91 | *var3; 92 | +++ yaml 93 | --- !!perl/glob: 94 | PACKAGE: main 95 | NAME: var3 96 | CODE: !!perl/code | 97 | { 98 | use warnings; 99 | use strict; 100 | print "Hello, world\n"; 101 | } 102 | 103 | === Blessed Empty Hash 104 | +++ perl: bless {}, 'A::B::C'; 105 | +++ yaml 106 | --- !!perl/hash:A::B::C {} 107 | 108 | === Blessed Populated Hash 109 | +++ perl: bless {qw(foo bar bar foo)}, 'A::B::C'; 110 | +++ yaml 111 | --- !!perl/hash:A::B::C 112 | bar: foo 113 | foo: bar 114 | 115 | === Blessed Empty Array 116 | +++ perl: bless [], 'A::B::C'; 117 | +++ yaml 118 | --- !!perl/array:A::B::C [] 119 | 120 | === Blessed Populated Array 121 | +++ perl: bless [qw(foo bar bar foo)], 'A::B::C'; 122 | +++ yaml 123 | --- !!perl/array:A::B::C 124 | - foo 125 | - bar 126 | - bar 127 | - foo 128 | 129 | === Blessed Empty String 130 | +++ perl: my $e = ''; bless \ $e, 'A::B::C'; 131 | +++ yaml 132 | --- !!perl/scalar:A::B::C '' 133 | 134 | === Blessed Populated String 135 | +++ perl: my $fbbf = 'foo bar bar foo'; bless \ $fbbf, 'A::B::C'; 136 | +++ yaml 137 | --- !!perl/scalar:A::B::C foo bar bar foo 138 | 139 | === Blessed Regular Expression 140 | +++ SKIP 141 | +++ perl: bless qr{perfect match}, 'A::B::C'; 142 | +++ yaml 143 | --- !!perl/regexp:A::B::C perfect match 144 | 145 | === Blessed Glob 146 | +++ SKIP 147 | +++ perl: $::x = 42; bless \ *::x, 'A::B::C'; 148 | +++ yaml 149 | --- !!perl/glob:A::B::C 150 | PACKAGE: main 151 | NAME: x 152 | SCALAR: 42 153 | 154 | -------------------------------------------------------------------------------- /test/dump-stringify.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 6; 4 | 5 | no_diff; 6 | 7 | package Foo; 8 | 9 | use overload '""' => \&stringy; 10 | 11 | sub stringy { 'Hello mate!' } 12 | 13 | sub new { bless { 'Hello' => 'mate!' }, shift }; 14 | 15 | package main; 16 | 17 | my $foo = Foo->new; 18 | 19 | my $stringy_dump = <<''; 20 | --- Hello mate! 21 | 22 | my $object_dump = <<''; 23 | --- !!perl/hash:Foo 24 | Hello: mate! 25 | 26 | my $yaml; 27 | 28 | $yaml = Dump($foo); 29 | is $yaml, $object_dump, "Global stringification default dump"; 30 | 31 | $YAML::Stringify = 1; 32 | $yaml = Dump($foo); 33 | is $yaml, $stringy_dump, "Global stringification enabled dump"; 34 | 35 | $YAML::Stringify = 0; 36 | $yaml = Dump($foo); 37 | is $yaml, $object_dump, "Global stringification disabled dump"; 38 | 39 | require YAML::Dumper; 40 | my $dumper = YAML::Dumper->new; 41 | 42 | $yaml = $dumper->dump($foo); 43 | is $yaml, $object_dump, "Local stringification default dump"; 44 | 45 | $dumper->stringify(1); 46 | $yaml = $dumper->dump($foo); 47 | is $yaml, $stringy_dump, "Local stringification enabled dump"; 48 | 49 | $dumper->stringify(0); 50 | $yaml = $dumper->dump($foo); 51 | is $yaml, $object_dump, "Local stringification disabled dump"; 52 | -------------------------------------------------------------------------------- /test/dump-stringy-numbers.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 6; 4 | use YAML (); 5 | use YAML::Dumper; 6 | 7 | $YAML::QuoteNumericStrings = 1; 8 | filters { perl => [qw'eval yaml_dump'], }; 9 | 10 | ok( YAML::Dumper->is_literal_number(1), '1 is a literal number' ); 11 | ok( !YAML::Dumper->is_literal_number("1"), '"1" is not a literal number' ); 12 | ok( YAML::Dumper->is_literal_number( "1" + 1 ), '"1" +1 is a literal number' ); 13 | 14 | run_is; 15 | 16 | __DATA__ 17 | === Mixed Literal and Stringy ints 18 | +++ perl 19 | +{ foo => '2', baz => 1 } 20 | +++ yaml 21 | --- 22 | baz: 1 23 | foo: '2' 24 | 25 | === Mixed Literal and Stringy floats 26 | +++ perl 27 | +{ foo => '2.000', baz => 1.000 } 28 | +++ yaml 29 | --- 30 | baz: 1 31 | foo: '2.000' 32 | 33 | === Numeric Keys 34 | +++ perl 35 | +{ 10 => '2.000', 20 => 1.000, '030' => 2.000 } 36 | +++ yaml 37 | --- 38 | '030': 2 39 | '10': '2.000' 40 | '20': 1 41 | 42 | -------------------------------------------------------------------------------- /test/dump-synopsis.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More tests => 1; 5 | 6 | my $success = 0; 7 | my $err; 8 | { 9 | local $@; 10 | eval { 11 | require YAML::Dumper; 12 | my $hash = {}; 13 | my $dumper = YAML::Dumper->new(); 14 | my $string = $dumper->dump($hash); 15 | $success = 1; 16 | }; 17 | $err = $@; 18 | } 19 | is( $success, 1, "Basic YAML::Dumper usage worked as expected" ) 20 | or diag( explain($err) ); 21 | 22 | -------------------------------------------------------------------------------- /test/dump-tests-512.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More; 4 | BEGIN { 5 | if ( qr/x/ =~ /\(\?\^/ ){ 6 | plan skip_all => "test only for perls before v5.13.5-11-gfb85c04"; 7 | } 8 | } 9 | use TestYAML tests => 1; 10 | 11 | no_diff(); 12 | run_roundtrip_nyn('dumper'); 13 | 14 | __DATA__ 15 | === 16 | +++ no_round_trip 17 | Since we don't use eval for regexp reconstitution any more (for safety 18 | sake) this test doesn't roundtrip even though the values are equivalent. 19 | +++ perl 20 | [qr{bozo$}i] 21 | +++ yaml 22 | --- 23 | - !!perl/regexp (?i-xsm:bozo$) 24 | 25 | -------------------------------------------------------------------------------- /test/dump-tests-514.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More; 4 | BEGIN { 5 | unless ( qr/x/ =~ /\(\?\^/ ){ 6 | plan skip_all => "test only for perls v5.13.5-11-gfb85c04 or later"; 7 | } 8 | } 9 | use TestYAML tests => 1; 10 | 11 | no_diff(); 12 | run_roundtrip_nyn('dumper'); 13 | 14 | __DATA__ 15 | === 16 | +++ no_round_trip 17 | Since we don't use eval for regexp reconstitution any more (for safety 18 | sake) this test doesn't roundtrip even though the values are equivalent. 19 | +++ perl 20 | [qr{bozo$}i] 21 | +++ yaml 22 | --- 23 | - !!perl/regexp (?^i:bozo$) 24 | 25 | -------------------------------------------------------------------------------- /test/dump-tests.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 57; 4 | local $YAML::LoadBlessed; 5 | $YAML::LoadBlessed = 1; 6 | 7 | no_diff(); 8 | run_roundtrip_nyn('dumper'); 9 | 10 | __DATA__ 11 | 12 | === 13 | +++ perl 14 | [ "foo\nbar", "I like pie\nYou like pie\nWe all like pie" ] 15 | +++ yaml 16 | --- 17 | - "foo\nbar" 18 | - |- 19 | I like pie 20 | You like pie 21 | We all like pie 22 | 23 | === 24 | +++ perl 25 | {name => 'Ingy dot Net', 26 | rank => 'JAPH', 27 | 'serial number' => '8675309', 28 | }; 29 | +++ yaml 30 | --- 31 | name: Ingy dot Net 32 | rank: JAPH 33 | serial number: 8675309 34 | 35 | === 36 | +++ perl 37 | {fruits => [qw(apples oranges pears)], 38 | meats => [qw(beef pork chicken)], 39 | vegetables => [qw(carrots peas corn)], 40 | } 41 | +++ yaml 42 | --- 43 | fruits: 44 | - apples 45 | - oranges 46 | - pears 47 | meats: 48 | - beef 49 | - pork 50 | - chicken 51 | vegetables: 52 | - carrots 53 | - peas 54 | - corn 55 | 56 | === 57 | +++ perl 58 | ['42', '43', '-44', '45'] 59 | +++ yaml 60 | --- 61 | - 42 62 | - 43 63 | - -44 64 | - 45 65 | 66 | === 67 | +++ perl 68 | [ 69 | 'foo bar', 70 | 'http://www.yaml.org', 71 | '12:34' 72 | ] 73 | +++ yaml 74 | --- 75 | - foo bar 76 | - http://www.yaml.org 77 | - 12:34 78 | 79 | === 80 | +++ perl 81 | ('1', " foo ", "bar\n", [], {}) 82 | +++ yaml 83 | --- 1 84 | --- ' foo ' 85 | --- "bar\n" 86 | --- [] 87 | --- {} 88 | 89 | === 90 | +++ perl 91 | '8\'-0" x 24" Lightweight' 92 | +++ yaml 93 | --- 8'-0" x 24" Lightweight 94 | 95 | === 96 | +++ perl 97 | bless {}, 'Foo::Bar' 98 | +++ yaml 99 | --- !!perl/hash:Foo::Bar {} 100 | 101 | === 102 | +++ perl 103 | bless {qw(foo 42 bar 43)}, 'Foo::Bar' 104 | +++ yaml 105 | --- !!perl/hash:Foo::Bar 106 | bar: 43 107 | foo: 42 108 | 109 | === 110 | +++ perl 111 | bless [], 'Foo::Bar' 112 | +++ yaml 113 | --- !!perl/array:Foo::Bar [] 114 | 115 | === 116 | +++ perl 117 | bless [map "$_",42..45], 'Foo::Bar' 118 | +++ yaml 119 | --- !!perl/array:Foo::Bar 120 | - 42 121 | - 43 122 | - 44 123 | - 45 124 | 125 | === 126 | +++ perl 127 | my $yn = YAML::Node->new({}, 'foo.com/bar'); 128 | $yn->{foo} = 'bar'; 129 | $yn->{bar} = 'baz'; 130 | $yn->{baz} = 'foo'; 131 | $yn 132 | +++ yaml 133 | --- !foo.com/bar 134 | foo: bar 135 | bar: baz 136 | baz: foo 137 | 138 | === 139 | +++ perl 140 | use YAML::Node; 141 | +++ no_round_trip 142 | +++ perl 143 | my $a = ''; 144 | bless \$a, 'Foo::Bark'; 145 | +++ yaml 146 | --- !!perl/scalar:Foo::Bark '' 147 | 148 | === Strings with nulls 149 | +++ perl 150 | "foo\0bar" 151 | +++ yaml 152 | --- "foo\0bar" 153 | 154 | === 155 | +++ no_round_trip 156 | XXX: probably a YAML.pm bug 157 | +++ perl 158 | &YAML::VALUE 159 | +++ yaml 160 | --- = 161 | 162 | === 163 | +++ perl 164 | my $ref = {foo => 'bar'}; 165 | [$ref, $ref] 166 | +++ yaml 167 | --- 168 | - &1 169 | foo: bar 170 | - *1 171 | 172 | === 173 | +++ perl 174 | no strict; 175 | package main; 176 | $joe_random_global = 42; 177 | @joe_random_global = (43, 44); 178 | *joe_random_global 179 | +++ yaml 180 | --- !!perl/glob: 181 | PACKAGE: main 182 | NAME: joe_random_global 183 | SCALAR: 42 184 | ARRAY: 185 | - 43 186 | - 44 187 | 188 | === 189 | +++ perl 190 | no strict; 191 | package main; 192 | \*joe_random_global 193 | +++ yaml 194 | --- !!perl/ref 195 | =: !!perl/glob: 196 | PACKAGE: main 197 | NAME: joe_random_global 198 | SCALAR: 42 199 | ARRAY: 200 | - 43 201 | - 44 202 | 203 | === 204 | +++ no_round_trip 205 | +++ perl 206 | my $foo = {qw(apple 1 banana 2 carrot 3 date 4)}; 207 | YAML::Bless($foo)->keys([qw(banana apple date)]); 208 | $foo 209 | +++ yaml 210 | --- 211 | banana: 2 212 | apple: 1 213 | date: 4 214 | 215 | === 216 | +++ no_round_trip 217 | +++ perl 218 | use YAML::Node; 219 | my $foo = {qw(apple 1 banana 2 carrot 3 date 4)}; 220 | my $yn = YAML::Node->new($foo); 221 | YAML::Bless($foo, $yn)->keys([qw(apple)]); # red herring 222 | ynode($yn)->keys([qw(banana date)]); 223 | $foo 224 | +++ yaml 225 | --- 226 | banana: 2 227 | date: 4 228 | 229 | === 230 | +++ no_round_trip 231 | XXX: probably a test driver bug 232 | +++ perl 233 | my $joe_random_global = {qw(apple 1 banana 2 carrot 3 date 4)}; 234 | YAML::Bless($joe_random_global, 'TestBless'); 235 | return [$joe_random_global, $joe_random_global]; 236 | package TestBless; 237 | use YAML::Node; 238 | sub yaml_dump { 239 | my $yn = YAML::Node->new($_[0]); 240 | ynode($yn)->keys([qw(apple pear carrot)]); 241 | $yn->{pear} = $yn; 242 | return $yn; 243 | } 244 | +++ yaml 245 | --- 246 | - &1 247 | apple: 1 248 | pear: *1 249 | carrot: 3 250 | - *1 251 | 252 | === 253 | +++ no_round_trip 254 | +++ perl 255 | use YAML::Node; 256 | my $joe_random_global = {qw(apple 1 banana 2 carrot 3 date 4)}; 257 | YAML::Bless($joe_random_global); 258 | my $yn = YAML::Blessed($joe_random_global); 259 | delete $yn->{banana}; 260 | $joe_random_global 261 | +++ yaml 262 | --- 263 | apple: 1 264 | carrot: 3 265 | date: 4 266 | 267 | === 268 | +++ perl 269 | my $joe_random_global = \\\\\\\'42'; 270 | [ 271 | $joe_random_global, 272 | $$$$joe_random_global, 273 | $joe_random_global, 274 | $$$$$$$joe_random_global, 275 | $$$$$$$$joe_random_global 276 | ] 277 | +++ yaml 278 | --- 279 | - &1 !!perl/ref 280 | =: !!perl/ref 281 | =: !!perl/ref 282 | =: &2 !!perl/ref 283 | =: !!perl/ref 284 | =: !!perl/ref 285 | =: &3 !!perl/ref 286 | =: 42 287 | - *2 288 | - *1 289 | - *3 290 | - 42 291 | 292 | === 293 | +++ perl 294 | local $YAML::Indent = 1; 295 | [{qw(foo 42 bar 44)}] 296 | +++ yaml 297 | --- 298 | - bar: 44 299 | foo: 42 300 | 301 | === 302 | +++ perl 303 | local $YAML::Indent = 4; 304 | [{qw(foo 42 bar 44)}] 305 | +++ yaml 306 | --- 307 | - bar: 44 308 | foo: 42 309 | 310 | === 311 | +++ perl 312 | [undef, undef] 313 | +++ yaml 314 | --- 315 | - ~ 316 | - ~ 317 | 318 | === 319 | +++ perl 320 | my $joe_random_global = []; 321 | push @$joe_random_global, $joe_random_global; 322 | bless $joe_random_global, 'XYZ'; 323 | $joe_random_global 324 | +++ yaml 325 | --- &1 !!perl/array:XYZ 326 | - *1 327 | 328 | === 329 | +++ perl 330 | [ 331 | '23', 332 | '3.45', 333 | '123456789012345', 334 | ] 335 | +++ yaml 336 | --- 337 | - 23 338 | - 3.45 339 | - 123456789012345 340 | 341 | === 342 | +++ perl 343 | {'foo: bar' => 'baz # boo', 'foo ' => ' monkey', } 344 | +++ yaml 345 | --- 346 | 'foo ': ' monkey' 347 | 'foo: bar': 'baz # boo' 348 | 349 | === 350 | +++ no_round_trip 351 | +++ perl 352 | $a = \\\\\\\\"foo"; $b = $$$$$a; 353 | ([$a, $b], [$b, $a]) 354 | +++ yaml 355 | --- 356 | - !!perl/ref 357 | =: !!perl/ref 358 | =: !!perl/ref 359 | =: !!perl/ref 360 | =: &1 !!perl/ref 361 | =: !!perl/ref 362 | =: !!perl/ref 363 | =: !!perl/ref 364 | =: foo 365 | - *1 366 | --- 367 | - &1 !!perl/ref 368 | =: !!perl/ref 369 | =: !!perl/ref 370 | =: !!perl/ref 371 | =: foo 372 | - !!perl/ref 373 | =: !!perl/ref 374 | =: !!perl/ref 375 | =: !!perl/ref 376 | =: *1 377 | 378 | === 379 | +++ no_round_trip 380 | XXX an AutoBless feature could make this rt 381 | +++ perl 382 | $a = YAML::Node->new({qw(a 1 b 2 c 3 d 4)}, 'ingy.com/foo'); 383 | YAML::Node::ynode($a)->keys([qw(d b a)]); 384 | $a; 385 | +++ yaml 386 | --- !ingy.com/foo 387 | d: 4 388 | b: 2 389 | a: 1 390 | 391 | === 392 | +++ no_round_trip 393 | +++ perl 394 | $a = 'bitter buffalo'; 395 | bless \$a, 'Heart'; 396 | +++ yaml 397 | --- !!perl/scalar:Heart bitter buffalo 398 | 399 | === 400 | +++ perl 401 | { 'foo[bar]' => 'baz' } 402 | +++ yaml 403 | --- 404 | 'foo[bar]': baz 405 | -------------------------------------------------------------------------------- /test/dump-works.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML; 4 | 5 | run_is; 6 | 7 | sub yaml_dump { 8 | return Dump(@_); 9 | } 10 | 11 | __DATA__ 12 | === A one key hash 13 | +++ perl eval yaml_dump 14 | +{foo => 'bar'} 15 | +++ yaml 16 | --- 17 | foo: bar 18 | -------------------------------------------------------------------------------- /test/errors.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 39; 4 | $^W = 1; 5 | 6 | use YAML::Error; 7 | 8 | filters { 9 | error => 'regexp', 10 | yaml => [mutate_yaml => 'yaml_load_error_or_warning' => 'check_yaml'], 11 | perl => 'perl_eval_error_or_warning', 12 | }; 13 | 14 | run_like('yaml' => 'error'); 15 | run_like('perl' => 'error'); 16 | 17 | sub mutate_yaml { 18 | s/\Q<%CNTL-G%>\E/\007/; 19 | chomp if /msg_no_newline/; 20 | } 21 | 22 | sub check_yaml { 23 | my $yaml = shift; 24 | return $yaml unless ref($yaml); 25 | print "YAML actually loaded:\n" . Data::Dumper::Dumper($yaml); 26 | return ''; 27 | } 28 | 29 | __DATA__ 30 | === YAML_PARSE_ERR_BAD_CHARS 31 | +++ error: YAML_PARSE_ERR_BAD_CHARS 32 | +++ yaml 33 | # Test msg_bad_chars 34 | --- 35 | - foo 36 | # The next line contains an escape character 37 | - bell -><%CNTL-G%><- 38 | 39 | === YAML_PARSE_ERR_BAD_MAJOR_VERSION 40 | +++ error: YAML_PARSE_ERR_BAD_MAJOR_VERSION 41 | +++ yaml 42 | # Test msg_bad_major_version 43 | --- 44 | - one 45 | - two 46 | --- #YAML:2.0 47 | - foo 48 | - bar 49 | 50 | === YAML_PARSE_WARN_BAD_MINOR_VERSION 51 | +++ error: YAML_PARSE_WARN_BAD_MINOR_VERSION 52 | +++ yaml 53 | # Test msg_bad_minor_version 54 | --- 55 | - one 56 | - two 57 | --- #YAML:1.5 58 | - foo 59 | - bar 60 | 61 | === YAML_PARSE_WARN_MULTIPLE_DIRECTIVES 62 | +++ error: YAML_PARSE_WARN_MULTIPLE_DIRECTIVES 63 | +++ yaml 64 | # Test msg_multiple_directives 65 | --- #YAML:1.0 #YAML:1.0 66 | - foo 67 | --- #FOO:2 #FOO:3 68 | - bar 69 | 70 | === YAML_PARSE_ERR_TEXT_AFTER_INDICATOR 71 | +++ error: YAML_PARSE_ERR_TEXT_AFTER_INDICATOR 72 | +++ yaml 73 | # Test msg_text_after_indicator 74 | --- 75 | - > 76 | This is OK. 77 | - > But this is not 78 | - This is OK 79 | 80 | === YAML_PARSE_ERR_NO_ANCHOR 81 | +++ error: YAML_PARSE_ERR_NO_ANCHOR 82 | +++ yaml 83 | # Test msg_no_anchor 84 | --- 85 | - &moo foo 86 | - bar 87 | - *star 88 | - &star far 89 | 90 | === YAML_PARSE_ERR_INCONSISTENT_INDENTATION 91 | +++ error: YAML_PARSE_ERR_INCONSISTENT_INDENTATION 92 | +++ yaml 93 | --- {foo: bar} 94 | - foo 95 | - bar 96 | 97 | === YAML_PARSE_ERR_SINGLE_LINE 98 | +++ error: YAML_PARSE_ERR_SINGLE_LINE 99 | +++ yaml 100 | --- 101 | - "foo" bar 102 | 103 | === YAML_PARSE_ERR_BAD_ANCHOR 104 | +++ error: YAML_PARSE_ERR_BAD_ANCHOR 105 | +++ yaml 106 | --- 107 | - &X=y 42 108 | 109 | === YAML_PARSE_ERR_BAD_ANCHOR 110 | +++ error: YAML_PARSE_ERR_BAD_ANCHOR 111 | +++ yaml 112 | --- 113 | - & 114 | 115 | #--- 116 | #error: YAML_PARSE_ERR_BAD_NODEX 117 | #load: | 118 | #--- 119 | #error: YAML_PARSE_ERR_BAD_EXPLICITX 120 | #load: | 121 | # I don't think this one can ever happen (yet) 122 | #--- 123 | #error: YAML_DUMP_USAGE_DUMPCODE 124 | #code: | 125 | # local $YAML::DumpCode = [0]; 126 | # Dump(sub { $foo + 42 }); 127 | 128 | === YAML_LOAD_ERR_FILE_INPUT 129 | +++ error: YAML_LOAD_ERR_FILE_INPUT 130 | +++ perl 131 | LoadFile('fooxxx'); 132 | # XXX - Causing bus error!?!? 133 | #--- 134 | #error: YAML_DUMP_ERR_FILE_CONCATENATE 135 | #code: | 136 | # DumpFile(">> YAML.pod", 42); 137 | 138 | === YAML_DUMP_ERR_FILE_OUTPUT 139 | +++ error: YAML_DUMP_ERR_FILE_OUTPUT 140 | +++ perl 141 | Test::YAML::DumpFile("x/y/z.yaml", 42); 142 | 143 | === YAML_DUMP_ERR_NO_HEADER 144 | +++ error: YAML_DUMP_ERR_NO_HEADER 145 | +++ perl 146 | local $YAML::UseHeader = 0; 147 | Test::YAML::Dump(42); 148 | 149 | === YAML_DUMP_ERR_NO_HEADER 150 | +++ error: YAML_DUMP_ERR_NO_HEADER 151 | +++ perl 152 | local $YAML::UseHeader = 0; 153 | Test::YAML::Dump([]); 154 | 155 | === YAML_DUMP_ERR_NO_HEADER 156 | +++ error: YAML_DUMP_ERR_NO_HEADER 157 | +++ perl 158 | local $YAML::UseHeader = 0; 159 | Test::YAML::Dump({}); 160 | #--- 161 | #error: xYAML_DUMP_WARN_BAD_NODE_TYPE 162 | #code: | 163 | # # 164 | #--- 165 | #error: YAML_EMIT_WARN_KEYS 166 | #code: | 167 | # # 168 | #--- 169 | #error: YAML_DUMP_WARN_DEPARSE_FAILED 170 | #code: | 171 | # # 172 | #--- 173 | #error: YAML_DUMP_WARN_CODE_DUMMY 174 | #code: | 175 | # Dump(sub{ 42 }); 176 | 177 | === YAML_PARSE_ERR_MANY_EXPLICIT 178 | +++ error: YAML_PARSE_ERR_MANY_EXPLICIT 179 | +++ yaml 180 | --- 181 | - !foo !bar 42 182 | 183 | === YAML_PARSE_ERR_MANY_IMPLICIT 184 | +++ error: YAML_PARSE_ERR_MANY_IMPLICIT 185 | +++ yaml 186 | --- 187 | - ! ! "42" 188 | 189 | === YAML_PARSE_ERR_MANY_ANCHOR 190 | +++ error: YAML_PARSE_ERR_MANY_ANCHOR 191 | +++ yaml 192 | --- 193 | - &foo &bar 42 194 | 195 | === YAML_PARSE_ERR_ANCHOR_ALIAS 196 | +++ error: YAML_PARSE_ERR_ANCHOR_ALIAS 197 | +++ yaml 198 | --- 199 | - &bar *foo 200 | 201 | === YAML_PARSE_ERR_BAD_ALIAS 202 | +++ error: YAML_PARSE_ERR_BAD_ALIAS 203 | +++ yaml 204 | --- 205 | - *foo=bar 206 | 207 | === YAML_PARSE_ERR_BAD_ALIAS 208 | +++ error: YAML_PARSE_ERR_BAD_ALIAS 209 | +++ yaml 210 | --- 211 | - * 212 | 213 | === YAML_PARSE_ERR_MANY_ALIAS 214 | +++ error: YAML_PARSE_ERR_MANY_ALIAS 215 | +++ yaml 216 | --- 217 | - *foo *bar 218 | 219 | === YAML_LOAD_ERR_NO_CONVERT 220 | +++ SKIP 221 | Actually this should load into a ynode... 222 | +++ error: YAML_LOAD_ERR_NO_CONVERT 223 | +++ yaml 224 | --- 225 | - !foo shoe 226 | 227 | === YAML_LOAD_ERR_NO_DEFAULT_VALUE 228 | +++ error: YAML_LOAD_ERR_NO_DEFAULT_VALUE 229 | +++ yaml 230 | --- 231 | - !perl/ref 232 | foo: bar 233 | #--- 234 | #error: YAML_LOAD_ERR_NON_EMPTY_STRING 235 | #load: | 236 | # --- 237 | # - !map foo 238 | #--- 239 | #error: YAML_LOAD_ERR_NON_EMPTY_STRING 240 | #load: | 241 | # --- 242 | # - !seq foo 243 | #--- 244 | #error: YAML_LOAD_ERR_BAD_MAP_TO_SEQ 245 | #load: | 246 | # --- !seq 247 | # 0: zero 248 | # won: one 249 | # 2: two 250 | # 3: three 251 | #--- 252 | #error: YAML_LOAD_ERR_BAD_GLOB 253 | #load: | 254 | # # 255 | #--- 256 | #error: YAML_LOAD_ERR_BAD_REGEXP 257 | #load: | 258 | # # 259 | 260 | === YAML_LOAD_ERR_BAD_MAP_ELEMENT 261 | +++ error: YAML_LOAD_ERR_BAD_MAP_ELEMENT 262 | +++ yaml 263 | --- 264 | foo: bar 265 | bar 266 | 267 | === YAML_LOAD_WARN_DUPLICATE_KEY 268 | +++ error: YAML_LOAD_WARN_DUPLICATE_KEY 269 | +++ yaml 270 | --- 271 | foo: bar 272 | bar: boo 273 | foo: baz 274 | boo: bah 275 | 276 | === Test duplicate key message 277 | +++ error: YAML Warning: Duplicate map key 'foo' found. Ignoring. 278 | +++ yaml 279 | --- 280 | foo: bar 281 | bar: boo 282 | foo: baz 283 | boo: bah 284 | 285 | === YAML_LOAD_ERR_BAD_SEQ_ELEMENT 286 | +++ error: YAML_LOAD_ERR_BAD_SEQ_ELEMENT 287 | +++ yaml 288 | --- 289 | - 42 290 | foo 291 | 292 | === YAML_PARSE_ERR_INLINE_MAP 293 | +++ error: YAML_PARSE_ERR_INLINE_MAP 294 | +++ yaml 295 | --- 296 | - {foo:bar} 297 | 298 | === YAML_PARSE_ERR_INLINE_SEQUENCE 299 | +++ error: YAML_PARSE_ERR_INLINE_SEQUENCE 300 | +++ yaml 301 | --- 302 | - [foo bar, baz 303 | 304 | === YAML_PARSE_ERR_BAD_DOUBLE 305 | +++ error: YAML_PARSE_ERR_BAD_DOUBLE 306 | +++ yaml 307 | --- 308 | - "foo baz 309 | 310 | === YAML_PARSE_ERR_BAD_SINGLE 311 | +++ error: YAML_PARSE_ERR_BAD_SINGLE 312 | +++ yaml 313 | --- 314 | - 'foo bar 315 | 316 | === YAML_PARSE_ERR_BAD_INLINE_IMPLICIT 317 | +++ error: YAML_PARSE_ERR_BAD_INLINE_IMPLICIT 318 | +++ yaml 319 | --- 320 | - [^gold] 321 | 322 | === YAML_PARSE_ERR_BAD_IMPLICIT 323 | +++ error: YAML_PARSE_ERR_BAD_IMPLICIT 324 | +++ yaml 325 | --- ! > 326 | - 4 foo bar 327 | #--- 328 | #error: xYAML_PARSE_ERR_INDENTATION 329 | #load: | 330 | # --- 331 | 332 | === YAML_PARSE_ERR_INCONSISTENT_INDENTATION 333 | +++ error: YAML_PARSE_ERR_INCONSISTENT_INDENTATION 334 | +++ yaml 335 | --- 336 | foo: bar 337 | bar: baz 338 | #--- 339 | #error: xYAML_LOAD_WARN_UNRESOLVED_ALIAS 340 | #load: | 341 | # --- 342 | # foo: *bar 343 | 344 | # === YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP 345 | # +++ error: YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP 346 | # +++ yaml 347 | # --- 348 | # - !perl/regexp: 349 | # foo: bar 350 | # 351 | # === YAML_LOAD_WARN_BAD_REGEXP_ELEM 352 | # +++ error: YAML_LOAD_WARN_BAD_REGEXP_ELEM 353 | # +++ yaml 354 | # --- 355 | # - !perl/regexp: 356 | # REGEXP: foo 357 | # foo: bar 358 | 359 | === YAML_LOAD_WARN_GLOB_NAME 360 | +++ error: YAML_LOAD_WARN_GLOB_NAME 361 | +++ yaml 362 | --- 363 | - !perl/glob: 364 | foo: bar 365 | #--- 366 | #error: xYAML_LOAD_WARN_PARSE_CODE 367 | #load: | 368 | # --- 369 | #--- 370 | #error: YAML_LOAD_WARN_CODE_DEPARSE 371 | #load: | 372 | # --- 373 | # - !perl/code | 374 | # sub { "foo" } 375 | #--- 376 | #error: xYAML_EMIT_ERR_BAD_LEVEL 377 | #code: 378 | # # 379 | #--- 380 | #error: YAML_PARSE_WARN_AMBIGUOUS_TAB 381 | #load: | 382 | # --- 383 | # - | 384 | # foo 385 | # bar 386 | 387 | === YAML_LOAD_WARN_BAD_GLOB_ELEM 388 | +++ error: YAML_LOAD_WARN_BAD_GLOB_ELEM 389 | +++ yaml 390 | --- 391 | - !perl/glob: 392 | NAME: foo 393 | bar: SHAME 394 | 395 | === YAML_PARSE_ERR_ZERO_INDENT 396 | +++ error: YAML_PARSE_ERR_ZERO_INDENT 397 | +++ yaml 398 | --- 399 | - |0 400 | foo 401 | 402 | === YAML_PARSE_ERR_NONSPACE_INDENTATION 403 | +++ error: YAML_PARSE_ERR_NONSPACE_INDENTATION 404 | +++ yaml 405 | --- 406 | some: 407 | data-preceded-with-tab: abc 408 | === YAML_PARSE_ERR_INCONSISTENT_INDENTATION 409 | +++ error: YAML_PARSE_ERR_INCONSISTENT_INDENTATION 410 | +++ yaml 411 | --- 412 | a: 413 | b: 414 | - 1 415 | - 2 416 | 417 | -------------------------------------------------------------------------------- /test/export.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use lib 'inc'; 4 | use Test::YAML(); 5 | BEGIN { 6 | @Test::YAML::EXPORT = 7 | grep { not /^(Dump|Load)(File)?$/ } @Test::YAML::EXPORT; 8 | } 9 | use TestYAML tests => 3; 10 | 11 | use YAML; 12 | 13 | ok defined(&Dump), 14 | 'Dump() is exported'; 15 | ok defined(&Load), 16 | 'Load() is exported'; 17 | ok not(defined &Store), 18 | 'Store() is not exported'; 19 | -------------------------------------------------------------------------------- /test/extra/meta.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Test that our META.yml file matches the current specification. 4 | 5 | use strict; 6 | BEGIN { 7 | $| = 1; 8 | $^W = 1; 9 | } 10 | 11 | my $MODULE = 'Test::CPAN::Meta 0.17'; 12 | 13 | # Don't run tests for installs 14 | use Test::More; 15 | unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { 16 | plan( skip_all => "Author tests not required for installation" ); 17 | } 18 | 19 | # Load the testing module 20 | eval "use $MODULE"; 21 | if ( $@ ) { 22 | $ENV{RELEASE_TESTING} 23 | ? die( "Failed to load required release-testing module $MODULE" ) 24 | : plan( skip_all => "$MODULE not available for testing" ); 25 | } 26 | 27 | meta_yaml_ok(); 28 | -------------------------------------------------------------------------------- /test/extra/pmv.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Test that our declared minimum Perl version matches our syntax 4 | 5 | use strict; 6 | BEGIN { 7 | $| = 1; 8 | $^W = 1; 9 | } 10 | 11 | my @MODULES = ( 12 | 'Perl::MinimumVersion 1.25', 13 | 'Test::MinimumVersion 0.101080', 14 | ); 15 | 16 | # Don't run tests for installs 17 | use Test::More; 18 | unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { 19 | plan( skip_all => "Author tests not required for installation" ); 20 | } 21 | 22 | # Load the testing modules 23 | foreach my $MODULE ( @MODULES ) { 24 | eval "use $MODULE"; 25 | if ( $@ ) { 26 | $ENV{RELEASE_TESTING} 27 | ? die( "Failed to load required release-testing module $MODULE" ) 28 | : plan( skip_all => "$MODULE not available for testing" ); 29 | } 30 | } 31 | 32 | all_minimum_version_from_metayml_ok(); 33 | -------------------------------------------------------------------------------- /test/extra/pod.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Test that the syntax of our POD documentation is valid 4 | 5 | use strict; 6 | BEGIN { 7 | $| = 1; 8 | $^W = 1; 9 | } 10 | 11 | my @MODULES = ( 12 | 'Pod::Simple 3.14', 13 | 'Test::Pod 1.44', 14 | ); 15 | 16 | # Don't run tests for installs 17 | use Test::More; 18 | unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { 19 | plan( skip_all => "Author tests not required for installation" ); 20 | } 21 | 22 | # Load the testing modules 23 | foreach my $MODULE ( @MODULES ) { 24 | eval "use $MODULE"; 25 | if ( $@ ) { 26 | $ENV{RELEASE_TESTING} 27 | ? die( "Failed to load required release-testing module $MODULE" ) 28 | : plan( skip_all => "$MODULE not available for testing" ); 29 | } 30 | } 31 | 32 | all_pod_files_ok(); 33 | -------------------------------------------------------------------------------- /test/freeze-thaw.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use lib 'inc'; 4 | use Test::YAML(); 5 | BEGIN { 6 | @Test::YAML::EXPORT = 7 | grep { not /^(Dump|Load)(File)?$/ } @Test::YAML::EXPORT; 8 | } 9 | use TestYAML tests => 9; 10 | 11 | use YAML qw(Dump Load freeze thaw); 12 | 13 | my $hash = { foo => 42, bar => 44 }; 14 | 15 | my $ice = freeze($hash); 16 | 17 | ok defined(&Dump), 'Dump exported'; 18 | ok defined(&Load), 'Load exported'; 19 | ok defined(&freeze), 'freeze exported'; 20 | ok defined(&thaw), 'thaw exported'; 21 | 22 | like $ice, qr{bar.*foo}s, 'freeze works'; 23 | 24 | is $ice, Dump($hash), 'freeze produces same thing as Dump'; 25 | 26 | my $melt = thaw($ice); 27 | 28 | is_deeply $melt, Load($ice), 'thaw produces same thing as Load'; 29 | 30 | is_deeply $melt, $hash, 'freeze/thaw makes a clone'; 31 | 32 | is ref($melt), 'HASH', 'Melted object really is a hash'; 33 | -------------------------------------------------------------------------------- /test/global-api.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use lib 'inc'; 4 | use Test::YAML(); 5 | BEGIN { 6 | @Test::YAML::EXPORT = 7 | grep { not /^(Dump|Load)(File)?$/ } @Test::YAML::EXPORT; 8 | } 9 | use TestYAML tests => 4; 10 | use YAML; 11 | 12 | { 13 | no warnings qw'once redefine'; 14 | require YAML::Dumper; 15 | 16 | local *YAML::Dumper::dump = 17 | sub { return 'got to dumper' }; 18 | 19 | require YAML::Loader; 20 | local *YAML::Loader::load = 21 | sub { return 'got to loader' }; 22 | 23 | is Dump(\%ENV), 'got to dumper', 24 | 'Dump got to the business end'; 25 | is Load(\%ENV), 'got to loader', 26 | 'Load got to the business end'; 27 | 28 | is Dump(\%ENV), 'got to dumper', 29 | 'YAML::Dump got to the business end'; 30 | is Load(\%ENV), 'got to loader', 31 | 'YAML::Load got to the business end'; 32 | } 33 | -------------------------------------------------------------------------------- /test/inbox.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 3; 4 | 5 | SKIP: { 6 | skip 'fix this next release', 3; 7 | my $x; 8 | is(Dump(bless(\$x)), 'foo'); 9 | } 10 | 11 | __END__ 12 | 03:14 < audreyt> ingy: 13 | 03:14 < audreyt> use YAML; my $x; print Dump bless(\$x); 14 | 03:14 < audreyt> is erroneous 15 | 03:14 < audreyt> then 16 | 03:14 < audreyt> use YAML; my $x = \3; print Dump bless(\$x); 17 | 03:14 < audreyt> is fatal error 18 | 03:15 < audreyt> use YAML; my $x; $x = \$x; print Dump bless(\$x); 19 | 03:15 < audreyt> is scary fatal error 20 | 03:15 < audreyt> (YAML::Syck handles all three ^^;) 21 | 03:16 * audreyt goes back to do $job work 22 | 23 | -------------------------------------------------------------------------------- /test/io-handle.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | my $t = -e 't' ? 't' : 'test'; 4 | 5 | use utf8; 6 | use lib 'inc'; 7 | use Test::YAML(); 8 | BEGIN { 9 | @Test::YAML::EXPORT = 10 | grep { not /^(Dump|Load)(File)?$/ } @Test::YAML::EXPORT; 11 | } 12 | use IO::Pipe; 13 | use IO::File; 14 | use TestYAML tests => 6; 15 | use YAML qw/DumpFile LoadFile/;; 16 | 17 | my $testdata = 'El país es medible. La patria es del tamaño del corazón de quien la quiere.'; 18 | 19 | 20 | # IO::Pipe 21 | 22 | my $pipe = new IO::Pipe; 23 | 24 | if ( fork() ) { # parent reads from IO::Pipe handle 25 | $pipe->reader(); 26 | my $recv_data = LoadFile($pipe); 27 | is length($recv_data), length($testdata), 'LoadFile from IO::Pipe read data'; 28 | is $recv_data, $testdata, 'LoadFile from IO::Pipe contents is correct'; 29 | } else { # child writes to IO::Pipe handle 30 | $pipe->writer(); 31 | DumpFile($pipe, $testdata); 32 | exit 0; 33 | } 34 | 35 | # IO::File 36 | 37 | my $file = "$t/dump-io-file-$$.yaml"; 38 | my $fh = new IO::File; 39 | 40 | # write to IO::File handle 41 | $fh->open($file, '>:utf8') or die $!; 42 | DumpFile($fh, $testdata); 43 | $fh->close; 44 | ok -e $file, 'IO::File output file exists'; 45 | 46 | # read from IO::File handle 47 | $fh->open($file, '<:utf8') or die $!; 48 | my $yaml = do { local $/; <$fh> }; 49 | is $yaml, "--- $testdata\n", 'LoadFile from IO::File contents is correct'; 50 | 51 | $fh->seek(0, 0); 52 | my $read_data = LoadFile($fh) or die $!; 53 | $fh->close; 54 | 55 | is length($read_data), length($testdata), 'LoadFile from IO::File read data'; 56 | is $read_data, $testdata, 'LoadFile from IO::File read data'; 57 | 58 | unlink $file; 59 | -------------------------------------------------------------------------------- /test/issue-149.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | use YAML; 3 | 4 | YAML::Load("a: b"); 5 | YAML::Load("a:\n b: c"); 6 | YAML::Load("a: b\nc: d"); 7 | 8 | pass "YAML w/o final newlines loads"; 9 | 10 | done_testing; 11 | -------------------------------------------------------------------------------- /test/issue-69.t: -------------------------------------------------------------------------------- 1 | use Test::More tests => 2; 2 | use YAML; 3 | 4 | my $seq = eval { YAML::Load("foo: [bar] "); 1 }; 5 | my $map = eval { YAML::Load("foo: {bar: 42} "); 1 }; 6 | 7 | ok($seq, "YAML inline sequence with trailing space loads"); 8 | ok($map, "YAML inline mapping with trailing space loads"); 9 | 10 | done_testing; 11 | -------------------------------------------------------------------------------- /test/load-code.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 4; 4 | 5 | run_roundtrip_nyn('dumper'); 6 | 7 | __DATA__ 8 | 9 | === Actually test LoadCode functionality, block 10 | +++ perl: $YAML::UseCode = 1; package main; no strict; sub { "really long test string that's longer than 30" } 11 | +++ yaml 12 | --- !!perl/code | 13 | { 14 | use warnings; 15 | q[really long test string that's longer than 30]; 16 | } 17 | 18 | === Actually test LoadCode functionality, line 19 | +++ perl: $YAML::UseCode = 1; package main; no strict; sub { 42 } 20 | +++ yaml 21 | --- !!perl/code "{\n use warnings;\n 42;\n}\n" 22 | -------------------------------------------------------------------------------- /test/load-fails.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | # This simply tests that a given piece of invalid YAML fails to parse 4 | use TestYAML tests => 4; 5 | 6 | filters { 7 | msg => 'regexp', 8 | yaml => 'yaml_load_or_fail', 9 | }; 10 | 11 | run_like yaml => 'msg'; 12 | 13 | __DATA__ 14 | 15 | === 16 | +++ SKIP 17 | This test hangs YAML.pm 18 | +++ msg 19 | YAML Error: Inconsistent indentation level 20 | +++ yaml 21 | a: * 22 | 23 | 24 | === 25 | +++ msg 26 | YAML Error: Inconsistent indentation level 27 | +++ yaml 28 | --- |\ 29 | foo\zbar 30 | 31 | 32 | === 33 | +++ msg 34 | YAML Error: Unrecognized implicit value 35 | +++ yaml 36 | --- @ 42 37 | 38 | 39 | === 40 | +++ msg 41 | YAML Error: Inconsistent indentation level 42 | +++ yaml 43 | --- 44 | - 1 45 | -2 46 | 47 | 48 | === 49 | +++ msg 50 | Unrecognized TAB policy 51 | +++ yaml 52 | --- #TAB:MOBY 53 | - foo 54 | 55 | -------------------------------------------------------------------------------- /test/load-passes.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 8; 4 | 5 | run_load_passes(); 6 | 7 | __DATA__ 8 | 9 | === Bug reported by Rich Morin 10 | +++ SKIP 11 | +++ yaml 12 | foo: 13 | - > 14 | This is a test. 15 | 16 | === Bug reported by audreyt 17 | +++ SKIP 18 | +++ yaml 19 | --- "\n\ 20 | \r" 21 | 22 | === 23 | +++ yaml 24 | --- 25 | foo: 26 | bar: 27 | baz: 28 | poo: bah 29 | 30 | 31 | === 32 | +++ yaml 33 | --- 42 34 | 35 | 36 | === 37 | +++ yaml 38 | # comment 39 | --- 42 40 | # comment 41 | 42 | 43 | === 44 | +++ yaml 45 | --- [1, 2, 3] 46 | 47 | 48 | === 49 | +++ yaml 50 | --- {foo: bar, bar: 42} 51 | 52 | 53 | === 54 | +++ yaml 55 | --- !foo.com/bar 56 | - 2 57 | 58 | 59 | === 60 | +++ yaml 61 | --- &1 !foo.com/bar 62 | - 42 63 | 64 | 65 | === 66 | +++ yaml 67 | --- 68 | - 40 69 | - 41 70 | - foof 71 | -------------------------------------------------------------------------------- /test/load-slides.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | # This tests the slides I used for YAPC 2002 4 | use TestYAML tests => 28; 5 | 6 | run_load_passes(); 7 | 8 | __DATA__ 9 | === 10 | +++ yaml 11 | YAML design goals: 12 | - YAML documents are very readable by humans. 13 | - YAML interacts well with scripting languages. 14 | - YAML uses host languages native data structures. 15 | - YAML has a consistent information model. 16 | - YAML enables stream-based processing. 17 | - YAML is expressive and extensible. 18 | - YAML is easy to implement. 19 | 20 | === 21 | +++ yaml 22 | --- 23 | scripting languages: 24 | - Perl 25 | - Python 26 | - C 27 | - Java 28 | standards: 29 | - RFC0822 (MAIL) 30 | - RFC1866 (HTML) 31 | - RFC2045 (MIME) 32 | - RFC2396 (URI) 33 | others: 34 | - SOAP 35 | - XML 36 | - SAX 37 | 38 | === 39 | +++ yaml 40 | --- 41 | name: Benjamin 42 | rank: Private 43 | serial number: 1234567890 44 | 12:34 PM: My favorite time 45 | 46 | === 47 | +++ yaml 48 | --- 49 | - red 50 | - white 51 | - blue 52 | - pinko 53 | 54 | === 55 | +++ yaml 56 | --- 57 | Fruits: 58 | - Apples 59 | - Tomatoes 60 | Veggies: 61 | - Spinach 62 | - Broccoli 63 | Meats: 64 | - Burgers 65 | - Shrimp 66 | Household: 67 | - Candles 68 | - Incense 69 | - Toilet Duck 70 | 71 | === 72 | +++ yaml 73 | --- 74 | - 75 | - 3 76 | - 5 77 | - 7 78 | - 79 | - 0 80 | - 0 81 | - 7 82 | - 83 | - 9 84 | - 1 85 | - 1 86 | 87 | === 88 | +++ yaml 89 | - Intro 90 | - 91 | Part 1: 92 | - Up 93 | - Down 94 | - Side to Side 95 | - Part 2: 96 | - Here 97 | - There 98 | - Underwear 99 | - Part 3: 100 | - The Good 101 | - The Bad 102 | - The Ingy 103 | 104 | === 105 | +++ yaml 106 | ## comment before document 107 | #--- #DIRECTIVE # comment 108 | #foo: bar # inline comment 109 | # 110 | #phone: number #555-1234 111 | # ### Comment 112 | #fact: fiction 113 | #--- 114 | #blue: bird 115 | ## Comment 116 | 117 | === 118 | +++ yaml 119 | --- 120 | simple: look ma, no quotes 121 | quoted: 122 | - 'Single quoted. Like Perl, no escapes' 123 | - "Double quotes.\nLike Perl, has escapes" 124 | - | 125 | A YAML block scalar. 126 | Much like Perl's 127 | here-document. 128 | 129 | === 130 | +++ yaml 131 | #--- 132 | #simple key: simple value 133 | #this value: can span multiple lines 134 | # but the key cannot. it would need quotes 135 | #stuff: 136 | # - foo 137 | # - 42 138 | # - 3.14 139 | # - 192.168.2.98 140 | # - m/^(.*)\// 141 | 142 | === 143 | +++ yaml 144 | #--- 145 | #'contains: colon': '$19.99' 146 | #or: ' value has leading/trailing whitespace ' 147 | #'key spans 148 | #lines': 'double ticks \ for ''escaping''' 149 | 150 | === 151 | +++ yaml 152 | #--- 153 | #The spec says: "The double quoted style variant adds escaping to the 'single quoted' style variant." 154 | # 155 | #like this: "null->\z newline->\n bell->\a 156 | #smiley->\u263a" 157 | # 158 | #self escape: "Brian \"Ingy\" Ingerson" 159 | 160 | === 161 | +++ yaml 162 | --- 163 | what is this: | 164 | is it: a YAML mapping 165 | or just: a string 166 | 167 | chomp me: |- 168 | sub foo { 169 | print "Love me do!"; 170 | } 171 | 172 | === 173 | +++ yaml 174 | --- #YAML:1.0 175 | old doc: | 176 | --- #YAML:1.0 177 | tools: 178 | - XML 179 | - XSLT 180 | new doc: | 181 | --- #YAML:1.0 182 | tools: 183 | - YAML 184 | - cYATL 185 | 186 | === 187 | +++ yaml 188 | --- 189 | - > 190 | Copyright © 2001 Brian Ingerson, Clark 191 | Evans & Oren Ben-Kiki, all rights 192 | reserved. This document may be freely 193 | copied provided that it is not modified. 194 | 195 | Next paragraph. 196 | 197 | - foo 198 | 199 | === 200 | +++ yaml 201 | --- 202 | The YAML Specification starts out by saying: > 203 | YAML(tm) (rhymes with "camel") is a straightforward 204 | machine parsable data serialization format designed 205 | for human readability and interaction with 206 | scripting languages such as Perl and Python. 207 | 208 | YAML documents are very readable by humans. 209 | YAML interacts well with scripting languages. 210 | YAML uses host languages' native data structures. 211 | 212 | Please join us, the mailing list is at SourceForge. 213 | 214 | === 215 | +++ yaml 216 | --- 217 | ? >+ 218 | Even a key can: 219 | 1) Be Folded 220 | 2) Have Wiki 221 | 222 | : cool, eh? 223 | 224 | === 225 | +++ yaml 226 | --- 227 | Hey Jude: &chorus 228 | - na, na, na, 229 | - &4 na, na, na, na, 230 | - *4 231 | - Hey Jude. 232 | - *chorus 233 | 234 | === 235 | +++ yaml 236 | headerless: first document 237 | --- #YAML:1.0 #TAB:NONE 238 | --- > 239 | folded top level scalar 240 | --- &1 241 | recurse: *1 242 | --- 243 | - simple header 244 | 245 | === 246 | +++ yaml 247 | #--- 248 | #seq: [ 14, 34, 55 ] 249 | #map: {purple: rain, blue: skies} 250 | #mixed: {sizes: [9, 11], shapes: [round]} 251 | #span: {players: [who, what, I don't know], 252 | # positions: [first, second, third]} 253 | 254 | === 255 | +++ yaml 256 | ## Inline sequences make data more compact 257 | #--- 258 | #- [3, 5, 7] 259 | #- [0, 0, 7] 260 | #- [9, 1, 1] 261 | # 262 | ## Above is equal to below 263 | #--- [[3, 5, 7], [0, 0, 7], [9, 1, 1]] 264 | # 265 | ## A 3D Matrix 266 | #--- 267 | #- [[3, 5, 7], [0, 0, 7], [9, 1, 1]] 268 | #- [[0, 0, 7], [9, 1, 1], [3, 5, 7]] 269 | #- [[9, 1, 1], [3, 5, 7], [0, 0, 7]] 270 | 271 | === 272 | +++ yaml 273 | --- 274 | ? 275 | - Kane 276 | - Kudra 277 | : engaged 278 | [Damian, Dominus]: engaging 279 | 280 | === 281 | +++ yaml 282 | #same: 283 | # - 42 284 | # - !int 42 285 | # - !yaml.org/int 42 286 | # - !http://yaml.org/int 42 287 | #perl: 288 | # - !perl/Foo::Bar {} 289 | # - !perl.yaml.org/Foo::Bar {} 290 | # - !http://perl.yaml.org/Foo::Bar {} 291 | 292 | === 293 | +++ yaml 294 | #--- 295 | #- 42 # integer 296 | #- -3.14 # floating point 297 | #- 6.02e+23 # scientific notation 298 | #- 0xCAFEBABE # hexadecimal int 299 | #- 2001-09-11 # ISO8601 time 300 | #- '2001-09-11' # string 301 | #- + # boolean true 302 | #- (false) # alternate boolean 303 | #- ~ # null (undef in Perl) 304 | #- 123 Main St # string 305 | 306 | === 307 | +++ yaml 308 | #--- 309 | #- !str YAML, YAML, YAML! 310 | #- !int 42 311 | #- !float 0.707 312 | #- !time 2001-12-14T21:59:43.10-05:00 313 | #- !bool 1 314 | #- !null 0 315 | #- !binary MWYNG84BwwEeECcgggoBADs= 316 | 317 | === 318 | +++ yaml 319 | #--- 320 | #- !perl/Foo::Bar {} # hash-based class 321 | #- !perl/@Foo::Bar [] # array-based class 322 | #- !perl/$Foo::Bar '' # scalar-based class 323 | #- !perl/glob: # typeglob 324 | #- !perl/code: # code reference 325 | #- !perl/ref: # hard reference 326 | #- !perl/regexp: # regular expression 327 | #- !perl/regexp:Foo::Bar # blessed regexp 328 | 329 | === 330 | +++ yaml 331 | --- #YAML:1.0 332 | NAME: AddressEntry 333 | HASH: 334 | - NAME: Name 335 | HASH: 336 | - NAME: First 337 | - NAME: Last 338 | OPTIONAL: yes 339 | - NAME: EmailAddresses 340 | ARRAY: yes 341 | - NAME: Phone 342 | ARRAY: yes 343 | HASH: 344 | - NAME: Type 345 | OPTIONAL: yes 346 | - NAME: Number 347 | 348 | === 349 | +++ yaml 350 | --- #YAML:1.0 351 | AddressEntry: 352 | Name: 353 | First: Brian 354 | EmailAddresses: 355 | - ingy@CPAN.org 356 | - ingy@ttul.org 357 | Phone: 358 | - Type: Work 359 | Number: 604-333-4567 360 | - Number: 843-444-5678 361 | -------------------------------------------------------------------------------- /test/load-spec.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 52; 4 | 5 | run_load_passes(); 6 | 7 | __DATA__ 8 | === 9 | +++ yaml 10 | - Mark McGwire 11 | - Sammy Sosa 12 | - Ken Griffey 13 | 14 | === 15 | +++ yaml 16 | hr: 65 17 | avg: 0.278 18 | rbi: 147 19 | 20 | === 21 | +++ yaml 22 | american: 23 | - Boston Red Sox 24 | - Detroit Tigers 25 | - New York Yankees 26 | - Texas Rangers 27 | national: 28 | - New York Mets 29 | - Chicago Cubs 30 | - Atlanta Braves 31 | - Montreal Expos 32 | 33 | === 34 | +++ yaml 35 | - 36 | name: Mark McGwire 37 | hr: 65 38 | avg: 0.278 39 | rbi: 147 40 | - 41 | name: Sammy Sosa 42 | hr: 63 43 | avg: 0.288 44 | rbi: 141 45 | 46 | === 47 | +++ yaml 48 | ? 49 | - New York Yankees 50 | - Atlanta Braves 51 | : 52 | - 2001-07-02 53 | - 2001-08-12 54 | - 2001-08-14 55 | ? 56 | - Detroit Tigers 57 | - Chicago Cubs 58 | : 59 | - 2001-07-23 60 | 61 | === 62 | +++ yaml 63 | invoice: 34843 64 | date : 2001-01-23 65 | bill-to: 66 | given : Chris 67 | family : Dumars 68 | product: 69 | - quantity: 4 70 | desc : Basketball 71 | - quantity: 1 72 | desc : Super Hoop 73 | 74 | === 75 | +++ yaml 76 | --- 77 | name: Mark McGwire 78 | hr: 65 79 | avg: 0.278 80 | rbi: 147 81 | --- 82 | name: Sammy Sosa 83 | hr: 63 84 | avg: 0.288 85 | rbi: 141 86 | 87 | === 88 | +++ yaml 89 | # Ranking of players by 90 | # season home runs. 91 | --- 92 | - Mark McGwire 93 | - Sammy Sosa 94 | - Ken Griffey 95 | 96 | === 97 | +++ yaml 98 | #hr: # Home runs 99 | # # 1998 record 100 | # - Mark McGwire 101 | # - Sammy Sosa 102 | #rbi: # Runs batted in 103 | # - Sammy Sosa 104 | # - Ken Griffey 105 | 106 | === 107 | +++ yaml 108 | hr: 109 | - Mark McGwire 110 | # Name "Sammy Sosa" scalar SS 111 | - &SS Sammy Sosa 112 | rbi: 113 | # So it can be referenced later. 114 | - *SS 115 | - Ken Griffey 116 | 117 | === 118 | +++ yaml 119 | --- > 120 | Mark McGwire's 121 | year was crippled 122 | by a knee injury. 123 | 124 | === 125 | +++ yaml 126 | --- | 127 | \/|\/| 128 | / | |_ 129 | 130 | === 131 | +++ yaml 132 | --- >- 133 | Sosa completed 134 | another fine 135 | season. 136 | 137 | === 138 | +++ yaml 139 | #name: Mark McGwire 140 | #occupation: baseball player 141 | #comments: Mark set a major 142 | # league home run 143 | # record in 1998. 144 | 145 | === 146 | +++ yaml 147 | years: "1998\t1999\t2000\n" 148 | msg: "Sosa did fine. \u263A" 149 | 150 | === 151 | +++ yaml 152 | - ' \/|\/| ' 153 | - ' / | |_ ' 154 | 155 | === 156 | +++ yaml 157 | - [ name , hr , avg ] 158 | - [ Mark McGwire , 65 , 0.278 ] 159 | - [ Sammy Sosa , 63 , 0.288 ] 160 | 161 | === 162 | +++ yaml 163 | #Mark McGwire: {hr: 65, avg: 0.278} 164 | #Sammy Sosa: {hr: 63, 165 | # avg: 0.288} 166 | 167 | === 168 | +++ yaml 169 | invoice: 34843 170 | date : 2001-01-23 171 | buyer: 172 | given : Chris 173 | family : Dumars 174 | product: 175 | - Basketball: 4 176 | - Superhoop: 1 177 | 178 | === 179 | +++ yaml 180 | #invoice: !int|dec 34843 181 | #date : !time 2001-01-23 182 | #buyer: !map 183 | # given : !str Chris 184 | # family : !str Dumars 185 | #product: !seq 186 | # - !str Basketball: !int 4 187 | # - !str Superhoop: !int 1 188 | 189 | === 190 | +++ yaml 191 | #invoice: !str 34843 192 | #date : !str 2001-01-23 193 | 194 | === 195 | +++ yaml 196 | #--- !clarkevans.com/schedule/^entry 197 | #who: Clark C. Evans 198 | #when: 2001-11-18 199 | #hours: !^hours 3 200 | #description: > 201 | # Wrote up these examples 202 | # and learned a lot about 203 | # baseball statistics. 204 | 205 | === 206 | +++ yaml 207 | #--- !clarkevans.com/graph/^shape 208 | #- !^circle 209 | # center: &ORIGIN {x: 73, y: 129} 210 | # radius: 7 211 | #- !^line [23, 32, 300, 200] 212 | #- !^text 213 | # center: *ORIGIN 214 | # color: 0x02FDBA 215 | 216 | === 217 | +++ yaml 218 | --- !clarkevans.com/^invoice 219 | invoice: 34843 220 | date : 2001-01-23 221 | bill-to: &id001 222 | given : Chris 223 | family : Dumars 224 | address: 225 | lines: | 226 | 458 Walkman Dr. 227 | Suite #292 228 | city : Royal Oak 229 | state : MI 230 | postal : 48046 231 | ship-to: *id001 232 | product: 233 | - sku : BL394D 234 | quantity : 4 235 | description : Basketball 236 | price : 450.00 237 | - sku : BL4438H 238 | quantity : 1 239 | description : Super Hoop 240 | price : 2392.00 241 | tax : 251.42 242 | total: 4443.52 243 | comments: > 244 | Late afternoon is best. 245 | Backup contact is Nancy 246 | Billsmer @ 338-4338. 247 | 248 | === 249 | +++ yaml 250 | --- 251 | Date: 2001-11-23 252 | Time: 15:01:42 253 | User: ed 254 | Warning: > 255 | This is an error message 256 | for the log file 257 | --- 258 | Date: 2001-11-23 259 | Time: 15:02:31 260 | User: ed 261 | Warning: > 262 | A slightly different error 263 | message. 264 | --- 265 | Date: 2001-11-23 266 | Time: 15:03:17 267 | User: ed 268 | Fatal: > 269 | Unknown variable "bar" 270 | Stack: 271 | - file: TopClass.py 272 | line: 23 273 | code: | 274 | x = MoreObject("345\n") 275 | - file: MoreClass.py 276 | line: 58 277 | code: | 278 | foo = bar 279 | 280 | === 281 | +++ yaml 282 | ################################### 283 | ## These are four throwaway comment 284 | # 285 | ## lines (the second line is empty). 286 | #this: | # Comments may trail lines. 287 | # contains three lines of text. 288 | # The third one starts with a 289 | # # character. This isn't a comment. 290 | # 291 | ## These are four throwaway comment 292 | ## lines (the first line is empty). 293 | ################################### 294 | 295 | === 296 | +++ yaml 297 | --- > 298 | This YAML stream contains a single text value. 299 | The next stream is a log file - a sequence of 300 | log entries. Adding an entry to the log is a 301 | simple matter of appending it at the end. 302 | 303 | === 304 | +++ yaml 305 | --- 306 | at: 2001-08-12T09:25:00.00 307 | type: GET 308 | HTTP: '1.0' 309 | url: '/index.html' 310 | --- 311 | at: 2001-08-12T09:25:10.00 312 | type: GET 313 | HTTP: '1.0' 314 | url: '/toc.html' 315 | 316 | === 317 | +++ yaml 318 | ## The following is a sequence of three documents. 319 | ## The first contains an empty mapping, the second 320 | ## an empty sequence, and the last an empty string. 321 | #--- {} 322 | #--- [ ] 323 | #--- '' 324 | 325 | === 326 | +++ yaml 327 | ## All entries in the sequence 328 | ## have the same type and value. 329 | #- 10.0 330 | #- !float 10 331 | #- !yaml.org/^float '10' 332 | #- !http://yaml.org/float "\ 333 | # 1\ 334 | # 0" 335 | 336 | === 337 | +++ yaml 338 | ## Private types are per-document. 339 | #--- 340 | #pool: !!ball 341 | # number: 8 342 | # color: black 343 | #--- 344 | #bearing: !!ball 345 | # material: steel 346 | 347 | === 348 | +++ yaml 349 | ## 'http://domain.tld/invoice' is some type family. 350 | #invoice: !domain.tld/^invoice 351 | # # 'seq' is shorthand for 'http://yaml.org/seq'. 352 | # # This does not effect '^customer' below 353 | # # because it is does not specify a prefix. 354 | # customers: !seq 355 | # # '^customer' is shorthand for the full 356 | # # notation 'http://domain.tld/customer'. 357 | # - !^customer 358 | # given : Chris 359 | # family : Dumars 360 | 361 | === 362 | +++ yaml 363 | ## It is possible to use XML namespace URIs as 364 | ## YAML namespaces. Using the ancestor's URI 365 | ## allows specifying it only once. The $ separates 366 | ## between the XML namespace URI and the tag name. 367 | #doc: !http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd$^html 368 | # - !^body 369 | # - !^p This is an HTML paragraph. 370 | 371 | === 372 | +++ yaml 373 | anchor : &A001 This scalar has an anchor. 374 | override : &A001 > 375 | The alias node below is a 376 | repeated use of this value. 377 | alias : *A001 378 | 379 | === 380 | +++ yaml 381 | #empty: [] 382 | #in-line: [ one, two, three # May span lines, 383 | # , four, # indentation is 384 | # five ] # mostly ignored. 385 | #nested: 386 | # - First item in top sequence 387 | # - 388 | # - Subordinate sequence entry 389 | # - > 390 | # A multi-line 391 | # sequence entry 392 | # - Sixth item in top sequence 393 | 394 | === 395 | +++ yaml 396 | #empty: {} 397 | #in-line: { one: 1, two: 2 } 398 | #spanning: { one: 1, 399 | # two: 2 } 400 | #nested: 401 | # first : First entry 402 | # second: 403 | # key: Subordinate mapping 404 | # third: 405 | # - Subordinate sequence 406 | # - { } 407 | # - Previous mapping is empty. 408 | # - A key: value pair in a sequence. 409 | # A second: key:value pair. 410 | # - The previous entry is equal to the following one. 411 | # - 412 | # A key: value pair in a sequence. 413 | # A second: key:value pair. 414 | # !float 12 : This key is a float. 415 | # ? > 416 | # ? 417 | # : This key had to be protected. 418 | # "\a" : This key had to be escaped. 419 | # ? > 420 | # This is a 421 | # multi-line 422 | # folded key 423 | # : Whose value is 424 | # also multi-line. 425 | # ? 426 | # - This key 427 | # - is a sequence 428 | # : 429 | # - With a sequence value. 430 | # ? 431 | # This: key 432 | # is a: mapping 433 | # : 434 | # with a: mapping value. 435 | 436 | === 437 | +++ yaml 438 | empty: | 439 | detected: | 440 | The \ ' " characters may be 441 | freely used. Leading white 442 | space is significant. 443 | 444 | All line breaks are significant, 445 | including the final one. Thus 446 | this value contains one empty 447 | line and ends with a line break, 448 | but does not start with one. 449 | 450 | # Comments may follow a nested 451 | # scalar value. They must be 452 | # less indented. 453 | 454 | # Explicit indentation must 455 | # be given in all the three 456 | # following cases. 457 | leading spaces: |2 458 | This value starts with four 459 | spaces. It ends with one line 460 | break and an empty comment line. 461 | 462 | leading line break: |2 463 | 464 | This value starts with 465 | a line break and ends 466 | with one. 467 | leading comment indicator: |2 468 | # first line starts with a 469 | #. This value does not start 470 | with a line break but ends 471 | with one. 472 | # Explicit indentation may 473 | # also be given when it is 474 | # not required. 475 | redundant: |2 476 | This value is indented 2 spaces. 477 | stripped: |- 478 | This contains no newline. 479 | 480 | kept: |+ 481 | This contains two newlines. 482 | 483 | # Comments may follow. 484 | 485 | === 486 | +++ yaml 487 | #empty: > 488 | #detected: > 489 | # Line feeds are converted 490 | # to spaces, so this value 491 | # contains no line breaks 492 | # except for the final one. 493 | # 494 | #explicit: >2 495 | # 496 | # An empty line, either 497 | # at the start or in 498 | # the value: 499 | # 500 | # Is interpreted as a 501 | # line break. Thus this 502 | # value contains three 503 | # line breaks. 504 | # 505 | #stripped: >-1 506 | # This starts with a space 507 | # and contains no newline. 508 | # 509 | #kept: >1+ 510 | # This starts with a space 511 | # and contains two newlines. 512 | # 513 | #indented: > 514 | # This is a folded 515 | # paragraph followed 516 | # by a list: 517 | # * first entry 518 | # * second entry 519 | # Followed by another 520 | # folded paragraph, 521 | # another list: 522 | # 523 | # * first entry 524 | # 525 | # * second entry 526 | # 527 | # And a final folded 528 | # paragraph. 529 | #block: | # Equal to above. 530 | # This is a folded paragraph followed by a list: 531 | # * first entry 532 | # * second entry 533 | # Followed by another folded paragraph and list: 534 | # 535 | # * first entry 536 | # 537 | # * second entry 538 | # 539 | # And a final folded paragraph. 540 | # 541 | ## Explicit comments may follow 542 | ## but must be less indented. 543 | 544 | === 545 | +++ yaml 546 | #empty: '' 547 | #second: '! : \ etc. can be used freely.' 548 | #third: 'a single quote '' must be escaped.' 549 | #span: 'this contains 550 | # six spaces 551 | # 552 | # and one 553 | # line break' 554 | 555 | === 556 | +++ yaml 557 | #empty: "" 558 | #second: "! : etc. can be used freely." 559 | #third: "a \" or a \\ must be escaped." 560 | #fourth: "this value ends with an LF.\n" 561 | #span: "this contains 562 | # four \ 563 | # spaces" 564 | 565 | === 566 | +++ yaml 567 | #first: There is no unquoted empty string. 568 | #second: 12 ## This is an integer. 569 | #third: !str 12 ## This is a string. 570 | #span: this contains 571 | # six spaces 572 | # 573 | # and one 574 | # line break 575 | #indicators: this has no comments. 576 | # #foo and bar# are 577 | # all text. 578 | #in-line: [ can span 579 | # lines, # comment 580 | # like 581 | # this ] 582 | #note: { one-line keys: but 583 | # multi-line values } 584 | 585 | === 586 | +++ yaml 587 | ## The following are equal seqs 588 | ## with different identities. 589 | #in-line: [ one, two ] 590 | #spanning: [ one, 591 | # two: ] 592 | #nested: 593 | # - one 594 | # - two 595 | 596 | === 597 | +++ yaml 598 | # The following are equal maps 599 | # with different identities. 600 | in-line: { one: 1, two: 2 } 601 | nested: 602 | one: 1 603 | two: 2 604 | 605 | === 606 | +++ yaml 607 | #- 12 # An integer 608 | ## The following scalars 609 | ## are loaded to the 610 | ## string value '1' '2'. 611 | #- !str 12 612 | #- '12' 613 | #- "12" 614 | #- "\ 615 | # 1\ 616 | # 2\ 617 | # " 618 | 619 | === 620 | +++ yaml 621 | #canonical: ~ 622 | #verbose: (null) 623 | #sparse: 624 | # - ~ 625 | # - Second entry. 626 | # - (nil) 627 | # - This sequence has 4 entries, two with values. 628 | #three: > 629 | # This mapping has three keys, 630 | # only two with values. 631 | 632 | === 633 | +++ yaml 634 | #canonical: - 635 | #logical: (true) 636 | #informal: (no) 637 | 638 | === 639 | +++ yaml 640 | #canonical: 12345 641 | #decimal: +12,345 642 | #octal: 014 643 | #hexadecimal: 0xC 644 | 645 | === 646 | +++ yaml 647 | #canonical: 1.23015e+3 648 | #exponential: 12.3015e+02 649 | #fixed: 1,230.15 650 | #negative infinity: (-inf) 651 | #not a number: (NaN) 652 | 653 | === 654 | +++ yaml 655 | canonical: 2001-12-15T02:59:43.1Z 656 | valid iso8601: 2001-12-14t21:59:43.10-05:00 657 | space separated: 2001-12-14 21:59:43.10 -05:00 658 | date (noon UTC): 2002-12-14 659 | 660 | === 661 | +++ yaml 662 | #canonical: !binary "\ 663 | # R0lGODlhDAAMAIQAAP//9/X17unp5WZmZgAAAOf\ 664 | # n515eXvPz7Y6OjuDg4J+fn5OTk6enp56enmlpaW\ 665 | # NjY6Ojo4SEhP/++f/++f/++f/++f/++f/++f/++\ 666 | # f/++f/++f/++f/++f/++f/++f/++SH+Dk1hZGUg\ 667 | # d2l0aCBHSU1QACwAAAAADAAMAAAFLCAgjoEwnuN\ 668 | # AFOhpEMTRiggcz4BNJHrv/zCFcLiwMWYNG84Bww\ 669 | # EeECcgggoBADs=" 670 | #base64: !binary | 671 | # R0lGODlhDAAMAIQAAP//9/X17unp5WZmZgAAAOf 672 | # n515eXvPz7Y6OjuDg4J+fn5OTk6enp56enmlpaW 673 | # NjY6Ojo4SEhP/++f/++f/++f/++f/++f/++f/++ 674 | # f/++f/++f/++f/++f/++f/++f/++SH+Dk1hZGUg 675 | # d2l0aCBHSU1QACwAAAAADAAMAAAFLCAgjoEwnuN 676 | # AFOhpEMTRiggcz4BNJHrv/zCFcLiwMWYNG84Bww 677 | # EeECcgggoBADs= 678 | #description: > 679 | # The binary value above is a tiny arrow 680 | # encoded as a gif image. 681 | 682 | === 683 | +++ yaml 684 | ## Old schema 685 | #--- 686 | #link with: 687 | # - library1.dll 688 | # - library2.dll 689 | # 690 | ## New schema 691 | #--- 692 | #link with: 693 | # - = : library1.dll 694 | # version: 1.2 695 | # - = : library2.dll 696 | # version: 2.1 697 | 698 | === 699 | +++ yaml 700 | #"!": These three keys 701 | #"&": had to be quoted 702 | #"=": and are normal strings. 703 | ## NOTE: the following encoded node 704 | ## should NOT be serialized this way. 705 | #encoded node : 706 | # !special '!' : '!type' 707 | # !special '&' : 12 708 | # = : value 709 | ## The proper way to serialize the 710 | ## above structure is as follows: 711 | #node : !!type &12 value 712 | -------------------------------------------------------------------------------- /test/load-tests.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 38; 4 | use Test::Deep; 5 | local $YAML::LoadBlessed; 6 | $YAML::LoadBlessed = 1; 7 | 8 | run { 9 | my $block = shift; 10 | my @result = eval { 11 | Load($block->yaml) 12 | }; 13 | my $error1 = $@ || ''; 14 | if ( $error1 ) { 15 | # $error1 =~ s{line: (\d+)}{"line: $1 ($0:".($1+$test->{lines}{yaml}-1).")"}e; 16 | } 17 | my @expect = eval $block->perl; 18 | my $error2 = $@ || ''; 19 | if (my $errors = $error1 . $error2) { 20 | fail($block->description 21 | . $errors); 22 | next; 23 | } 24 | cmp_deeply( 25 | \@result, 26 | \@expect, 27 | $block->description, 28 | ) or do { 29 | require Data::Dumper; 30 | diag("Wanted: ".Data::Dumper::Dumper(\@expect)); 31 | diag("Got: ".Data::Dumper::Dumper(\@result)); 32 | } 33 | }; 34 | 35 | __DATA__ 36 | === a yaml error log 37 | +++ yaml 38 | --- 39 | date: Sun Oct 28 20:41:17 2001 40 | error msg: Premature end of script headers 41 | --- 42 | date: Sun Oct 28 20:41:44 2001 43 | error msg: malformed header from script. Bad header= 44 | --- 45 | date: Sun Oct 28 20:42:19 2001 46 | error msg: malformed header from script. Bad header= 47 | +++ perl 48 | my $a = { map {split /:\s*/, $_, 2} split /\n/, < 55 | END 56 | my $c = { map {split /:\s*/, $_, 2} split /\n/, < 59 | END 60 | ($a, $b, $c) 61 | === comments and some top level documents 62 | +++ yaml 63 | # Top level documents 64 | # 65 | # Note that inline (single line) values 66 | # are not allowed at the top level. This 67 | # includes implicit values, quoted values 68 | # and inline collections. 69 | --- 70 | a: map 71 | --- 72 | - a 73 | - sequence 74 | --- > 75 | plain scalar 76 | --- | 77 | This 78 | is 79 | a 80 | block. 81 | It's 82 | kinda 83 | like 84 | a 85 | here 86 | document. 87 | --- |- 88 | A 89 | chomped 90 | block. 91 | +++ perl 92 | my $a = {a => 'map'}; 93 | my $b = ['a', 'sequence']; 94 | my $c = "plain scalar\n"; 95 | my $d = < 'bar', baz => 'too'}; 156 | my $f = []; 157 | my $g = {}; 158 | my $h = {'09:00:00' => 'Breakfast', '12:00:00' => 'lunch time'}; 159 | my $i = bless {small => 'object'}, 'XYZ'; 160 | my $j = bless [bless([qw(a b c)], 'DEF'), 161 | bless({do => 're', mi => 'fa', so => 'la', ti => 'do'}, 'GHI'), 162 | ], 'ABC'; 163 | my $k = []; 164 | push @$k, $k, $k, $k; 165 | my $l = [{name => 'Ingy'}, {name => 'Clark'}, {name => 'Oren'}, ]; 166 | [$a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l] 167 | === a bunch of small top level thingies 168 | +++ yaml 169 | --- 42 170 | --- foo 171 | --- " bar " 172 | --- [] 173 | --- #YAML:1.0 {} 174 | --- '#YAML:9.9' 175 | --- {foo: [1, 2, 3], 12:34:56: bar} 176 | +++ perl 177 | my $a = 42; 178 | my $b = "foo"; 179 | my $c = " bar "; 180 | my $d = []; 181 | my $e = {}; 182 | my $f = "#YAML:9.9"; 183 | my $g = {foo => [1, 2, 3], '12:34:56' => 'bar'}; 184 | ($a, $b, $c, $d, $e, $f, $g) 185 | === a headerless sequence and a map 186 | +++ yaml 187 | - 2 188 | - 3 189 | - 4 190 | --- #YAML:1.0 191 | foo: bar 192 | +++ perl 193 | ([2,3,4], {foo => 'bar'}) 194 | === comments in various places 195 | +++ yaml 196 | # A pre header comment 197 | --- 198 | # comment 199 | # comment 200 | #comment 201 | - 2 202 | # comment 203 | # comment 204 | - 3 205 | - 4 206 | # comment 207 | - 5 208 | # last comment 209 | --- #YAML:1.0 210 | boo: far 211 | # a comment 212 | foo : bar 213 | --- 214 | - > 215 | # Not a comment; 216 | # Is a comment 217 | #Another comment 218 | --- 42 219 | #Final 220 | #Comment 221 | +++ perl 222 | ([2,3,4,5], 223 | {foo => 'bar', boo => 'far'}, 224 | ["# Not a comment;\n"], 225 | 42) 226 | === several docs, some empty 227 | +++ yaml 228 | --- 229 | - foo 230 | - bar 231 | --- 232 | --- 233 | - foo 234 | - foo 235 | --- 236 | # comment 237 | 238 | --- 239 | - bar 240 | - bar 241 | +++ perl 242 | (['foo', 'bar'],undef,['foo', 'foo'],undef,['bar', 'bar']) 243 | === a perl reference to a scalar 244 | +++ yaml 245 | --- !perl/ref: 246 | =: 42 247 | +++ perl 248 | (\42); 249 | === date loading 250 | +++ yaml 251 | --- 252 | - 1964-03-25 253 | - ! "1975-04-17" 254 | - !date '2001-09-11' 255 | - 12:34:00 256 | - ! "12:00:00" 257 | - !time '01:23:45' 258 | +++ perl 259 | ['1964-03-25', 260 | '1975-04-17', 261 | '2001-09-11', 262 | '12:34:00', 263 | '12:00:00', 264 | '01:23:45', 265 | ]; 266 | === sequence with trailing comment 267 | +++ yaml 268 | --- 269 | - fee 270 | - fie 271 | - foe 272 | # no num defined 273 | +++ perl 274 | [qw(fee fie foe)] 275 | === a simple literal block 276 | +++ yaml 277 | --- 278 | - | 279 | foo 280 | bar 281 | 282 | +++ perl 283 | ["foo\nbar\n"] 284 | === an unchomped literal 285 | +++ yaml -trim 286 | --- 287 | - |+ 288 | foo 289 | bar 290 | 291 | +++ perl 292 | ["foo\nbar\n\n"] 293 | === a chomped literal 294 | +++ yaml -trim 295 | --- 296 | - |- 297 | foo 298 | bar 299 | 300 | +++ perl 301 | ["foo\nbar"] 302 | === assorted numerics 303 | +++ yaml 304 | --- 305 | #- - 306 | #- + 307 | - 44 308 | - -45 309 | - 4.6 310 | - -4.7 311 | - 3e+2 312 | - [-4e+3, 5e-4] 313 | - -6e-10 314 | - 2001-12-15 315 | - 2001-12-15T02:59:43.1Z 316 | - 2001-12-14T21:59:43.25-05:00 317 | +++ perl 318 | [44, -45, 4.6, -4.7, '3e+2', ['-4e+3', '5e-4'], '-6e-10', 319 | '2001-12-15', '2001-12-15T02:59:43.1Z', '2001-12-14T21:59:43.25-05:00', 320 | ] 321 | === an empty string top level doc 322 | +++ yaml 323 | --- 324 | +++ perl 325 | undef 326 | 327 | === an array of various undef 328 | +++ yaml 329 | --- 330 | - 331 | - 332 | - '' 333 | +++ perl 334 | [undef,undef,''] 335 | === !!perl/array 336 | +++ yaml 337 | --- !!perl/array 338 | - 1 339 | +++ perl 340 | [ 1 ] 341 | === !!perl/array: 342 | +++ yaml 343 | --- !!perl/array: 344 | - 1 345 | +++ perl 346 | [ 1 ] 347 | === !!perl/array:moose 348 | +++ yaml 349 | --- !!perl/array:moose 350 | - 1 351 | +++ perl 352 | bless([ 1 ], "moose") 353 | === foo 354 | +++ yaml 355 | --- !!perl/hash 356 | foo: bar 357 | +++ perl 358 | { foo => "bar" } 359 | === foo 360 | +++ yaml 361 | --- !!perl/hash: 362 | foo: bar 363 | +++ perl 364 | { foo => "bar" } 365 | === foo 366 | +++ yaml 367 | --- !!perl/array:moose 368 | foo: bar 369 | +++ perl 370 | bless({ foo => "bar" }, "moose") 371 | === foo 372 | +++ yaml 373 | --- !!perl/ref 374 | =: 1 375 | +++ perl 376 | \1 377 | === foo 378 | +++ yaml 379 | --- !!perl/ref: 380 | =: 1 381 | +++ perl 382 | \1 383 | === foo 384 | +++ yaml 385 | --- !!perl/ref:moose 386 | =: 1 387 | +++ perl 388 | bless(do { my $x = 1; \$x}, "moose") 389 | === foo 390 | +++ yaml 391 | --- !!perl/scalar 1 392 | +++ perl 393 | 1 394 | === foo 395 | +++ yaml 396 | --- !!perl/scalar: 1 397 | +++ perl 398 | 1 399 | === foo 400 | +++ yaml 401 | --- !!perl/scalar:moose 1 402 | +++ perl 403 | bless(do { my $x = 1; \$x}, "moose") 404 | === ^ can start implicit 405 | +++ yaml 406 | - ^foo 407 | +++ perl 408 | ['^foo'] 409 | === Quoted keys 410 | +++ yaml 411 | - 'test - ': 23 412 | 'test '' ': 23 413 | "test \\": 23 414 | +++ perl 415 | [{ 'test - ' => 23, "test ' " => 23, 'test \\' => 23 }] 416 | === Plain string with multiple spaces 417 | +++ yaml 418 | --- A B 419 | +++ perl 420 | 'A B' 421 | === Plain string with multiple spaces at the beginning 422 | +++ yaml 423 | --- " ABC" 424 | +++ perl 425 | ' ABC' 426 | === Allowed characters in anchors 427 | +++ yaml 428 | --- 429 | - &a.1 a 430 | - &b/2 b 431 | - &c_3 c 432 | - &d-4 d 433 | - *a.1 434 | - *b/2 435 | - *c_3 436 | - *d-4 437 | +++ perl 438 | ['a', 'b', 'c', 'd', 'a', 'b', 'c', 'd'] 439 | 440 | === Compact nested block sequences 441 | +++ yaml 442 | - - a 443 | - b 444 | - - 1 445 | - - 2 446 | - 3 447 | - - [c] 448 | +++ perl 449 | [ 450 | ['a', 'b', [1], [2,3] ], 451 | [ ['c'] ], 452 | ] 453 | 454 | === Combined block scalar indicators 455 | +++ yaml 456 | --- 457 | a: |-2 458 | 1 459 | 2 460 | b: |2- 461 | 1 462 | 2 463 | c: >+2 464 | 1 465 | 2 466 | d: >2+ 467 | 1 468 | 2 469 | +++ perl 470 | { 471 | a => " 1\n2", 472 | b => " 1\n2", 473 | c => " 1\n2\n", 474 | d => " 1\n2\n", 475 | } 476 | 477 | === Nested explicit key 478 | +++ yaml 479 | --- 480 | - ? a 481 | : b 482 | +++ perl 483 | [{ a => 'b' }] 484 | 485 | === Nested mappings with non \w keys 486 | +++ yaml 487 | --- 488 | - .: a 489 | <: b 490 | -: c 491 | - 'not: a map' 492 | - "not: a map" 493 | +++ perl 494 | [ { '.' => 'a', '<' => 'b', '-' => 'c' }, 'not: a map', 'not: a map' ] 495 | 496 | === Zero indented block sequence 497 | +++ yaml 498 | a: 499 | b: 500 | - 501 | - 502 | c: 503 | - 504 | - 505 | d: 506 | - 1 507 | - 2 508 | e: 509 | - 3 510 | - 4 511 | - f: 512 | - 5 513 | - 6 514 | g: 7 515 | +++ perl 516 | { 517 | a => { b => [ undef, undef ] }, 518 | c => [undef, undef], 519 | d => [1, 2], 520 | e => [3, 4, { 521 | f => [5, 6], 522 | g => 7, 523 | }], 524 | } 525 | 526 | -------------------------------------------------------------------------------- /test/load-works.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML; 4 | 5 | filters { 6 | perl => 'eval', 7 | yaml => 'yaml_load', 8 | }; 9 | 10 | run_is_deeply; 11 | 12 | __DATA__ 13 | === A one key hash 14 | +++ perl 15 | +{foo => 'bar'} 16 | +++ yaml 17 | --- 18 | foo: bar 19 | === empty hashes 20 | +++ perl 21 | +{foo1 => undef, foo2 => undef} 22 | +++ yaml 23 | foo1: 24 | foo2: 25 | -------------------------------------------------------------------------------- /test/marshall.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 10; 4 | 5 | use strict; 6 | use warnings; 7 | 8 | #------------------------------------------------------------------------------- 9 | package Foo::Bar; 10 | BEGIN { 11 | require TestYAMLBase; 12 | @Foo::Bar::ISA = 'TestYAMLBase'; 13 | } 14 | use YAML::Marshall; 15 | 16 | sub yaml_dump { 17 | my $self = shift; 18 | my $array = []; 19 | for my $k (sort keys %$self) { 20 | push @$array, $k, $self->{$k}; 21 | } 22 | $self->yaml_node($array, 'perl/Foo::Bar'); 23 | } 24 | 25 | sub yaml_load { 26 | my $class = shift; 27 | my $node = shift; 28 | my $self = $class->new; 29 | %$self = @$node; 30 | return $self; 31 | } 32 | 33 | #------------------------------------------------------------------------------- 34 | package Bar::Baz; 35 | BEGIN { 36 | require TestYAMLBase; 37 | @Bar::Baz::ISA = 'TestYAMLBase'; 38 | } 39 | use YAML::Marshall 'random/object:bar.baz'; 40 | 41 | #------------------------------------------------------------------------------- 42 | package Baz::Foo; 43 | BEGIN { 44 | require TestYAMLBase; 45 | @Bar::Foo::ISA = 'TestYAMLBase'; 46 | } 47 | use YAML::Marshall; 48 | 49 | sub yaml_dump { 50 | my $self = shift; 51 | my $node = $self->SUPER::yaml_dump(@_); 52 | $node->{comment} = "Hi, Mom"; 53 | return $node; 54 | } 55 | 56 | sub yaml_load { 57 | my $class = shift; 58 | my $node = $class->SUPER::yaml_load(@_); 59 | delete $node->{comment}; 60 | return $node; 61 | } 62 | 63 | #------------------------------------------------------------------------------- 64 | package main; 65 | no_diff; 66 | run_roundtrip_nyn; 67 | 68 | is $main::BazFoo->{11}, 12, 69 | 'first key exists'; 70 | 71 | is $main::BazFoo->{13}, 14, 72 | 'second key exists'; 73 | 74 | ok not($main::BazFoo->{comment}), 75 | 'extra key not added'; 76 | 77 | __DATA__ 78 | 79 | === Serialize a hash object as a sequence 80 | +++ perl 81 | my $fb = Foo::Bar->new; 82 | $fb->{x} = 5; 83 | $fb->{y} = 'che'; 84 | [$fb]; 85 | +++ yaml 86 | --- 87 | - !perl/Foo::Bar 88 | - x 89 | - 5 90 | - y 91 | - che 92 | 93 | 94 | === Use a non-standard tag 95 | +++ perl: bless {11 .. 14}, 'Bar::Baz'; 96 | +++ yaml 97 | --- !random/object:bar.baz 98 | 11: 12 99 | 13: 14 100 | 101 | 102 | === super calls to mixins work 103 | +++ perl: bless {11 .. 14}, 'Baz::Foo'; 104 | +++ yaml 105 | --- !perl/Baz::Foo 106 | 11: 12 107 | 13: 14 108 | comment: 'Hi, Mom' 109 | 110 | 111 | === yaml_dump doesn't mutate original hash 112 | +++ no_round_trip 113 | +++ perl: $main::BazFoo = bless {11 .. 14}, 'Baz::Foo'; 114 | +++ yaml 115 | --- !perl/Baz::Foo 116 | 11: 12 117 | 13: 14 118 | comment: 'Hi, Mom' 119 | 120 | 121 | -------------------------------------------------------------------------------- /test/no-load-blessed.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 11; 4 | use Test::Deep; 5 | use YAML (); 6 | 7 | my $unblessed = YAML::Load(<<"EOM"); 8 | --- !!perl/array:Foo [] 9 | EOM 10 | is(ref $unblessed, 'ARRAY', "No objects by default"); 11 | 12 | $YAML::LoadBlessed = 0; 13 | 14 | run { 15 | my $block = shift; 16 | my @result = eval { 17 | Load($block->yaml) 18 | }; 19 | my $error1 = $@ || ''; 20 | if ( $error1 ) { 21 | # $error1 =~ s{line: (\d+)}{"line: $1 ($0:".($1+$test->{lines}{yaml}-1).")"}e; 22 | } 23 | my @expect = eval $block->perl; 24 | my $error2 = $@ || ''; 25 | if (my $errors = $error1 . $error2) { 26 | fail($block->description 27 | . $errors); 28 | next; 29 | } 30 | cmp_deeply( 31 | \@result, 32 | \@expect, 33 | $block->description, 34 | ) or do { 35 | require Data::Dumper; 36 | diag("Wanted: ".Data::Dumper::Dumper(\@expect)); 37 | diag("Got: ".Data::Dumper::Dumper(\@result)); 38 | } 39 | }; 40 | 41 | { 42 | local $YAML::LoadCode = 1; 43 | my $data = YAML::Load(<<'EOM'); 44 | --- !!perl/code:Foo::Bar | 45 | { 46 | return $_[0] * 2 47 | } 48 | EOM 49 | my $ref = ref $data; 50 | cmp_ok($ref, 'eq', 'CODE', "Coderef loaded, but not blessed"); 51 | my $result = $data->(2); 52 | cmp_ok($result, 'eq', 4, "Coderef works"); 53 | } 54 | 55 | { 56 | $main::foo = 23; 57 | my $data = YAML::Load(<<'EOM'); 58 | --- !!perl/glob:moose 59 | PACKAGE: main 60 | NAME: foo 61 | SCALAR: 42 62 | EOM 63 | my $ref = ref $data; 64 | cmp_ok($main::foo, '==', 23, "Glob did not set variable"); 65 | } 66 | 67 | __DATA__ 68 | === an array of assorted junk 69 | +++ yaml 70 | --- 71 | # a private Perl XYZ object 72 | - !perl/XYZ {small: object} 73 | # an object containing objects 74 | - !perl/ABC [!perl/@DEF [a,b,c],!perl/GHI {do: re, mi: fa, so: la,ti: do}] 75 | +++ perl 76 | my $i = {small => 'object'}; 77 | my $j = [[qw(a b c)], 78 | {do => 're', mi => 'fa', so => 'la', ti => 'do'}, 79 | ]; 80 | [ $i, $j ] 81 | === !!perl/array:moose 82 | +++ yaml 83 | --- !!perl/array:moose 84 | - 1 85 | +++ perl 86 | [ 1 ] 87 | === !!perl/hash:moose 88 | +++ yaml 89 | --- !!perl/hash:moose 90 | foo: bar 91 | +++ perl 92 | { foo => "bar" } 93 | === !!perl/ref:moose 94 | +++ yaml 95 | --- !!perl/ref:moose 96 | =: 1 97 | +++ perl 98 | do { my $x = 1; \$x} 99 | === !!perl/scalar:moose 100 | +++ yaml 101 | --- !!perl/scalar:moose 1 102 | +++ perl 103 | do { my $x = 1; \$x} 104 | === !!perl/regexp:moose 105 | +++ yaml 106 | --- !!perl/regexp:moose (?-xism:foo$) 107 | +++ perl 108 | qr{foo$} 109 | === !!perl/glob:moose 110 | +++ yaml 111 | --- !!perl/glob:moose 112 | PACKAGE: main 113 | NAME: foo 114 | SCALAR: 0 115 | +++ perl 116 | *main::foo 117 | -------------------------------------------------------------------------------- /test/node-info.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 16; 4 | use YAML::Dumper; 5 | 6 | package StrIngy; 7 | use overload '""', sub { 'A Stringy String' }; 8 | sub new {bless {}, shift} 9 | 10 | package main; 11 | my $object = bless {}, 'StrIngy'; 12 | 13 | # $\ = "\n"; 14 | # print ref($object); 15 | # print "$object"; 16 | # print overload::StrVal($object); 17 | # print overload::StrVal(bless {}, 'foo'); 18 | # exit; 19 | 20 | filters { 21 | node => ['eval_perl' => 'get_info'], 22 | info => ['lines' => 'make_regexp'], 23 | }; 24 | 25 | run_like node => 'info'; 26 | 27 | sub eval_perl { 28 | my $perl = shift; 29 | my $stringify = 0; 30 | $stringify = 1 if $perl =~ s/^#\s*//; 31 | my $node = eval $perl; 32 | die "Perl code failed to eval:\n$perl\n$@" if $@; 33 | return ($node, $stringify); 34 | } 35 | 36 | sub get_info { 37 | my $dumper = YAML::Dumper->new; 38 | join ';', map { 39 | defined($_) ? $_ : 'undef' 40 | } $dumper->node_info(@_); 41 | } 42 | 43 | sub make_regexp { 44 | my $string = join ';', map { 45 | chomp; 46 | s/^~$/undef/; 47 | s/^0x\d+/0x[0-9a-fA-F]+/; 48 | $_; 49 | } @_; 50 | qr/^${string}$/; 51 | } 52 | 53 | __DATA__ 54 | === Hash Ref 55 | +++ node: +{1..4}; 56 | +++ info 57 | ~ 58 | HASH 59 | 0x12345678 60 | 61 | === Array Ref 62 | +++ node: [1..5] 63 | +++ info 64 | ~ 65 | ARRAY 66 | 0x12345678 67 | 68 | === Scalar 69 | +++ node: 'hello'; 70 | +++ info 71 | ~ 72 | ~ 73 | 0x12345678-S 74 | 75 | === Scalar Ref 76 | +++ node: \ 'hello'; 77 | +++ info 78 | ~ 79 | SCALAR 80 | 0x12345678 81 | 82 | === Scalar Ref Ref 83 | +++ node: \\ 'hello'; 84 | +++ info 85 | ~ 86 | REF 87 | 0x12345678 88 | 89 | === Code Ref 90 | +++ node: sub { 42; } 91 | +++ info 92 | ~ 93 | CODE 94 | 0x12345678 95 | 96 | === Code Ref Ref 97 | +++ node: \ sub { 42; } 98 | +++ info 99 | ~ 100 | REF 101 | 0x12345678 102 | 103 | === Glob 104 | +++ node: $::x = 5; \ *x; 105 | +++ info 106 | ~ 107 | GLOB 108 | 0x12345678 109 | 110 | === Regular Expression 111 | +++ node: qr{xxx}; 112 | +++ info 113 | ~ 114 | REGEXP 115 | 0x12345678 116 | 117 | === Blessed Hash Ref 118 | +++ node: bless {}, 'ARRAY'; 119 | +++ info 120 | ARRAY 121 | HASH 122 | 0x12345678 123 | 124 | === Blessed Array Ref 125 | +++ node: bless [], 'Foo::Bar'; 126 | +++ info 127 | Foo::Bar 128 | ARRAY 129 | 0x12345678 130 | 131 | === Blessed Scalar Ref 132 | +++ node: my $b = 'boomboom'; bless ((\ $b), 'Foo::Barge'); 133 | +++ info 134 | Foo::Barge 135 | SCALAR 136 | 0x12345678 137 | 138 | === Blessed Code Ref 139 | +++ node: bless sub { 43 }, 'Foo::Barbie'; 140 | +++ info 141 | Foo::Barbie 142 | CODE 143 | 0x12345678 144 | 145 | === Blessed Glob 146 | +++ node: $::x = 5; bless \ *x, 'Che'; 147 | +++ info 148 | Che 149 | GLOB 150 | 0x12345678 151 | 152 | === Not Stringified Hash Object 153 | +++ node: bless {}, 'StrIngy'; 154 | +++ info 155 | StrIngy 156 | HASH 157 | 0x12345678 158 | 159 | === Stringified Hash Object 160 | +++ node: # bless {}, 'StrIngy'; 161 | +++ info 162 | ~ 163 | ~ 164 | 0x12345678-S 165 | 166 | 167 | -------------------------------------------------------------------------------- /test/numify.t: -------------------------------------------------------------------------------- 1 | use Test::More tests => 6; 2 | use YAML (); 3 | use B; 4 | 5 | my $yaml = <<'EOM'; 6 | int: 23 7 | float: 3.14 8 | exp: 1e-5 9 | EOM 10 | 11 | my $data1 = do { 12 | local $YAML::Numify = 1; 13 | YAML::Load($yaml); 14 | }; 15 | my $data2 = YAML::Load($yaml); 16 | 17 | my $int1 = B::svref_2object(\$data1->{int})->FLAGS & (B::SVp_IOK | B::SVp_NOK); 18 | my $int2 = B::svref_2object(\$data2->{int})->FLAGS & (B::SVp_IOK | B::SVp_NOK); 19 | my $float1 = B::svref_2object(\$data1->{float})->FLAGS & (B::SVp_IOK | B::SVp_NOK); 20 | my $float2 = B::svref_2object(\$data2->{float})->FLAGS & (B::SVp_IOK | B::SVp_NOK); 21 | my $exp1 = B::svref_2object(\$data1->{exp})->FLAGS & (B::SVp_IOK | B::SVp_NOK); 22 | my $exp2 = B::svref_2object(\$data2->{exp})->FLAGS & (B::SVp_IOK | B::SVp_NOK); 23 | 24 | ok($int1, "int with \$YAML::Numify"); 25 | ok(! $int2, "int without \$YAML::Numify"); 26 | ok($float1, "float with \$YAML::Numify"); 27 | ok(! $float2, "float without \$YAML::Numify"); 28 | ok($exp1, "exp with \$YAML::Numify"); 29 | ok(! $exp2, "exp without \$YAML::Numify"); 30 | done_testing; 31 | -------------------------------------------------------------------------------- /test/preserve.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Test::More tests => 1; 3 | use YAML; 4 | 5 | local $YAML::Preserve = 1; 6 | 7 | my $yaml = <<'...'; 8 | --- 9 | z: z 10 | y: y 11 | x: x 12 | w: w 13 | v: v 14 | u: u 15 | t: t 16 | s: s 17 | r: r 18 | q: q 19 | p: p 20 | o: o 21 | n: n 22 | m: m 23 | l: l 24 | k: k 25 | j: j 26 | i: i 27 | h: h 28 | g: g 29 | f: f 30 | e: e 31 | d: d 32 | c: c 33 | b: b 34 | a: a 35 | ... 36 | 37 | my $data = YAML::Load($yaml); 38 | my $dump = YAML::Dump($data); 39 | cmp_ok($dump, 'eq', $yaml, "Roundtrip with Preserve option"); 40 | 41 | done_testing; 42 | 43 | -------------------------------------------------------------------------------- /test/pugs-objects.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 2; 4 | local $YAML::LoadBlessed; 5 | $YAML::LoadBlessed = 1; 6 | 7 | { 8 | no warnings 'once'; 9 | $Foo::Bar::ClassTag = '!pugs/object:Foo::Bar'; 10 | $YAML::TagClass->{'!pugs/object:Foo::Bar'} = 'Foo::Bar'; 11 | } 12 | 13 | no_diff; 14 | run_roundtrip_nyn('dumper'); 15 | 16 | __DATA__ 17 | === Turn Perl object to Pugs object 18 | +++ perl: bless { 'a'..'d' }, 'Foo::Bar'; 19 | +++ yaml 20 | --- !!pugs/object:Foo::Bar 21 | a: b 22 | c: d 23 | -------------------------------------------------------------------------------- /test/references.t: -------------------------------------------------------------------------------- 1 | use lib 'inc'; 2 | use Test::YAML tests => 10; 3 | 4 | no_diff; 5 | 6 | run_yaml_tests; 7 | 8 | __DATA__ 9 | === A scalar ref 10 | +++ perl: \ 42 11 | +++ yaml 12 | --- !!perl/ref 13 | =: 42 14 | 15 | === A ref to a scalar ref 16 | +++ perl: \\ "yellow" 17 | +++ yaml 18 | --- !!perl/ref 19 | =: !!perl/ref 20 | =: yellow 21 | 22 | === A ref to a ref to a scalar ref 23 | +++ perl: \\\ 123 24 | +++ yaml 25 | --- !!perl/ref 26 | =: !!perl/ref 27 | =: !!perl/ref 28 | =: 123 29 | 30 | === A blessed container reference 31 | +++ perl 32 | my $array_ref = [ 1, 3, 5]; 33 | my $container_ref = \ $array_ref; 34 | bless $container_ref, 'Wax'; 35 | +++ yaml 36 | --- !!perl/ref:Wax 37 | =: 38 | - 1 39 | - 3 40 | - 5 41 | 42 | === A blessed scalar reference 43 | +++ perl 44 | my $scalar = "omg"; 45 | my $scalar_ref = \ $scalar; 46 | bless $scalar_ref, 'Wax'; 47 | +++ yaml 48 | --- !!perl/scalar:Wax omg 49 | -------------------------------------------------------------------------------- /test/regexp.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 12; 4 | use YAML(); 5 | use Encode; 6 | no warnings 'once'; 7 | local $YAML::LoadBlessed = 1; 8 | 9 | my $m_xis = "m-xis"; 10 | my $_xism = "-xism"; 11 | if (qr/x/ =~ /\(\?\^/){ 12 | $m_xis = "^m"; 13 | $_xism = "^"; 14 | } 15 | my @blocks = blocks; 16 | 17 | my $block = $blocks[0]; 18 | 19 | $YAML::UseCode = 1; 20 | my $hash = YAML::Load($block->yaml); 21 | is $hash->{key}, "(?$m_xis:foo\$)", 'Regexps load'; 22 | is YAML::Dump(eval $block->perl), <<"...", 'Regexps dump'; 23 | --- 24 | key: !!perl/regexp (?$m_xis:foo\$) 25 | ... 26 | 27 | my $re = $hash->{key}; 28 | 29 | is ref($re), 'Regexp', 'The regexp is a Regexp'; 30 | 31 | like "Hello\nBarfoo", $re, 'The regexp works'; 32 | 33 | #------------------------------------------------------------------------------- 34 | 35 | $block = $blocks[1]; 36 | 37 | $hash = YAML::Load($block->yaml); 38 | is $hash->{key}, "(?$m_xis:foo\$)", 'Regexps load'; 39 | 40 | # XXX Dumper can't detect a blessed regexp 41 | 42 | # is YAML::Dump(eval $block->perl), <<"...", 'Regexps dump'; 43 | # --- 44 | # key: !!perl/regexp (?$m_xis:foo\$) 45 | # ... 46 | 47 | $re = $hash->{key}; 48 | 49 | is ref($re), 'Classy', 'The regexp is a Classy :('; 50 | 51 | # XXX Test more doesn't think a blessed regexp is a regexp (for like) 52 | 53 | # like "Hello\nBarfoo", $re, 'The regexp works'; 54 | ok(("Hello\nBarfoo" =~ $re), 'The regexp works'); 55 | 56 | #------------------------------------------------------------------------------- 57 | 58 | $block = $blocks[2]; 59 | 60 | $hash = YAML::Load($block->yaml); 61 | is $hash->{key}, "(?$_xism:foo\$)", 'Regexps load'; 62 | 63 | is YAML::Dump(eval $block->perl), <<"...", 'Regexps dump'; 64 | --- 65 | key: !!perl/regexp (?$_xism:foo\$) 66 | ... 67 | 68 | $re = $hash->{key}; 69 | 70 | is ref($re), 'Regexp', 'The regexp is a Regexp'; 71 | 72 | like "Barfoo", $re, 'The regexp works'; 73 | 74 | my $yaml = decode_utf8 q{re : !!perl/regexp OK}; 75 | $re = Load $yaml; 76 | $yaml = Dump $re; 77 | my $compare = $yaml; 78 | for (1 .. 5) { 79 | $re = Load $yaml; 80 | $yaml = Dump $re; 81 | } 82 | 83 | cmp_ok($yaml, 'eq', $compare, "Regexp multiple roundtrip does not grow"); 84 | 85 | 86 | __END__ 87 | === A regexp with flag 88 | +++ yaml 89 | --- 90 | key: !!perl/regexp (?m-xis:foo$) 91 | +++ perl 92 | +{key => qr/foo$/m} 93 | 94 | === A blessed rexexp 95 | +++ yaml 96 | --- 97 | key: !!perl/regexp:Classy (?m-xis:foo$) 98 | +++ perl 99 | +{key => bless(qr/foo$/m, 'Classy')} 100 | 101 | === A regexp with no flag 102 | +++ yaml 103 | --- 104 | key: !!perl/regexp (?-xism:foo$) 105 | +++ perl 106 | +{key => qr/foo$/} 107 | 108 | -------------------------------------------------------------------------------- /test/roundtrip.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use YAML; 5 | use Test::More tests => 1; 6 | use Test::Deep; 7 | 8 | my %in = ( '=' => 'value' ); 9 | my $yaml = Dump \%in; 10 | my $roundtrip = Load $yaml; 11 | cmp_deeply($roundtrip, \%in, "Roundtrip with '=' hash key"); 12 | 13 | 14 | done_testing; 15 | -------------------------------------------------------------------------------- /test/rt-90593.t: -------------------------------------------------------------------------------- 1 | # https://rt.cpan.org/Public/Bug/Display.html?id=90593 2 | use Test::More; 3 | 4 | if ($] < 5.010000) { 5 | plan skip_all => "Skip old perls"; 6 | } 7 | else { 8 | plan tests => 2; 9 | } 10 | 11 | use YAML; 12 | use constant LENGTH => 1000000; 13 | 14 | $SIG{__WARN__} = sub { die @_ }; 15 | 16 | my $yaml = 'x: "' . ('x' x LENGTH) . '"' . "\n"; 17 | 18 | my $hash = Load $yaml; 19 | 20 | is ref($hash), 'HASH', 'Loaded a hash'; 21 | is length($hash->{x}), LENGTH, 'Long scalar loaded'; 22 | -------------------------------------------------------------------------------- /test/svk-config.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | checkout: !perl/Data::Hierarchy 3 | hash: 4 | /home/jesse/README: 5 | depotpath: //local/rt-3.4/README 6 | encoding: ascii 7 | revision: 17371 8 | /home/jesse/foo: 9 | depotpath: //local/foo 10 | encoding: ascii 11 | revision: 19501 12 | /home/jesse/svk/1.0-releng: 13 | depotpath: //mirror/svk/branches/1.0-releng/ 14 | encoding: ascii 15 | revision: 20905 16 | /home/jesse/svk/Acme-Net-OdiousPlan: 17 | depotpath: //mirror//bps-public/Acme-Net-OdiousPlan/ 18 | encoding: ascii 19 | revision: 13820 20 | /home/jesse/svk/Business-Hours: 21 | depotpath: //local/Business-Hours 22 | encoding: iso-8859-1 23 | revision: 17426 24 | /home/jesse/svk/DBIx-DBSchema: 25 | depotpath: //local/DBIx-DBSchema 26 | encoding: utf-8-strict 27 | revision: 19508 28 | /home/jesse/svk/DBIx-SearchBuilder: 29 | depotpath: //local/DBIx-SearchBuilder/ 30 | encoding: iso-8859-1 31 | revision: 21870 32 | /home/jesse/svk/Data-ICal: 33 | depotpath: //local/Data-ICal 34 | encoding: iso-8859-1 35 | revision: 17222 36 | /home/jesse/svk/Devel-ebug: 37 | depotpath: //local/Devel-ebug/ 38 | encoding: ascii 39 | revision: 15097 40 | /home/jesse/svk/Devel-ebug-HTTP: 41 | depotpath: //local/Devel-ebug-HTTP/ 42 | encoding: ascii 43 | revision: 15099 44 | /home/jesse/svk/HTTP-Server-Simple: 45 | depotpath: //local/HTTP-Server-Simple/ 46 | encoding: iso-8859-1 47 | revision: 18459 48 | /home/jesse/svk/HTTP-Server-Simple-Mason: 49 | depotpath: //local/HTTP-Server-Simple-Mason/ 50 | encoding: ascii 51 | revision: 13726 52 | /home/jesse/svk/HTTP-Server-Simple-Recorder: 53 | depotpath: //local/HTTP-Server-Simple-Recorder 54 | encoding: ascii 55 | revision: 13245 56 | /home/jesse/svk/Module-Install-RTx: 57 | depotpath: //local/Module-Install-RTx/ 58 | encoding: ascii 59 | revision: 19842 60 | /home/jesse/svk/Module-Refresh: 61 | depotpath: //local/Module-Refresh 62 | encoding: iso-8859-1 63 | revision: 20956 64 | /home/jesse/svk/RT-Extension-ActivityReports: 65 | depotpath: //local/RT-Extension-ActivityReports/ 66 | encoding: ascii 67 | revision: 22084 68 | /home/jesse/svk/RT-Extension-MergeUsers: 69 | depotpath: //local/RT-Extension-MergeUsers/ 70 | encoding: ascii 71 | revision: 18043 72 | /home/jesse/svk/RT-Extension-Redacted: 73 | depotpath: //local/RT-Extension-Redacted/ 74 | encoding: ascii 75 | revision: 20453 76 | /home/jesse/svk/RT-Integration-SVN: 77 | depotpath: //local/RT-Integration-SVN/ 78 | encoding: iso-8859-1 79 | revision: 4915 80 | /home/jesse/svk/RT-KeyBindings: 81 | depotpath: //local/RT-KeyBindings 82 | encoding: ascii 83 | revision: 15495 84 | /home/jesse/svk/RT-OnlineDocs: 85 | depotpath: //local/RT-OnlineDocs/ 86 | encoding: ascii 87 | revision: 20473 88 | /home/jesse/svk/RT-TicketWhiteboard: 89 | depotpath: //local/RT-TicketWhiteboard/ 90 | encoding: utf-8-strict 91 | revision: 20454 92 | /home/jesse/svk/RT-Todo: 93 | depotpath: //local/RT-Todo 94 | encoding: iso-8859-1 95 | revision: 7320 96 | /home/jesse/svk/RT-View-Directory: 97 | depotpath: //local/RT-View-Directory/ 98 | encoding: ascii 99 | revision: 20455 100 | /home/jesse/svk/RT-View-Tree: 101 | depotpath: //local/RT-View-Tree/ 102 | encoding: iso-8859-1 103 | revision: 4918 104 | /home/jesse/svk/Test-HTTP-Server-Simple: 105 | depotpath: //mirror/bps-public/Test-HTTP-Server-Simple/ 106 | encoding: ascii 107 | revision: 7358 108 | /home/jesse/svk/WWW-Mechanize-FromRecording: 109 | depotpath: //mirror/bps-public/WWW-Mechanize-FromRecording/ 110 | encoding: ascii 111 | revision: 15347 112 | /home/jesse/svk/chaldea: 113 | depotpath: //local/chaldea 114 | encoding: ascii 115 | revision: 19696 116 | /home/jesse/svk/chaldea/html/Ticket/ModifyAll.html: 117 | revision: 19797 118 | /home/jesse/svk/clkao: 119 | depotpath: //local/clkao 120 | encoding: ascii 121 | revision: 15496 122 | /home/jesse/svk/customers: 123 | depotpath: //local/customers 124 | encoding: ascii 125 | revision: 20447 126 | /home/jesse/svk/hiveminder-trunk: 127 | depotpath: //local/hiveminder-trunk/ 128 | encoding: ascii 129 | revision: 21802 130 | /home/jesse/svk/jifty.org: 131 | depotpath: //local/jifty.org 132 | encoding: ascii 133 | revision: 22079 134 | /home/jesse/svk/logo: 135 | depotpath: //mirror/bps-private/docs/logo 136 | encoding: ascii 137 | revision: 7032 138 | /home/jesse/svk/modinstal: 139 | depotpath: //local/modinstal 140 | encoding: ascii 141 | revision: 20926 142 | /home/jesse/svk/people: 143 | depotpath: //local/people 144 | encoding: ascii 145 | revision: 7029 146 | /home/jesse/svk/people/kevinr: 147 | revision: 7633 148 | /home/jesse/svk/perl6-doc: 149 | depotpath: //local/perl6-doc/ 150 | encoding: iso-8859-1 151 | revision: 17030 152 | /home/jesse/svk/personal: 153 | depotpath: //local/personal 154 | encoding: ascii 155 | revision: 13817 156 | /home/jesse/svk/planetsix: 157 | depotpath: //local/planetsix 158 | encoding: ascii 159 | revision: 21020 160 | /home/jesse/svk/private-docs: 161 | depotpath: //local/private-docs 162 | encoding: ascii 163 | revision: 18093 164 | /home/jesse/svk/quebec: 165 | depotpath: //local/quebec 166 | encoding: ascii 167 | revision: 19693 168 | /home/jesse/svk/rt-3.0: 169 | depotpath: //local/rt-3.0 170 | encoding: iso-8859-1 171 | revision: 18019 172 | /home/jesse/svk/rt-3.2: 173 | depotpath: //local/rt-3.2 174 | encoding: iso-8859-1 175 | revision: 17458 176 | /home/jesse/svk/rt-3.4: 177 | depotpath: //local/rt-3.4 178 | encoding: iso-8859-1 179 | revision: 20436 180 | /home/jesse/svk/rt-3.5: 181 | depotpath: //local/rt-3.5 182 | encoding: iso-8859-1 183 | revision: 20493 184 | /home/jesse/svk/rt-book: 185 | depotpath: //local/rt-book/ 186 | encoding: ascii 187 | revision: 4893 188 | /home/jesse/svk/rt.cpan.org: 189 | depotpath: //local/rt.cpan.org 190 | encoding: ascii 191 | revision: 17911 192 | /home/jesse/svk/rtfm-2.0: 193 | depotpath: //local/rtfm-2.0 194 | encoding: ascii 195 | revision: 16160 196 | /home/jesse/svk/rtfm-2.1: 197 | depotpath: //local/rtfm-2.1 198 | encoding: ascii 199 | revision: 19705 200 | /home/jesse/svk/rtir-1.0: 201 | depotpath: //local/rtir-1.0 202 | encoding: iso-8859-1 203 | revision: 17456 204 | /home/jesse/svk/svk-trunk: 205 | depotpath: //local/svk-trunk 206 | encoding: ascii 207 | revision: 21697 208 | /home/jesse/svk/svkbook: 209 | depotpath: //local/svkbook-trunk 210 | encoding: ascii 211 | revision: 18587 212 | /home/jesse/svk/training: 213 | depotpath: //local/training 214 | encoding: ascii 215 | revision: 22081 216 | /home/jesse/svk/trunk: 217 | depotpath: //local/svk/trunk 218 | encoding: ascii 219 | revision: 0 220 | /tmp/3.5-TESTING: 221 | depotpath: //mirror/bps-public/rt/branches/3.5-TESTING/ 222 | encoding: ascii 223 | revision: 19687 224 | /tmp/gtd: 225 | depotpath: //local/gtd 226 | encoding: ascii 227 | revision: 0 228 | /tmp/hm/hiveminder-trunk: 229 | depotpath: //local/hiveminder-trunk 230 | encoding: ascii 231 | revision: 15375 232 | /tmp/svl-checkous/Acme-Colour: 233 | depotpath: //_default_/acme/Acme-Colour 234 | encoding: ascii 235 | revision: 7268 236 | /tmp/svlco/Acme-Colour: 237 | depotpath: //_default_/acme/Acme-Colour 238 | encoding: ascii 239 | revision: 7268 240 | /tmp/trunk: 241 | depotpath: //mirror/bps-private/hiveminder/trunk 242 | encoding: utf-8-strict 243 | revision: 19754 244 | sep: / 245 | sticky: 246 | /home/jesse/svk/1.0-releng/lib/SVK/Target.pm: 247 | .newprop: {} 248 | /home/jesse/svk/hiveminder-trunk/Jifty: 249 | .conflict: 1 250 | /home/jesse/svk/hiveminder-trunk/Jifty/Makefile: 251 | .conflict: 1 252 | /home/jesse/svk/hiveminder-trunk/Jifty/Makefile.old: 253 | .conflict: 1 254 | /home/jesse/svk/hiveminder-trunk/Jifty/blib: 255 | .conflict: 1 256 | /home/jesse/svk/hiveminder-trunk/Jifty/doc: 257 | .conflict: 1 258 | /home/jesse/svk/hiveminder-trunk/Jifty/doc/session: 259 | .conflict: 1 260 | /home/jesse/svk/hiveminder-trunk/Jifty/inc: 261 | .conflict: 1 262 | /home/jesse/svk/hiveminder-trunk/Jifty/jifty: 263 | .conflict: 1 264 | /home/jesse/svk/hiveminder-trunk/Jifty/lib: 265 | .conflict: 1 266 | /home/jesse/svk/hiveminder-trunk/Jifty/lib/Jifty: 267 | .conflict: 1 268 | /home/jesse/svk/hiveminder-trunk/Jifty/lib/Jifty/DefaultApp: 269 | .conflict: 1 270 | /home/jesse/svk/hiveminder-trunk/Jifty/lib/Jifty/Manual: 271 | .conflict: 1 272 | /home/jesse/svk/hiveminder-trunk/Jifty/lib/Jifty/Manual/ObjectModel.pod: 273 | .conflict: 1 274 | /home/jesse/svk/hiveminder-trunk/Jifty/pm_to_blib: 275 | .conflict: 1 276 | /home/jesse/svk/hiveminder-trunk/Jifty/t: 277 | .conflict: 1 278 | /home/jesse/svk/hiveminder-trunk/Jifty/t/Continuations: 279 | .conflict: 1 280 | /home/jesse/svk/hiveminder-trunk/Jifty/t/Continuations/Makefile.old: 281 | .conflict: 1 282 | /home/jesse/svk/hiveminder-trunk/Jifty/t/Continuations/continuations: 283 | .conflict: 1 284 | /home/jesse/svk/hiveminder-trunk/Jifty/t/Continuations/continuationstest: 285 | .conflict: 1 286 | /home/jesse/svk/hiveminder-trunk/Jifty/t/Continuations/inc: 287 | .conflict: 1 288 | /home/jesse/svk/hiveminder-trunk/Jifty/t/Mapper: 289 | .conflict: 1 290 | /home/jesse/svk/hiveminder-trunk/Jifty/t/Mapper/mapper: 291 | .conflict: 1 292 | /home/jesse/svk/hiveminder-trunk/Jifty/t/Mapper/mappertest: 293 | .conflict: 1 294 | /home/jesse/svk/hiveminder-trunk/Jifty/t/utils.pl: 295 | .conflict: 1 296 | /home/jesse/svk/jifty.org: 297 | .newprop: 298 | svk:merge: e84bef0a-9b06-0410-84ba-c4c9edb13aeb:/:428 299 | .schedule: prop 300 | /home/jesse/svk/rt.cpan.org/rt2-existing/local/WebRT/html/NoAuth/bugs.tsv: 301 | .newprop: 302 | svn:executable: '*' 303 | .schedule: add 304 | /home/jesse/svk/training: 305 | .newprop: 306 | svk:merge: |- 307 | 6641d27c-1bcc-0310-8a77-bef5c512aa61:/training:1585 308 | a51291e0-c2ea-0310-847b-fbb8d8170edb:/local/training:5752 309 | .schedule: prop 310 | /home/jesse/svk/training/developer_training: 311 | .newprop: 312 | svk:merge: |- 313 | 5f29b386-91d9-0310-ba9f-d3bca794479a:/rttraining/local:1354 314 | 5f29b386-91d9-0310-ba9f-d3bca794479a:/rttraining/local-merge-9322:1032 315 | 5f88e03f-dcfa-0310-a525-a1f853655784:/rt-developer-training:1586 316 | 8d5e1d6e-e2eb-0310-9379-fb19c180b7be:/dev_training-local:1241 317 | .schedule: prop 318 | depotmap: 319 | '': /home/jesse/.svk/local 320 | parrot: /home/jesse/.svk/parrot 321 | -------------------------------------------------------------------------------- /test/svk.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use TestYAML tests => 3; 4 | 5 | my $test_file = "$t/svk-config.yaml"; 6 | my $node = LoadFile($test_file); 7 | 8 | is ref($node), 'HASH', 9 | "loaded svk file is a hash"; 10 | 11 | open IN, $test_file or die "Can't open $test_file for input: $!"; 12 | my $yaml_from_file = do {local $/; }; 13 | 14 | like $yaml_from_file, qr{^---\ncheckout: !perl/Data::Hierarchy\n}, 15 | "at least first two lines of file are right"; 16 | 17 | my $yaml_from_node = Dump($node); 18 | 19 | is Dump(Load($yaml_from_node)), Dump(Load($yaml_from_file)), 20 | "svk data roundtrips!";; 21 | -------------------------------------------------------------------------------- /test/test.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 1; 4 | 5 | pass('TestYAML framework loads'); 6 | -------------------------------------------------------------------------------- /test/trailing-comments-content.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 6; 4 | 5 | run { 6 | my $block = shift; 7 | my @result = eval { 8 | Load($block->yaml) 9 | }; 10 | my $error1 = $@ || ''; 11 | if ( $error1 ) { 12 | # $error1 =~ s{line: (\d+)}{"line: $1 ($0:".($1+$test->{lines}{yaml}-1).")"}e; 13 | } 14 | my @expect = eval $block->perl; 15 | my $error2 = $@ || ''; 16 | if (my $errors = $error1 . $error2) { 17 | fail($block->description 18 | . $errors); 19 | next; 20 | } 21 | is_deeply( 22 | \@result, 23 | \@expect, 24 | $block->description, 25 | ) or do { 26 | require Data::Dumper; 27 | diag("Wanted: ".Data::Dumper::Dumper(\@expect)); 28 | diag("Got: ".Data::Dumper::Dumper(\@result)); 29 | } 30 | }; 31 | 32 | __DATA__ 33 | 34 | === Comment after simple mapping value 35 | +++ yaml 36 | --- 37 | foo: val #comment val 38 | +++ perl 39 | { foo => "val" } 40 | 41 | === Comment after simple sequence value 42 | +++ yaml 43 | --- 44 | foo: 45 | - s2 #comment s2 46 | +++ perl 47 | { foo => ['s2'] } 48 | 49 | === Comment after simple sequence value (2) 50 | +++ yaml 51 | --- 52 | - s2 #comment s1 53 | +++ perl 54 | ['s2'] 55 | 56 | === Comment after simple top level scalar 57 | +++ yaml 58 | --- abc # comment abc 59 | +++ perl 60 | 'abc' 61 | 62 | === Comment after empty mapping value 63 | +++ yaml 64 | --- 65 | foo: #comment foo 66 | bar: #comment bar 67 | +++ perl 68 | { foo => undef, bar => undef } 69 | 70 | === Comment after empty sequence value 71 | +++ yaml 72 | --- 73 | foo: 74 | - # empty sequence value 75 | +++ perl 76 | { foo => [''] } 77 | -------------------------------------------------------------------------------- /test/trailing-comments-non-content.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib -e 't' ? 't' : 'test'; 3 | use TestYAML tests => 7; 4 | 5 | # testing trailing comments which were errors before 6 | 7 | run { 8 | my $block = shift; 9 | my @result = eval { 10 | Load($block->yaml) 11 | }; 12 | my $error1 = $@ || ''; 13 | if ( $error1 ) { 14 | # $error1 =~ s{line: (\d+)}{"line: $1 ($0:".($1+$test->{lines}{yaml}-1).")"}e; 15 | } 16 | my @expect = eval $block->perl; 17 | my $error2 = $@ || ''; 18 | if (my $errors = $error1 . $error2) { 19 | fail($block->description 20 | . $errors); 21 | next; 22 | } 23 | is_deeply( 24 | \@result, 25 | \@expect, 26 | $block->description, 27 | ) or do { 28 | require Data::Dumper; 29 | diag("Wanted: ".Data::Dumper::Dumper(\@expect)); 30 | diag("Got: ".Data::Dumper::Dumper(\@result)); 31 | } 32 | }; 33 | 34 | __DATA__ 35 | 36 | === Comment after inline seq 37 | +++ yaml 38 | --- 39 | seq: [314] #comment 40 | +++ perl 41 | { seq => [314] } 42 | 43 | === Comment after inline map 44 | +++ yaml 45 | --- 46 | map: {x: y} #comment 47 | +++ perl 48 | { map => { x => 'y' }, } 49 | 50 | === Comment after literal block scalar indicator 51 | +++ yaml 52 | --- 53 | - |- #comment 54 | +++ perl 55 | [''] 56 | 57 | === Comment after folded block scalar indicator 58 | +++ yaml 59 | --- 60 | - >- #comment 61 | +++ perl 62 | [''] 63 | 64 | === Comment after top level literal block scalar indicator 65 | +++ yaml 66 | --- |- #comment 67 | +++ perl 68 | '' 69 | === Comment after double quoted string 70 | +++ yaml 71 | --- 72 | quoted: "string" #comment 73 | +++ perl 74 | { quoted => 'string' } 75 | 76 | === Comment after single quoted string 77 | +++ yaml 78 | --- 79 | quoted: 'string' #comment 80 | +++ perl 81 | { quoted => 'string' } 82 | --------------------------------------------------------------------------------