├── .travis.yml ├── About ├── Changes ├── Meta ├── ReadMe.pod ├── doc └── IO │ ├── All.swim │ └── All │ ├── DBM.swim │ ├── Dir.swim │ ├── File.swim │ ├── Filesys.swim │ ├── Link.swim │ ├── MLDBM.swim │ ├── Pipe.swim │ ├── STDIO.swim │ ├── Socket.swim │ ├── String.swim │ └── Temp.swim ├── eg └── create-cat-to.pl ├── lib └── IO │ ├── All.pm │ └── All │ ├── Base.pm │ ├── DBM.pm │ ├── Dir.pm │ ├── File.pm │ ├── Filesys.pm │ ├── Link.pm │ ├── MLDBM.pm │ ├── Pipe.pm │ ├── STDIO.pm │ ├── Socket.pm │ ├── String.pm │ └── Temp.pm ├── note ├── Design.st ├── Design.swim ├── ToDo └── method_list └── test ├── IO_All_Test.pm ├── IO_Dumper.pm ├── RT81224.t ├── absolute.t ├── accept.t ├── all.t ├── all2.t ├── append.t ├── assert.t ├── assert2.t ├── autotie.t ├── backwards.t ├── binary_utf8.t ├── chdir.t ├── chomp.t ├── construct.t ├── copy.t ├── data └── head_test.txt ├── dbm.t ├── devnull.t ├── empty.t ├── encoding.t ├── error1.t ├── file_spec.t ├── file_subclass.t ├── fileno.t ├── glob.t ├── head.t ├── img.jpg ├── import_flags.t ├── in-place.t ├── inline_subclass.t ├── input.t ├── link.t ├── link2.t ├── lock.t ├── mldbm.t ├── morestuff ├── mydir ├── dir1 │ ├── dira │ │ └── dirx │ │ │ └── file1 │ └── file1 ├── dir2 │ └── file1 ├── file1 ├── file2 └── file3 ├── mystuff ├── mystuff2 ├── new.t ├── os.t ├── overload.t ├── pipe.t ├── print.t ├── println.t ├── read.t ├── read_write.t ├── round_robin.t ├── rt-41819.t ├── scalar.t ├── seek.t ├── separator.t ├── stat.t ├── string_open.t ├── subtleties.t ├── synopsis1.t ├── synopsis2.t ├── synopsis3.t ├── synopsis5.t ├── text.big5 ├── text.utf8 ├── tie.t ├── tie_file.t ├── unit ├── append.pl ├── client.pl ├── println.pl ├── server.pl ├── stdio.pl ├── test.pl └── xxx.pl └── xxx.t /.travis.yml: -------------------------------------------------------------------------------- 1 | # DO NOT EDIT 2 | # 3 | # This .travis.yml file generated by Zilla-Dist-0.0.196. 4 | # 5 | # To update it, run: 6 | # 7 | # > zild update 8 | # 9 | 10 | language: perl 11 | 12 | perl: 13 | - '5.24' 14 | - '5.22' 15 | - '5.20' 16 | - '5.18' 17 | - '5.16' 18 | - '5.14' 19 | - '5.12' 20 | - '5.10' 21 | 22 | install: 23 | - cpanm --quiet --notest 24 | Devel::Cover::Report::Coveralls 25 | Cwd 26 | File::MimeInfo 27 | File::ReadBackwards 28 | Scalar::Util 29 | 30 | script: 31 | - true && [ ! -e test/ ] || 32 | PERL5OPT=-MDevel::Cover=-coverage,statement,branch,condition,path,subroutine 33 | prove -lv test/ 34 | - true && [ ! -e test/ ] || cover 35 | 36 | after_success: 37 | - cover -report coveralls 38 | 39 | notifications: 40 | irc: 41 | channels: 42 | - irc.perl.org#io-all 43 | on_success: change 44 | on_failure: always 45 | skip_join: true 46 | 47 | # Hack to not run on tag pushes: 48 | branches: 49 | except: 50 | - /^v?[0-9]+\.[0-9]+/ 51 | -------------------------------------------------------------------------------- /About: -------------------------------------------------------------------------------- 1 | About IO-All 2 | ============ 3 | 4 | This repository contains the source code for the Perl 5 module distribution: 5 | 6 | IO-All — "IO::All to Larry Wall!" 7 | 8 | by Ingy döt Net 9 | 10 | Copyright 2004-2017. Ingy döt Net. 11 | 12 | License 13 | ------- 14 | 15 | This program is free software; you can redistribute it and/or modify it under 16 | the same terms as Perl itself. 17 | 18 | See http://www.perl.com/perl/misc/Artistic.html 19 | 20 | Installation 21 | ------------ 22 | 23 | You can install the latest release of IO-All with this command: 24 | 25 | cpanm IO::All 26 | 27 | If you don't have `cpanm` yet, installation is simple. See: 28 | 29 | https://metacpan.org/pod/App::cpanminus#INSTALLATION 30 | 31 | Or get the release information directly from: 32 | 33 | https://metacpan.org/release/IO-All 34 | 35 | Open Source 36 | ----------- 37 | 38 | The code for IO-All is hosted at GitHub. The URL is: 39 | 40 | https://github.com/ingydotnet/io-all-pm 41 | 42 | This project uses the Zilla-Dist framework for development and release 43 | automation. You install it with: 44 | 45 | cpanm -n Zilla::Dist # -n means "no test" which can save a lot of time 46 | 47 | Once installed, run `zild make` to get a list of all the things you can do. 48 | See https://metacpan.org/pod/distribution/Zilla-Dist/lib/Zilla/Dist.pod for 49 | more information. 50 | 51 | NOTE: If you just want to run the tests without installing Zilla::Dist, use: 52 | 53 | prove -lv test/ 54 | 55 | Repository Layout 56 | ----------------- 57 | 58 | This repoository contains the following top level files and directories: 59 | 60 | About - This file describing the repository. (generated) 61 | Changes - Change log file in YAML. 62 | Meta - All metadata for the project. 63 | ReadMe.pod - Top level ReadMe file for GitHub. (generated) 64 | .travis.yml - Travis CI test control file. (generated) 65 | 66 | doc/ - Documentation directory. 67 | eg/ - Example files. 68 | .git/ - Git repository data. 69 | lib/ - All the source code libraries (modules). 70 | note/ - Random note files. To-Do lists, specs, etc. 71 | 72 | Resources 73 | --------- 74 | 75 | Source - https://github.com/ingydotnet/io-all-pm 76 | Release - https://metacpan.org/release/IO-All 77 | Bugs - https://github.com/ingydotnet/io-all-pm/issues 78 | Pulls - https://github.com/ingydotnet/io-all-pm/pulls 79 | IRC - irc.perl.org#io-all 80 | 81 | Contributing 82 | ------------ 83 | 84 | If you would like to contribute to this project, please read: 85 | 86 | https://metacpan.org/pod/Zilla::Dist::Contributing 87 | 88 | for up-to-date instructions. 89 | 90 | 91 | 92 | 93 | 94 | # This file generated by Zilla-Dist-0.0.196 95 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | --- 2 | version: 0.87 3 | date: Tue Jul 18 14:05:40 PDT 2017 4 | changes: 5 | - Fix io($dir)->all when files have unicode in names (GH#95) 6 | - Stop trampling $! 7 | - Add cmp overload to fix some windows problems (GH#74) 8 | --- 9 | version: 0.86 10 | date: Thu Jan 1 18:44:25 PST 2015 11 | changes: 12 | - Revamp docs 13 | --- 14 | version: 0.85 15 | date: Mon Dec 15 08:34:09 CST 2014 16 | changes: 17 | - Fix copy tests on Windows 18 | --- 19 | version: 0.84 20 | date: Sun Dec 14 02:06:37 CST 2014 21 | changes: 22 | - Pass separator along when tie'ing (Fixes GH#52, Arthur Axel 'fREW' Schmidt) 23 | - Add ->copy method (Arthur Axel 'fREW' Schmidt) 24 | - Prefix private methods with underscores (Arthur Axel 'fREW' Schmidt) 25 | --- 26 | version: 0.83 27 | date: Sat Dec 13 01:00:16 CST 2014 28 | changes: 29 | - Allow passing an argument to ->relative (Arthur Axel 'fREW' Schmidt) 30 | --- 31 | version: 0.82 32 | date: Thu Nov 13 15:10:32 CST 2014 33 | changes: 34 | - Use bsd_glob for ::Dir->glob (Arthur Axel 'fREW' Schmidt) 35 | --- 36 | version: 0.81 37 | date: Wed Nov 5 18:18:25 PST 2014 38 | changes: 39 | - Fixed a doc formatting bug. 40 | --- 41 | version: 0.80 42 | date: Tue Nov 4 11:13:18 PST 2014 43 | changes: 44 | - Make the Role Call list link to their doc sections. 45 | --- 46 | version: 0.79 47 | date: Tue Sep 2 14:34:27 MDT 2014 48 | changes: 49 | - Doc enhancement. PR/51. @nheinric++ 50 | --- 51 | version: 0.78 52 | date: Thu Aug 28 11:56:36 PDT 2014 53 | changes: 54 | - Release to steal indexing back from Alt::IO::All::new. 55 | --- 56 | version: 0.77 57 | date: Tue Aug 26 12:37:29 PDT 2014 58 | changes: 59 | - Add new overloads from PR/49 @ginzel++ 60 | --- 61 | version: 0.76 62 | date: Tue Aug 19 16:21:05 PDT 2014 63 | changes: 64 | - Relplace tabs with spaces 65 | --- 66 | version: 0.75 67 | date: Sat Aug 16 16:41:13 PDT 2014 68 | changes: 69 | - Change testdir to t 70 | --- 71 | version: 0.74 72 | date: Sat Aug 16 16:03:33 PDT 2014 73 | changes: 74 | - Fix strict/warnings 75 | --- 76 | version: 0.73 77 | date: Sat Aug 16 15:35:55 PDT 2014 78 | changes: 79 | - Remove 'use 5.x.x' from code 80 | --- 81 | version: 0.72 82 | date: Sat Aug 16 11:19:00 PDT 2014 83 | changes: 84 | - Meta 0.0.2 85 | --- 86 | version: 0.71 87 | date: Sat Aug 16 03:45:11 PDT 2014 88 | changes: 89 | - Eliminate spurious trailing whitespace 90 | --- 91 | version: 0.70 92 | date: Sat Aug 16 02:08:08 PDT 2014 93 | changes: 94 | - Eliminate File::Basename from test/ 95 | --- 96 | version: 0.69 97 | date: Fri Aug 15 15:55:18 PDT 2014 98 | changes: 99 | - Add t/000-compile-modules.t 100 | - CPAN Day 2014 - 21 Release Salute! 101 | --- 102 | version: 0.68 103 | date: Sun Aug 10 08:56:08 PDT 2014 104 | changes: 105 | - PR/47. Doc fixes. @ginzel++ 106 | --- 107 | version: 0.67 108 | date: Sat Aug 2 11:58:01 PDT 2014 109 | changes: 110 | - Fix Copyright years. 111 | --- 112 | version: 0.66 113 | date: Wed Jul 16 23:39:38 PDT 2014 114 | changes: 115 | - Move doc to Swim 116 | - Fix Meta and add Contributing file 117 | --- 118 | version: 0.65 119 | date: Sat Jun 14 12:48:31 PDT 2014 120 | changes: 121 | - Support recommended modules again 122 | --- 123 | version: 0.64 124 | date: Sat Jun 14 12:33:21 PDT 2014 125 | changes: 126 | - New badge syntax 127 | - Changed the ABSTRACT 128 | --- 129 | version: 0.63 130 | date: Sun Jun 8 12:45:43 PDT 2014 131 | changes: 132 | - Add coveralls badge 133 | - Finish porting pod to kwim 134 | --- 135 | version: 0.62 136 | date: Sat Jun 7 13:36:32 PDT 2014 137 | changes: 138 | - Convert release to Zilla::Dist 139 | - Start converting doc to Kwim 140 | --- 141 | version: 0.61 142 | date: 143 | changes: 144 | - Fix GH#44 (Thanks Shlomi Fish!) 145 | --- 146 | version: 0.60 147 | date: 148 | changes: 149 | - Fix IO Layer situation (Thanks Mithaldu!) 150 | --- 151 | version: 0.59 152 | date: 153 | changes: 154 | - Fix possible infinite loop in t/accept.t (Thanks C. Wallace for complaining) 155 | (closes #42) 156 | - Fix yet another utf8 validation issue (Thanks Mithaldu for complaining) 157 | (closes #38) 158 | - Fix warnings running t/tie.t on windows (Thanks Mithaldu for complaining) 159 | (closes #37) 160 | --- 161 | version: 0.58 162 | date: 163 | changes: 164 | - Fix canonpath on MSWin32 165 | - Fix marking files as both binary and utf8 (Thanks Mithaldu!) (closes GH#36) 166 | --- 167 | version: 0.57 168 | date: 169 | changes: 170 | - Fix printing to a tie'd object, closes GH#26 (thanks Graham Knop for helping) 171 | - Fix tests if $^X ne 'perl', closes GH#35 (thanks Hugemeir for the report) 172 | --- 173 | version: 0.56 174 | date: 175 | changes: 176 | - Return realpath for canonpath when possible (closes GH#34) 177 | - Fix regression related to chaining dirs caused by making '' not become '/' 178 | - correctly check exists for ::File, ::Dir, and ::Link 179 | - RT#61627/GH#29 and Fix RT#82633/GH#32, thanks Graham Knop for helping 180 | - Some doc cleanup around the SYNOPSIS (Thanks Mithaldu) 181 | --- 182 | version: 0.55 183 | date: 184 | changes: 185 | - Change minimum perl version to 5.8.1, and thus remove dep for IO::String 186 | --- 187 | version: 0.54 188 | date: 189 | changes: 190 | - Remove mentions of unimplemented strict (Thanks Mithaldu, GH#15) 191 | - Allow testing on non SDBM DBM's (thanks Jerry D. Hedden) 192 | - Abandon RT in favor of GitHub Issues 193 | --- 194 | version: 0.53 195 | date: 196 | changes: 197 | - Make mkdir die if it fails (thanks Martyn Pearce for RT#61697) 198 | - Fix possible path test issues, esp in Win32 (Thanks Mithaldu) 199 | - Fix ->binary under -utf8 import mode (thanks T. Linden for RT#81224) 200 | - Validate UTF-8 in ->utf8 (thanks Ovid for RT#74642) 201 | - Consistently use :encoding($encoding) (thanks Bernardo Rechea for RT#68512) 202 | - Pass perms to mkpath in assert_dirpath (thanks Rob Kinyon for RT#53687) 203 | - Fix minor POD niggle (thanks Greg Skyles for RT#83798) 204 | - Remove broken test for ->mimetype (thanks Slaven Rezic for RT#91743) 205 | - Skip t/encoding.t for perls built without PerlIO::encoding (thanks 206 | Jerry D. Hedden for RT#26230) 207 | --- 208 | version: 0.52 209 | date: 210 | changes: 211 | - Add a fix for io->file("foobar")->assert (Shlomi Fish) 212 | - Make io->file('') not break on Windows systems (Roy Ivy III) 213 | - Fix dangling file handles in tests (Roy Ivy III) 214 | --- 215 | version: 0.51 216 | date: Mon Dec 30 13:55:00 CDT 2013 217 | changes: 218 | - Make '' not become / when using io->dir('') 219 | --- 220 | version: 0.50 221 | date: Fri Oct 18 13:08:41 PDT 2013 222 | changes: 223 | - Fix for rt87200 224 | --- 225 | version: 0.49 226 | date: Fri Oct 18 01:05:39 CDT 2013 227 | changes: 228 | - Fix various tests on Windows 229 | --- 230 | version: 0.48 231 | date: Tue Oct 8 01:45:39 CDT 2013 232 | changes: 233 | - Add ->os method to ::Filesys (Arthur Axel "fREW" Schmidt) 234 | --- 235 | version: 0.47 236 | date: Mon Sep 30 18:57:52 CDT 2013 237 | changes: 238 | - Add ->glob method to ::Dir (Arthur Axel "fREW" Schmidt) 239 | - Add list based constructors to ::Dir and ::File (Arthur Axel "fREW" Schmidt) 240 | - Add ->mimetype method to ::FileSys (Arthur Axel "fREW" Schmidt) 241 | - Add ->ext method to ::FileSys (Arthur Axel "fREW" Schmidt) 242 | - All tests should be parallelizable (Shlomi Fish) 243 | --- 244 | version: 0.46 245 | date: Wed Jul 25 17:35:44 PDT 2012 246 | changes: 247 | - Re-releasing to reclaim indexing from Alt-IO-All-new 248 | --- 249 | version: 0.45 250 | date: Wed Jul 18 22:15:04 EDT 2012 251 | changes: 252 | - Added an example for ->assert and fixed the \E warnings on 5.16, courtesy shlomi fish 253 | --- 254 | version: 0.44 255 | date: Wed Oct 5 18:11:27 EDT 2011 256 | changes: 257 | - Switch from testing $^V to $^] in DESTROY since $^V comparisons leak pre-5.14 (mst) 258 | --- 259 | version: 0.43 260 | date: Wed Jul 20 08:34:01 PDT 2011 261 | changes: 262 | - Fix directory scalar deref for mst++ 263 | --- 264 | version: 0.42 265 | date: Mon Jul 18 11:31:43 PDT 2011 266 | changes: 267 | - Doc work and tests by Shlomi Fish 268 | - Use Module::Package 269 | - Fix rt41819 270 | --- 271 | version: 0.41 272 | date: Mon Aug 16 22:33:45 PDT 2010 273 | changes: 274 | - Recent Test::More was triggering errors in file_spec.t. 275 | - Thanks to Torsten Raudssus for a fix. Getty++ 276 | --- 277 | version: 0.40 278 | date: Sun Aug 15 15:22:12 PDT 2010 279 | changes: 280 | - Fixed a bug in t/chdir.t 281 | --- 282 | version: 0.39 283 | date: Thu Dec 11 23:22:56 PST 2008 284 | changes: 285 | - Fix tests on 5.6. 286 | --- 287 | version: 0.38 288 | date: Mon Apr 9 10:52:44 JST 2007 289 | changes: 290 | - Add generic encoding, instead of just utf8. 291 | --- 292 | version: 0.37 293 | date: Fri Apr 6 18:04:27 JST 2007 294 | changes: 295 | - make catdir work with current dir in addition to other args. 296 | - make catfile work with current dir in addition to other args. 297 | - Add support for import flags like -strict and -utf8 298 | --- 299 | version: 0.36 300 | date: Mon Oct 16 14:48:58 PDT 2006 301 | changes: 302 | - Applied the patch from http://rt.cpan.org/Public/Bug/Display.html?id=20053 Made sure Carp is required and the sub Carp::carp is predeclared in IO/All.pm. 303 | --- 304 | version: 0.35 305 | date: Tue May 9 08:25:37 PDT 2006 306 | changes: 307 | - Remove dependency on XXX.pm *groan* 308 | --- 309 | version: 0.34 310 | date: Mon May 8 01:03:12 PDT 2006 311 | changes: 312 | - Remove dependency on Spiffy.pm 313 | - Apply patches and fix bugs from rt 314 | - rt tickets - 11552 12048 14184 12966 13879 17105 7448 11463 7410 7337 7527 315 | 18465 316 | --- 317 | version: 0.33 318 | date: Fri Dec 17 02:33:41 PST 2004 319 | changes: 320 | - Fixed some nagging problems with the tests 321 | --- 322 | version: 0.32 323 | date: Wed Dec 15 12:19:44 PST 2004 324 | changes: 325 | - io('path/to/symlink') would return a file object if the link was to a file. (Dave Rolsky) 326 | - $link->readlink incorrectly returned a new IO::All::Link object, no matter what the link pointed to. (Dave Rolsky) 327 | - io($io_all_object) would not return an object of the same type as the object give to io(), it would always return a plain IO::All object. (Dave Rolsky) 328 | - add head and tail methods 329 | --- 330 | version: 0.31 331 | date: Sun Aug 8 22:49:46 PDT 2004 332 | changes: 333 | - added readdir 334 | - let exists work on non-existant filename 335 | --- 336 | version: 0.31 337 | date: Sat Jul 24 20:19:10 PDT 2004 338 | changes: 339 | - absolute, relative, pathname 340 | - chdir 341 | - stat on unopened file/dir 342 | --- 343 | version: 0.30 344 | date: Mon Jul 19 11:23:15 PDT 2004 345 | changes: 346 | - Split module into several classes 347 | - Pluggable framework 348 | - file->all 349 | - ->touch 350 | - ->empty 351 | --- 352 | version: 0.22 353 | date: Tue Jun 1 11:20:17 PDT 2004 354 | changes: 355 | - Make tests pass on MSWin32 :P 356 | - Added exists method 357 | --- 358 | version: 0.21 359 | date: Sat May 29 12:45:00 PDT 2004 360 | changes: 361 | - Fixed buglets in sockets 362 | - Added Cookbook example for Tiny Web Server 363 | --- 364 | version: 0.20 365 | date: Thu May 27 01:46:04 PDT 2004 366 | changes: 367 | - Rewrote documentation 368 | - Refactored construction 369 | - File::Spec support 370 | - File::Path support 371 | - lots of new methods 372 | --- 373 | version: 0.19 374 | date: Mon May 24 17:02:24 PDT 2004 375 | changes: 376 | - DBM support 377 | - MLDBM support 378 | - chomp support 379 | - Fixed forking server zombie issues 380 | - Replaced flags with methods (-tie -fork -lock, etc) 381 | - Added chainable options `assert, chomp, deep, rdonly, rdwr, sort` 382 | - Fixed problems with perl-5.6.1 and Solaris 383 | --- 384 | version: 0.18 385 | date: Sun May 16 17:40:37 PDT 2004 386 | changes: 387 | - Get the shift out 388 | - Support DBM files as has overload 389 | - Add ->scalar() method 390 | - close orphaned socket on fork after accept 391 | - seek now opens file for read/write 392 | - polish subtle behaviour 393 | - added stat functions 394 | --- 395 | version: 0.17 396 | date: Fri May 7 01:14:36 PDT 2004 397 | changes: 398 | - File to File copy use File::Copy for speed 399 | --- 400 | version: 0.16 401 | date: Mon Mar 22 23:35:32 PST 2004 402 | changes: 403 | - Added tests for some subtleties 404 | - Added check_nmake to Makefile.PL 405 | --- 406 | version: 0.15 407 | date: Mon Mar 15 09:50:46 PST 2004 408 | changes: 409 | - Got things working on MSWin32 410 | - turned off lock.t on solaris and cygwin for now 411 | --- 412 | version: 0.14 413 | date: Mon Mar 15 00:19:21 PST 2004 414 | changes: 415 | - Added multiple dispatch overloading 416 | - Added Tie::File support 417 | --- 418 | version: 0.13 419 | date: Fri Mar 12 00:02:10 PST 2004 420 | changes: 421 | - Accidentally left debugging code in module. 422 | --- 423 | version: 0.12 424 | date: Tue Mar 2 21:50:05 PST 2004 425 | changes: 426 | - Require IO::String 427 | --- 428 | version: 0.11 429 | date: Tue Mar 2 09:21:39 PST 2004 430 | changes: 431 | - Depend on newer Spiffy 432 | --- 433 | version: 0.10 434 | date: Sat Feb 7 00:55:42 PST 2004 435 | changes: 436 | - Initial release. 437 | -------------------------------------------------------------------------------- /Meta: -------------------------------------------------------------------------------- 1 | =meta: 0.0.2 2 | 3 | name: IO-All 4 | version: 0.87 5 | abstract: IO::All to Larry Wall! 6 | homepage: https://metacpan.org/release/IO-All 7 | language: perl 8 | license: perl 9 | copyright: 2004-2017 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/io-all-pm 21 | bug: https://github.com/ingydotnet/io-all-pm/issues 22 | irc: irc.perl.org#io-all 23 | 24 | requires: 25 | perl: 5.8.1 26 | Cwd: 0 27 | Scalar::Util: 0 28 | 29 | recommends: 30 | File::ReadBackwards: 0 31 | File::MimeInfo: 0 32 | 33 | badge: travis 34 | see: 35 | - File::Spec 36 | - File::Path 37 | - File::ReadBackwards 38 | - File::MimeInfo 39 | - IO::Handle 40 | - IO::File 41 | - IO::Dir 42 | - IO::Socket 43 | - Tie::File 44 | -------------------------------------------------------------------------------- /doc/IO/All.swim: -------------------------------------------------------------------------------- 1 | <<>> 2 | 3 | = Synopsis 4 | 5 | First, some safe examples: 6 | 7 | use IO::All; 8 | 9 | # Some of the many ways to read a whole file into a scalar 10 | $contents = io->file('file.txt')->slurp; # Read an entire file 11 | @files = io->dir('lib')->all; # Get a list of files 12 | $tail = io->pipe('-| tail app.log'); # Open a pipe to a command 13 | $line = $tail->getline; # Read from the pipe 14 | 15 | That said, there are a lot more things that are very convenient and will help 16 | you write code very quickly, though they should be used judiciously: 17 | 18 | use IO::All; # Let the madness begin... 19 | 20 | # Some of the many ways to read a whole file into a scalar 21 | io('file.txt') > $contents; # Overloaded "arrow" 22 | $contents < io 'file.txt'; # Flipped but same operation 23 | $io = io 'file.txt'; # Create a new IO::All object 24 | $contents = $$io; # Overloaded scalar dereference 25 | $contents = $io->all; # A method to read everything 26 | $contents = $io->slurp; # Another method for that 27 | $contents = join '', $io->getlines; # Join the separate lines 28 | $contents = join '', map "$_\n", @$io; # Same. Overloaded array deref 29 | $io->tie; # Tie the object as a handle 30 | $contents = join '', <$io>; # And use it in builtins 31 | # and the list goes on ... 32 | 33 | # Other file operations: 34 | @lines = io('file.txt')->slurp; # List context slurp 35 | $content > io('file.txt'); # Print to a file 36 | io('file.txt')->print($content, $more); # (ditto) 37 | $content >> io('file.txt'); # Append to a file 38 | io('file.txt')->append($content); # (ditto) 39 | $content << $io; # Append to a string 40 | io('copy.txt') < io('file.txt'); $ Copy a file 41 | io('file.txt') > io('copy.txt'); # Invokes File::Copy 42 | io('more.txt') >> io('all.txt'); # Add on to a file 43 | io('dir/') < io('file.txt'); $ Copy a file to a directory 44 | io('file.txt') > io('dir/'); # Invokes File::Copy 45 | io('more.txt') >> io('dir/'); # Add on to a file in the dir 46 | 47 | # UTF-8 Support 48 | $contents = io('file.txt')->utf8->all; # Turn on utf8 49 | use IO::All -utf8; # Turn on utf8 for all io 50 | $contents = io('file.txt')->all; # by default in this package. 51 | 52 | # General Encoding Support 53 | $contents = io('file.txt')->encoding('big5')->all; 54 | use IO::All -encoding => 'big5'; # Turn on big5 for all io 55 | $contents = io('file.txt')->all; # by default in this package. 56 | 57 | # Print the path name of a file: 58 | print $io->name; # The direct method 59 | print "$io"; # Object stringifies to name 60 | print $io; # Quotes not needed here 61 | print $io->filename; # The file portion only 62 | $io->os('win32'); # change the object to be a 63 | # win32 path 64 | print $io->ext; # The file extension only 65 | print $io->mimetype; # The mimetype, requires a 66 | # working File::MimeType 67 | 68 | 69 | # Read all the files/directories in a directory: 70 | $io = io('my/directory/'); # Create new directory object 71 | @contents = $io->all; # Get all contents of dir 72 | @contents = @$io; # Directory as an array 73 | @contents = values %$io; # Directory as a hash 74 | push @contents, $subdir # One at a time 75 | while $subdir = $io->next; 76 | 77 | # Print the name and file type for all the contents above: 78 | print "$_ is a " . $_->type . "\n" # Each element of @contents 79 | for @contents; # is an IO::All object!! 80 | 81 | # Print first line of each file: 82 | print $_->getline # getline gets one line 83 | for io('dir')->all_files; # Files only 84 | 85 | # Print names of all files/dirs three directories deep: 86 | print "$_\n" for $io->all(3); # Pass in the depth. Default=1 87 | 88 | # Print names of all files/dirs recursively: 89 | print "$_\n" for $io->all(0); # Zero means all the way down 90 | print "$_\n" for $io->All; # Capitalized shortcut 91 | print "$_\n" for $io->deep->all; # Another way 92 | 93 | # There are some special file names: 94 | print io('-'); # Print STDIN to STDOUT 95 | io('-') > io('-'); # Do it again 96 | io('-') < io('-'); # Same. Context sensitive. 97 | "Bad puppy" > io('='); # Message to STDERR 98 | $string_file = io('$'); # Create string based filehandle 99 | $temp_file = io('?'); # Create a temporary file 100 | 101 | # Socket operations: 102 | $server = io('localhost:5555')->fork; # Create a daemon socket 103 | $connection = $server->accept; # Get a connection socket 104 | $input < $connection; # Get some data from it 105 | "Thank you!" > $connection; # Thank the caller 106 | $connection->close; # Hang up 107 | io(':6666')->accept->slurp > io->devnull; # Take a complaint and file it 108 | 109 | # DBM database operations: 110 | $dbm = io 'my/database'; # Create a database object 111 | print $dbm->{grocery_list}; # Hash context makes it a DBM 112 | $dbm->{todo} = $new_list; # Write to database 113 | $dbm->dbm('GDBM_file'); # Demand specific DBM 114 | io('mydb')->mldbm->{env} = \%ENV; # MLDBM support 115 | 116 | # Tie::File support: 117 | $io = io 'file.txt'; 118 | $io->[42] = 'Line Forty Three'; # Change a line 119 | print $io->[@$io / 2]; # Print middle line 120 | @$io = reverse @$io; # Reverse lines in a file 121 | 122 | # Stat functions: 123 | printf "%s %s %s\n", # Print name, uid and size of 124 | $_->name, $_->uid, $_->size # contents of current directory 125 | for io('.')->all; 126 | print "$_\n" for sort # Use mtime method to sort all 127 | {$b->mtime <=> $a->mtime} # files under current directory 128 | io('.')->All_Files; # by recent modification time. 129 | 130 | # File::Spec support: 131 | $contents < io->catfile(qw(dir file.txt)); # Portable IO operation 132 | 133 | # Miscellaneous: 134 | @lines = io('file.txt')->chomp->slurp; # Chomp as you slurp 135 | @chunks = 136 | io('file.txt')->separator('xxx')->slurp; # Use alternnate record sep 137 | $binary = io('file.bin')->binary->all; # Read a binary file 138 | io('a-symlink')->readlink->slurp; # Readlink returns an object 139 | print io('foo')->absolute->pathname; # Print absolute path of foo 140 | 141 | # IO::All External Plugin Methods 142 | io("myfile") > io->("ftp://store.org"); # Upload a file using ftp 143 | $html < io->http("www.google.com"); # Grab a web page 144 | io('mailto:worst@enemy.net')->print($spam); # Email a "friend" 145 | 146 | # This is just the beginning, read on... 147 | 148 | = Description 149 | 150 | IO::All combines all of the best Perl IO modules into a single nifty object 151 | oriented interface to greatly simplify your everyday Perl IO idioms. It 152 | exports a single function called `io`, which returns a new IO::All object. And 153 | that object can do it all! 154 | 155 | The IO::All object is a proxy for IO::File, IO::Dir, IO::Socket, Tie::File, 156 | File::Spec, File::Path, File::MimeInfo and File::ReadBackwards; as well as all 157 | the DBM and MLDBM modules. You can use most of the methods found in these 158 | classes and in IO::Handle (which they inherit from). IO::All adds dozens of 159 | other helpful idiomatic methods including file stat and manipulation 160 | functions. 161 | 162 | IO::All is pluggable, and modules like [IO::All::LWP] and [IO::All::Mailto] 163 | add even more functionality. Optionally, every IO::All object can be tied to 164 | itself. This means that you can use most perl IO builtins on it: readline, 165 | `<>`, getc, print, printf, syswrite, sysread, close. 166 | 167 | The distinguishing magic of IO::All is that it will automatically open (and 168 | close) files, directories, sockets and other IO things for you. You never need 169 | to specify the mode (`<`, `>>`, etc), since it is determined by the usage 170 | context. That means you can replace this: 171 | 172 | open STUFF, '<', './mystuff' 173 | or die "Can't open './mystuff' for input:\n$!"; 174 | local $/; 175 | my $stuff = ; 176 | close STUFF; 177 | 178 | with this: 179 | 180 | my $stuff < io './mystuff'; 181 | 182 | And that is a *good thing*! 183 | 184 | = Usage 185 | 186 | Normally just say: 187 | 188 | use IO::All; 189 | 190 | and IO::All will export a single function called `io`, which constructs all IO 191 | objects. 192 | 193 | == Note on `io` 194 | 195 | The `io` function is a /magic constructor/. It is easy to use and will usually 196 | do the right thing, but can also blow up easily. 197 | 198 | It takes a single optional argument and determines what type of IO::All 199 | subclass object to return. With no arguments it returns an `IO::All` object, 200 | which has no I/O methods, but has methods to construct subclass objects like 201 | `IO::All::File`. 202 | 203 | In other words, these 2 statements are usually the same: 204 | 205 | $content = io('file.txt')->all; 206 | $content = io->file('file.txt')->all; 207 | 208 | Use the first form when you are demonstrating your Perl virtues of laziness 209 | and impatience, and use the second form when your job is on the line. 210 | 211 | = Method role Call 212 | 213 | Here is an alphabetical list of all the public methods that you can call on an 214 | IO::All object. 215 | 216 | [/abs2rel], [/absolute], [/accept], [/All], [/all], [/All_Dirs], [/all_dirs], 217 | [/All_Files], [/all_files], [/All_Links], [/all_links], [/append], [/appendf], 218 | [/appendln], [/assert], [/atime], [/autoclose], [/autoflush], [/backwards], 219 | [/bcc], [/binary], [/binmode], [/blksize], [/blocks], [/block_size], 220 | [/buffer], [/canonpath], [/case_tolerant], [/catdir], [/catfile], [/catpath], 221 | [/cc], [/chdir], [/chomp], [/clear], [/close], [/confess], [/content], 222 | [/copy], [/ctime], [/curdir], [/dbm], [/deep], [/device], [/device_id], 223 | [/devnull], [/dir], [/domain], [/empty], [/ext], [/encoding], [/eof], 224 | [/errors], [/file], [/filename], [/fileno], [/filepath], [/filter], [/fork], 225 | [/from], [/ftp], [/get], [/getc], [/getline], [/getlines], [/gid], [/glob], 226 | [/handle], [/head], [/http], [/https], [/inode], [/io_handle], [/is_absolute], 227 | [/is_dir], [/is_dbm], [/is_executable], [/is_file], [/is_link], [/is_mldbm], 228 | [/is_open], [/is_pipe], [/is_readable], [/is_socket], [/is_stdio], 229 | [/is_string], [/is_temp], [/is_writable], [/join], [/length], [/link], 230 | [/lock], [/mailer], [/mailto], [/mimetype], [/mkdir], [/mkpath], [/mldbm], 231 | [/mode], [/modes], [/mtime], [/name], [/new], [/next], [/nlink], [/open], 232 | [/os] [/password], [/path], [/pathname], [/perms], [/pipe], [/port], [/print], 233 | [/printf], [/println], [/put], [/rdonly], [/rdwr], [/read], [/readdir], 234 | [/readlink], [/recv], [/rel2abs], [/relative], [/rename], [/request], 235 | [/response], [/rmdir], [/rmtree], [/rootdir], [/scalar], [/seek], [/send], 236 | [/separator], [/shutdown], [/size], [/slurp], [/socket], [/sort], [/splitdir], 237 | [/splitpath], [/stat], [/stdio], [/stderr], [/stdin], [/stdout], [/string], 238 | [/string_ref], [/subject], [/sysread], [/syswrite], [/tail], [/tell], [/temp], 239 | [/tie], [/tmpdir], [/to], [/touch], [/truncate], [/type], [/user], [/uid], 240 | [/unlink], [/unlock], [/updir], [/uri], [/utf8], [/utime] and [/write]. 241 | 242 | Each method is documented further below. 243 | 244 | = Operator Overloading 245 | 246 | IO::All objects overload a small set of Perl operators to great effect. The 247 | overloads are limited to `<`, `<<`, `>`, `>>`, dereferencing operations, and 248 | stringification. 249 | 250 | Even though relatively few operations are overloaded, there is actually a huge 251 | matrix of possibilities for magic. That's because the overloading is sensitive 252 | to the types, position and context of the arguments, and an IO::All object can 253 | be one of many types. 254 | 255 | The most important overload to become familiar with is stringification. 256 | IO::All objects stringify to their file or directory name. Here we print the 257 | contents of the current directory: 258 | 259 | perl -MIO::All -le 'print for io(".")->all' 260 | 261 | is the same as: 262 | 263 | perl -MIO::All -le 'print $_->name for io(".")->all' 264 | 265 | Stringification is important because it allows IO::All operations to return 266 | objects when they might otherwise return file names. Then the recipient can 267 | use the result either as an object or a string. 268 | 269 | `>` and `<` move data between objects in the direction pointed to by the 270 | operator. 271 | 272 | $content1 < io('file1'); 273 | $content1 > io('file2'); 274 | io('file2') > $content3; 275 | io('file3') < $content3; 276 | io('file3') > io('file4'); 277 | io('file5') < io('file4'); 278 | 279 | `>>` and `<<` do the same thing except the recipient string or file is 280 | appended to. 281 | 282 | An IO::All file used as an array reference becomes tied using Tie::File: 283 | 284 | $file = io "file"; 285 | # Print last line of file 286 | print $file->[-1]; 287 | # Insert new line in middle of file 288 | $file->[$#$file / 2] = 'New line'; 289 | 290 | An IO::All file used as a hash reference becomes tied to a DBM class: 291 | 292 | io('mydbm')->{ingy} = 'YAML'; 293 | 294 | An IO::All directory used as an array reference, will expose each file or 295 | subdirectory as an element of the array. 296 | 297 | print "$_\n" for @{io 'dir'}; 298 | 299 | IO::All directories used as hash references have file names as keys, and 300 | IO::All objects as values: 301 | 302 | print io('dir')->{'foo.txt'}->slurp; 303 | 304 | Files used as scalar references get slurped: 305 | 306 | print ${io('dir')->{'foo.txt'}}; 307 | 308 | Not all combinations of operations and object types are supported. Some just 309 | haven't been added yet, and some just don't make sense. If you use an invalid 310 | combination, an error will be thrown. 311 | 312 | = CookBook 313 | 314 | This section describes some various things that you can easily cook up with 315 | IO::All. 316 | 317 | == File Locking 318 | 319 | IO::All makes it very easy to lock files. Just use the `lock` method. Here's a 320 | standalone program that demonstrates locking for both write and read: 321 | 322 | use IO::All; 323 | my $io1 = io('myfile')->lock; 324 | $io1->println('line 1'); 325 | 326 | fork or do { 327 | my $io2 = io('myfile')->lock; 328 | print $io2->slurp; 329 | exit; 330 | }; 331 | 332 | sleep 1; 333 | $io1->println('line 2'); 334 | $io1->println('line 3'); 335 | $io1->unlock; 336 | 337 | There are a lot of subtle things going on here. An exclusive lock is issued 338 | for `$io1` on the first `println`. That's because the file isn't actually 339 | opened until the first IO operation. 340 | 341 | When the child process tries to read the file using `$io2`, there is a shared 342 | lock put on it. Since `$io1` has the exclusive lock, the slurp blocks. 343 | 344 | The parent process sleeps just to make sure the child process gets a chance. 345 | The parent needs to call `unlock` or `close` to release the lock. If all goes 346 | well the child will print 3 lines. 347 | 348 | == In-place Editing 349 | 350 | Because an IO::All object can be used as an array reference, operations 351 | on arrays are supported transparently (using Tie::File) so a file can be 352 | modified in the same way you would modify an array. 353 | 354 | > cat > x.txt 355 | The sexy saxophone, 356 | 357 | got the axe. 358 | ^d 359 | 360 | > perl -MIO::All -e 'map { s/x/X/g; $_ } @{ io(shift) }' x.txt 361 | > cat x.txt 362 | The seXy saXophone, 363 | 364 | got the aXe. 365 | 366 | This one liner uses shift() to grab the file from STDIN and create an io object 367 | that is dereferenced using @{ } and fed to map() like any perl array reference. 368 | 369 | == Round Robin 370 | 371 | This simple example will read lines from a file forever. When the last line is 372 | read, it will reopen the file and read the first one again. 373 | 374 | my $io = io 'file1.txt'; 375 | $io->autoclose(1); 376 | while (my $line = $io->getline || $io->getline) { 377 | print $line; 378 | } 379 | 380 | == Reading Backwards 381 | 382 | If you call the `backwards` method on an IO::All object, the `getline` and 383 | `getlines` will work in reverse. They will read the lines in the file from the 384 | end to the beginning. 385 | 386 | my @reversed; 387 | my $io = io('file1.txt'); 388 | $io->backwards; 389 | while (my $line = $io->getline) { 390 | push @reversed, $line; 391 | } 392 | 393 | or more simply: 394 | 395 | my @reversed = io('file1.txt')->backwards->getlines; 396 | 397 | The `backwards` method returns the IO::All object so that you can chain the 398 | calls. 399 | 400 | NOTE: This operation requires that you have the [File::ReadBackwards] module 401 | installed. 402 | 403 | == Client/Server Sockets 404 | 405 | IO::All makes it really easy to write a forking socket server and a client to 406 | talk to it. 407 | 408 | In this example, a server will return 3 lines of text, to every client that 409 | calls it. Here is the server code: 410 | 411 | use IO::All; 412 | 413 | my $socket = io(':12345')->fork->accept; 414 | $socket->print($_) while ; 415 | $socket->close; 416 | 417 | __DATA__ 418 | On your mark, 419 | Get set, 420 | Go! 421 | 422 | Here is the client code: 423 | 424 | use IO::All; 425 | 426 | my $io = io('localhost:12345'); 427 | print while $_ = $io->getline; 428 | 429 | You can run the server once, and then run the client repeatedly (in another 430 | terminal window). It should print the 3 data lines each time. 431 | 432 | Note that it is important to close the socket if the server is forking, or 433 | else the socket won't go out of scope and close. 434 | 435 | == A Tiny Web Server 436 | 437 | Here is how you could write a simplistic web server that works with static and 438 | dynamic pages: 439 | 440 | perl -MIO::All -e 'io(":8080")->fork->accept->(sub { $_[0] < io(-x $1 ? "./$1 |" : $1) if /^GET \/(.*) / })' 441 | 442 | There is are a lot of subtle things going on here. First we accept a socket 443 | and fork the server. Then we overload the new socket as a code ref. This code 444 | ref takes one argument, another code ref, which is used as a callback. 445 | 446 | The callback is called once for every line read on the socket. The line is put 447 | into `$_` and the socket itself is passed in to the callback. 448 | 449 | Our callback is scanning the line in `$_` for an HTTP GET request. If one is 450 | found it parses the file name into `$1`. Then we use `$1` to create an new 451 | IO::All file object... with a twist. If the file is executable (`-x`), then we 452 | create a piped command as our IO::All object. This somewhat approximates CGI 453 | support. 454 | 455 | Whatever the resulting object is, we direct the contents back at our socket 456 | which is in `$_[0]`. Pretty simple, eh? 457 | 458 | == DBM Files 459 | 460 | IO::All file objects used as a hash reference, treat the file as a DBM tied to 461 | a hash. Here I write my DB record to STDERR: 462 | 463 | io("names.db")->{ingy} > io('='); 464 | 465 | Since their are several DBM formats available in Perl, IO::All picks the first 466 | one of these that is installed on your system: 467 | 468 | DB_File GDBM_File NDBM_File ODBM_File SDBM_File 469 | 470 | You can override which DBM you want for each IO::All object: 471 | 472 | my @keys = keys %{io('mydbm')->dbm('SDBM_File')}; 473 | 474 | == File Subclassing 475 | 476 | Subclassing is easy with IO::All. Just create a new module and use IO::All as 477 | the base class, like this: 478 | 479 | package NewModule; 480 | use IO::All -base; 481 | 482 | You need to do it this way so that IO::All will export the `io` function. Here 483 | is a simple recipe for subclassing: 484 | 485 | IO::Dumper inherits everything from IO::All and adds an extra method called 486 | `dump`, which will dump a data structure to the file we specify in the `io` 487 | function. Since it needs Data::Dumper to do the dumping, we override the 488 | `open` method to `require Data::Dumper` and then pass control to the real 489 | `open`. 490 | 491 | First the code using the module: 492 | 493 | use IO::Dumper; 494 | 495 | io('./mydump')->dump($hash); 496 | 497 | And next the IO::Dumper module itself: 498 | 499 | package IO::Dumper; 500 | use IO::All -base; 501 | use Data::Dumper; 502 | 503 | sub dump { 504 | my $self = shift; 505 | Dumper(@_) > $self; 506 | } 507 | 508 | 1; 509 | 510 | == Inline Subclassing 511 | 512 | This recipe does the same thing as the previous one, but without needing to 513 | write a separate module. The only real difference is the first line. Since you 514 | don't "use" IO::Dumper, you need to still call its `import` method manually. 515 | 516 | IO::Dumper->import; 517 | io('./mydump')->dump($hash); 518 | 519 | package IO::Dumper; 520 | use IO::All -base; 521 | use Data::Dumper; 522 | 523 | sub dump { 524 | my $self = shift; 525 | Dumper(@_) > $self; 526 | } 527 | 528 | = The IO::All Methods 529 | 530 | This section gives a full description of all of the methods that you can call 531 | on IO::All objects. The methods have been grouped into subsections based on 532 | object construction, option settings, configuration, action methods and 533 | support for specific modules. 534 | 535 | == Object Construction and Initialization Methods 536 | 537 | - new 538 | 539 | There are three ways to create a new IO::All object. The first is with the 540 | special function `io` which really just calls `IO::All->new`. The second is 541 | by calling `new` as a class method. The third is calling `new` as an object 542 | instance method. In this final case, the new objects attributes are copied 543 | from the instance object. 544 | 545 | io(file-descriptor); 546 | IO::All->new(file-descriptor); 547 | $io->new(file-descriptor); 548 | 549 | All three forms take a single argument, a file descriptor. A file descriptor 550 | can be any of the following: 551 | 552 | - A file name 553 | - A file handle 554 | - A directory name 555 | - A directory handle 556 | - A typeglob reference 557 | - A piped shell command. eg '| ls -al' 558 | - A socket domain/port. eg 'perl.com:5678' 559 | - '-' means STDIN or STDOUT (depending on usage) 560 | - '=' means STDERR 561 | - '$' means an in memory filehandle object 562 | - '?' means a temporary file 563 | - A URI including: http, https, ftp and mailto 564 | - An IO::All object 565 | 566 | If you provide an IO::All object, you will simply get that /same object/ 567 | returned from the constructor. 568 | 569 | If no file descriptor is provided, an object will still be created, but it 570 | must be defined by one of the following methods before it can be used for 571 | I/O: 572 | 573 | - file 574 | 575 | io->file("path/to/my/file.txt"); 576 | 577 | Using the `file` method sets the type of the object to /file/ and sets the 578 | pathname of the file if provided. 579 | 580 | It might be important to use this method if you had a file whose name was 581 | `'-'`, or if the name might otherwise be confused with a directory or a 582 | socket. In this case, either of these statements would work the same: 583 | 584 | my $file = io('-')->file; 585 | my $file = io->file('-'); 586 | 587 | - dir 588 | 589 | io->dir($dir_name); 590 | 591 | Make the object be of type /directory/. 592 | 593 | - socket 594 | 595 | io->socket("${domain}:${port}"); 596 | 597 | Make the object be of type /socket/. 598 | 599 | - link 600 | 601 | io->link($link_name); 602 | 603 | Make the object be of type /link/. 604 | 605 | - pipe 606 | 607 | io->pipe($pipe_command); 608 | 609 | Make the object be of type /pipe/. The following three statements are 610 | equivalent: 611 | 612 | my $io = io('ls -l |'); 613 | my $io = io('ls -l')->pipe; 614 | my $io = io->pipe('ls -l'); 615 | 616 | - dbm 617 | 618 | This method takes the names of zero or more DBM modules. The first one that 619 | is available is used to process the dbm file. 620 | 621 | io('mydbm')->dbm('NDBM_File', 'SDBM_File')->{author} = 'ingy'; 622 | 623 | If no module names are provided, the first available of the following is 624 | used: 625 | 626 | DB_File GDBM_File NDBM_File ODBM_File SDBM_File 627 | 628 | - mldbm 629 | 630 | Similar to the `dbm` method, except create a Multi Level DBM object using 631 | the MLDBM module. 632 | 633 | This method takes the names of zero or more DBM modules and an optional 634 | serialization module. The first DBM module that is available is used to 635 | process the MLDBM file. The serialization module can be Data::Dumper, 636 | Storable or FreezeThaw. 637 | 638 | io('mymldbm')->mldbm('GDBM_File', 'Storable')->{author} = 639 | {nickname => 'ingy'}; 640 | 641 | - string 642 | 643 | Make the object be an in memory filehandle. These are equivalent: 644 | 645 | my $io = io('$'); 646 | my $io = io->string; 647 | 648 | - temp 649 | 650 | Make the object represent a temporary file. It will automatically be open 651 | for both read and write. 652 | 653 | - stdio 654 | 655 | Make the object represent either STDIN or STDOUT depending on how it is used 656 | subsequently. These are equivalent: 657 | 658 | my $io = io('-'); 659 | my $io = io->stdin; 660 | 661 | - stdin 662 | 663 | Make the object represent STDIN. 664 | 665 | - stdout 666 | 667 | Make the object represent STDOUT. 668 | 669 | - stderr 670 | 671 | Make the object represent STDERR. 672 | 673 | - handle 674 | 675 | io->handle($io_handle); 676 | 677 | Forces the object to be created from an pre-existing IO handle. You can 678 | chain calls together to indicate the type of handle: 679 | 680 | my $file_object = io->file->handle($file_handle); 681 | my $dir_object = io->dir->handle($dir_handle); 682 | 683 | - http 684 | 685 | Make the object represent an HTTP URI. Requires IO-All-LWP. 686 | 687 | - https 688 | 689 | Make the object represent an HTTPS URI. Requires IO-All-LWP. 690 | 691 | - ftp 692 | 693 | Make the object represent an FTP URI. Requires IO-All-LWP. 694 | 695 | - mailto 696 | 697 | Make the object represent a `mailto:` URI. Requires IO-All-Mailto. 698 | 699 | If you need to use the same options to create a lot of objects, and don't want 700 | to duplicate the code, just create a dummy object with the options you want, 701 | and use that object to spawn other objects. 702 | 703 | my $lt = io->lock->tie; 704 | ... 705 | my $io1 = $lt->new('file1'); 706 | my $io2 = $lt->new('file2'); 707 | 708 | Since the new method copies attributes from the calling object, both `$io1` 709 | and `$io2` will be locked and tied. 710 | 711 | == Option Setting Methods 712 | 713 | The following methods don't do any actual I/O, but they specify options about 714 | how the I/O should be done. 715 | 716 | Each option can take a single argument of 0 or 1. If no argument is given, the 717 | value 1 is assumed. Passing 0 turns the option off. 718 | 719 | All of these options return the object reference that was used to invoke them. 720 | This is so that the option methods can be chained together. For example: 721 | 722 | my $io = io('path/file')->tie->assert->chomp->lock; 723 | 724 | - absolute 725 | 726 | Indicates that the `pathname` for the object should be made absolute. 727 | 728 | # Print the full path of the current working directory 729 | # (like pwd). 730 | 731 | use IO::All; 732 | 733 | print io->curdir->absolute; 734 | 735 | - assert 736 | 737 | This method ensures that the path for a file or directory actually exists 738 | before the file is open. If the path does not exist, it is created. 739 | 740 | For example, here is a program called "create-cat-to" that outputs to a file 741 | that it creates. 742 | 743 | #!/usr/bin/perl 744 | 745 | # create-cat-to.pl 746 | # cat to a file that can be created. 747 | 748 | use strict; 749 | use warnings; 750 | 751 | use IO::All; 752 | 753 | my $filename = shift(@ARGV); 754 | 755 | # Create a file called $filename, including all leading components. 756 | io('-') > io->file($filename)->assert; 757 | 758 | Here's an example use of it: 759 | 760 | $ ls -l 761 | total 0 762 | $ echo "Hello World" | create-cat-to one/two/three/four.txt 763 | $ ls -l 764 | total 4 765 | drwxr-xr-x 3 shlomif shlomif 4096 2010-10-14 18:03 one/ 766 | $ cat one/two/three/four.txt 767 | Hello World 768 | $ 769 | 770 | - autoclose 771 | 772 | By default, IO::All will close an object opened for input when EOF is 773 | reached. By closing the handle early, one can immediately do other 774 | operations on the object without first having to close it. 775 | 776 | This option is on by default, so if you don't want this behaviour, say so 777 | like this: 778 | 779 | $io->autoclose(0); 780 | 781 | The object will then be closed when `$io` goes out of scope, or you manually 782 | call `$io->close`. 783 | 784 | - autoflush 785 | 786 | Proxy for IO::Handle::autoflush 787 | 788 | - backwards 789 | 790 | Sets the object to 'backwards' mode. All subsequent `getline` operations 791 | will read backwards from the end of the file. 792 | 793 | Requires the File::ReadBackwards CPAN module. 794 | 795 | - binary 796 | 797 | Adds `:raw` to the list of PerlIO layers applied after `open`, and applies 798 | it immediately on an open handle. 799 | 800 | - chdir 801 | 802 | chdir() to the pathname of a directory object. When object goes out of scope, 803 | chdir back to starting directory. 804 | 805 | - chomp 806 | 807 | Indicates that all operations that read lines should chomp the lines. If the 808 | `separator` method has been called, chomp will remove that value from the 809 | end of each record. 810 | 811 | Note that `chomp` may cause the following idiom to halt prematurely (e.g., 812 | if `separator` is `\n` (the default) and `chomp` is in effect, then this 813 | command will stop reading at the first blank line): 814 | 815 | while ( my $line = $io->getline ) {...} 816 | 817 | Try the following instead: 818 | 819 | while ( defined(my $line = $io->getline) ) {...} 820 | 821 | - confess 822 | 823 | Errors should be reported with the very detailed Carp::confess function. 824 | 825 | - deep 826 | 827 | Indicates that calls to the `all` family of methods should search 828 | directories as deep as possible. 829 | 830 | - fork 831 | 832 | Indicates that the process should automatically be forked inside the 833 | `accept` socket method. 834 | 835 | - lock 836 | 837 | Indicate that operations on an object should be locked using flock. 838 | 839 | - rdonly 840 | 841 | This option indicates that certain operations like DBM and Tie::File access 842 | should be done in read-only mode. 843 | 844 | - rdwr 845 | 846 | This option indicates that DBM and MLDBM files should be opened in 847 | read/write mode. 848 | 849 | - relative 850 | 851 | Indicates that the `pathname` for the object should be made relative. If 852 | passed an argument, path will be made relative to passed argument. 853 | 854 | - sort 855 | 856 | Indicates whether objects returned from one of the `all` methods will be in 857 | sorted order by name. True by default. 858 | 859 | - tie 860 | 861 | Indicate that the object should be tied to itself, thus allowing it to be 862 | used as a filehandle in any of Perl's builtin IO operations. 863 | 864 | my $io = io('foo')->tie; 865 | @lines = <$io>; 866 | 867 | - utf8 868 | 869 | Adds `:encoding(UTF-8)` to the list of PerlIO layers applied after `open`, 870 | and applies it immediately on an open handle. 871 | 872 | == Configuration Methods 873 | 874 | The following methods don't do any actual I/O, but they set specific values to 875 | configure the IO::All object. 876 | 877 | If these methods are passed no argument, they will return their current value. 878 | If arguments are passed they will be used to set the current value, and the 879 | object reference will be returned for potential method chaining. 880 | 881 | - bcc 882 | 883 | Set the Bcc field for a mailto object. 884 | 885 | - binmode 886 | 887 | Adds the specified layer to the list of PerlIO layers applied after `open`, 888 | and applies it immediately on an open handle. Does a bare `binmode` when 889 | called without argument. 890 | 891 | - block_size 892 | 893 | The default length to be used for `read` and `sysread` calls. Defaults to 894 | 1024. 895 | 896 | - buffer 897 | 898 | Returns a reference to the internal buffer, which is a scalar. You can use 899 | this method to set the buffer to a scalar of your choice. (You can just pass 900 | in the scalar, rather than a reference to it.) 901 | 902 | This is the buffer that `read` and `write` will use by default. 903 | 904 | You can easily have IO::All objects use the same buffer: 905 | 906 | my $input = io('abc'); 907 | my $output = io('xyz'); 908 | my $buffer; 909 | $output->buffer($input->buffer($buffer)); 910 | $output->write while $input->read; 911 | 912 | - cc 913 | 914 | Set the Cc field for a mailto object. 915 | 916 | - content 917 | 918 | Get or set the content for an LWP operation manually. 919 | 920 | - domain 921 | 922 | Set the domain name or ip address that a socket should use. 923 | 924 | - encoding 925 | 926 | Adds the specified encoding to the list of PerlIO layers applied after 927 | `open`, and applies it immediately on an open handle. Requires an argument. 928 | 929 | - errors 930 | 931 | Use this to set a subroutine reference that gets called when an internal 932 | error is thrown. 933 | 934 | - filter 935 | 936 | Use this to set a subroutine reference that will be used to grep which 937 | objects get returned on a call to one of the `all` methods. For example: 938 | 939 | my @odd = io->curdir->filter(sub {$_->size % 2})->All_Files; 940 | 941 | `@odd` will contain all the files under the current directory whose size is 942 | an odd number of bytes. 943 | 944 | - from 945 | 946 | Indicate the sender for a mailto object. 947 | 948 | - mailer 949 | 950 | Set the mailer program for a mailto transaction. Defaults to 'sendmail'. 951 | 952 | - mode 953 | 954 | Set the mode for which the file should be opened. Examples: 955 | 956 | $io->mode('>>')->open; 957 | $io->mode(O_RDONLY); 958 | 959 | my $log_appender = io->file('/var/log/my-application.log') 960 | ->mode('>>')->open(); 961 | 962 | $log_appender->print("Stardate 5987.6: Mission accomplished."); 963 | 964 | - name 965 | 966 | Set or get the name of the file or directory represented by the IO::All 967 | object. 968 | 969 | - password 970 | 971 | Set the password for an LWP transaction. 972 | 973 | - perms 974 | 975 | Sets the permissions to be used if the file/directory needs to be created. 976 | 977 | - port 978 | 979 | Set the port number that a socket should use. 980 | 981 | - request 982 | 983 | Manually specify the request object for an LWP transaction. 984 | 985 | - response 986 | 987 | Returns the resulting response object from an LWP transaction. 988 | 989 | - separator 990 | 991 | Sets the record (line) separator to whatever value you pass it. Default is 992 | `\n`. Affects the chomp setting too. 993 | 994 | - string_ref 995 | 996 | Returns a reference to the internal string that is acting like a file. 997 | 998 | - subject 999 | 1000 | Set the subject for a mailto transaction. 1001 | 1002 | - to 1003 | 1004 | Set the recipient address for a mailto request. 1005 | 1006 | - uri 1007 | 1008 | Direct access to the URI used in LWP transactions. 1009 | 1010 | - user 1011 | 1012 | Set the user name for an LWP transaction. 1013 | 1014 | == IO Action Methods 1015 | 1016 | These are the methods that actually perform I/O operations on an IO::All 1017 | object. The stat methods and the File::Spec methods are documented in separate 1018 | sections below. 1019 | 1020 | - accept 1021 | 1022 | For sockets. Opens a server socket (LISTEN => 1, REUSE => 1). Returns an 1023 | IO::All socket object that you are listening on. 1024 | 1025 | If the `fork` method was called on the object, the process will 1026 | automatically be forked for every connection. 1027 | 1028 | - all 1029 | 1030 | Read all contents into a single string. 1031 | 1032 | compare(io('file1')->all, io('file2')->all); 1033 | 1034 | - all (For directories) 1035 | 1036 | Returns a list of IO::All objects for all files and subdirectories in a 1037 | directory. 1038 | 1039 | '.' and '..' are excluded. 1040 | 1041 | Takes an optional argument telling how many directories deep to search. The 1042 | default is 1. Zero (0) means search as deep as possible. 1043 | 1044 | The filter method can be used to limit the results. 1045 | 1046 | The items returned are sorted by name unless `->sort(0)` is used. 1047 | 1048 | - All 1049 | 1050 | Same as `all(0)`. 1051 | 1052 | - all_dirs 1053 | 1054 | Same as `all`, but only return directories. 1055 | 1056 | - All_Dirs 1057 | 1058 | Same as `all_dirs(0)`. 1059 | 1060 | - all_files 1061 | 1062 | Same as `all`, but only return files. 1063 | 1064 | - All_Files 1065 | 1066 | Same as `all_files(0)`. 1067 | 1068 | - all_links 1069 | 1070 | Same as `all`, but only return links. 1071 | 1072 | - All_Links 1073 | 1074 | Same as `all_links(0)`. 1075 | 1076 | - append 1077 | 1078 | Same as print, but sets the file mode to '>>'. 1079 | 1080 | - appendf 1081 | 1082 | Same as printf, but sets the file mode to '>>'. 1083 | 1084 | - appendln 1085 | 1086 | Same as println, but sets the file mode to '>>'. 1087 | 1088 | - clear 1089 | 1090 | Clear the internal buffer. This method is called by `write` after it writes 1091 | the buffer. Returns the object reference for chaining. 1092 | 1093 | - close 1094 | 1095 | Close will basically unopen the object, which has different meanings for 1096 | different objects. For files and directories it will close and release the 1097 | handle. For sockets it calls shutdown. For tied things it unties them, and 1098 | it unlocks locked things. 1099 | 1100 | - copy 1101 | 1102 | Copies the object to the path passed. Works on both files and directories, 1103 | but directories require `File::Copy::Recursive` to be installed. 1104 | 1105 | - empty 1106 | 1107 | Returns true if a file exists but has no size, or if a directory exists but 1108 | has no contents. 1109 | 1110 | - eof 1111 | 1112 | Proxy for IO::Handle::eof 1113 | 1114 | - ext 1115 | 1116 | Returns the extension of the file. Can also be spelled as `extension` 1117 | 1118 | - exists 1119 | 1120 | Returns whether or not the file or directory exists. 1121 | 1122 | - filename 1123 | 1124 | Return the name portion of the file path in the object. For example: 1125 | 1126 | io('my/path/file.txt')->filename; 1127 | 1128 | would return `file.txt`. 1129 | 1130 | - fileno 1131 | 1132 | Proxy for IO::Handle::fileno 1133 | 1134 | - filepath 1135 | 1136 | Return the path portion of the file path in the object. For example: 1137 | 1138 | io('my/path/file.txt')->filepath; 1139 | 1140 | would return `my/path`. 1141 | 1142 | - get 1143 | 1144 | Perform an LWP GET request manually. 1145 | 1146 | - getc 1147 | 1148 | Proxy for IO::Handle::getc 1149 | 1150 | - getline 1151 | 1152 | Calls IO::File::getline. You can pass in an optional record separator. 1153 | 1154 | - getlines 1155 | 1156 | Calls IO::File::getlines. You can pass in an optional record separator. 1157 | 1158 | - glob 1159 | 1160 | Creates IO::All objects for the files matching the glob in the IO::All::Dir. 1161 | For example: 1162 | 1163 | io->dir($ENV{HOME})->glob('*.txt') 1164 | 1165 | - head 1166 | 1167 | Return the first 10 lines of a file. Takes an optional argument which is the 1168 | number of lines to return. Works as expected in list and scalar context. Is 1169 | subject to the current line separator. 1170 | 1171 | - io_handle 1172 | 1173 | Direct access to the actual IO::Handle object being used on an opened 1174 | IO::All object. 1175 | 1176 | - is_dir 1177 | 1178 | Returns boolean telling whether or not the IO::All object represents a 1179 | directory. 1180 | 1181 | - is_executable 1182 | 1183 | Returns true if file or directory is executable. 1184 | 1185 | - is_dbm 1186 | 1187 | Returns boolean telling whether or not the IO::All object represents a dbm 1188 | file. 1189 | 1190 | - is_file 1191 | 1192 | Returns boolean telling whether or not the IO::All object represents a file. 1193 | 1194 | - is_link 1195 | 1196 | Returns boolean telling whether or not the IO::All object represents a 1197 | symlink. 1198 | 1199 | - is_mldbm 1200 | 1201 | Returns boolean telling whether or not the IO::All object represents a mldbm 1202 | file. 1203 | 1204 | - is_open 1205 | 1206 | Indicates whether the IO::All is currently open for input/output. 1207 | 1208 | - is_pipe 1209 | 1210 | Returns boolean telling whether or not the IO::All object represents a pipe 1211 | operation. 1212 | 1213 | - is_readable 1214 | 1215 | Returns true if file or directory is readable. 1216 | 1217 | - is_socket 1218 | 1219 | Returns boolean telling whether or not the IO::All object represents a 1220 | socket. 1221 | 1222 | - is_stdio 1223 | 1224 | Returns boolean telling whether or not the IO::All object represents a STDIO 1225 | file handle. 1226 | 1227 | - is_string 1228 | 1229 | Returns boolean telling whether or not the IO::All object represents an in 1230 | memory filehandle. 1231 | 1232 | - is_temp 1233 | 1234 | Returns boolean telling whether or not the IO::All object represents a 1235 | temporary file. 1236 | 1237 | - is_writable 1238 | 1239 | Returns true if file or directory is writable. Can also be spelled as 1240 | `is_writeable`. 1241 | 1242 | - length 1243 | 1244 | Return the length of the internal buffer. 1245 | 1246 | - mimetype 1247 | 1248 | Return the mimetype of the file. 1249 | 1250 | Requires a working installation of the [File::MimeInfo] CPAN module. 1251 | 1252 | - mkdir 1253 | 1254 | Create the directory represented by the object. 1255 | 1256 | - mkpath 1257 | 1258 | Create the directory represented by the object, when the path contains more 1259 | than one directory that doesn't exist. Proxy for File::Path::mkpath. 1260 | 1261 | - next 1262 | 1263 | For a directory, this will return a new IO::All object for each file or 1264 | subdirectory in the directory. Return undef on EOD. 1265 | 1266 | - open 1267 | 1268 | Open the IO::All object. Takes two optional arguments `mode` and `perms`, 1269 | which can also be set ahead of time using the `mode` and `perms` methods. 1270 | 1271 | NOTE: Normally you won't need to call open (or mode/perms), since this 1272 | happens automatically for most operations. 1273 | 1274 | - os 1275 | 1276 | Change the object's os representation. Valid options are: `win32`, `unix`, 1277 | `vms`, `mac`, `os2`. 1278 | 1279 | - pathname 1280 | 1281 | Return the absolute or relative pathname for a file or directory, depending 1282 | on whether object is in `absolute` or `relative` mode. 1283 | 1284 | - print 1285 | 1286 | Proxy for IO::Handle::print 1287 | 1288 | - printf 1289 | 1290 | Proxy for IO::Handle::printf 1291 | 1292 | - println 1293 | 1294 | Same as print, but adds newline to each argument unless it already ends with 1295 | one. 1296 | 1297 | - put 1298 | 1299 | Perform an LWP PUT request manually. 1300 | 1301 | - read 1302 | 1303 | This method varies depending on its context. Read carefully (no pun 1304 | intended). 1305 | 1306 | For a file, this will proxy IO::File::read. This means you must pass it a 1307 | buffer, a length to read, and optionally a buffer offset for where to put 1308 | the data that is read. The function returns the length actually read (which 1309 | is zero at EOF). 1310 | 1311 | If you don't pass any arguments for a file, IO::All will use its own 1312 | internal buffer, a default length, and the offset will always point at the 1313 | end of the buffer. The buffer can be accessed with the `buffer` method. The 1314 | length can be set with the `block_size` method. The default length is 1024 1315 | bytes. The `clear` method can be called to clear the buffer. 1316 | 1317 | For a directory, this will proxy IO::Dir::read. 1318 | 1319 | - readdir 1320 | 1321 | Similar to the Perl `readdir` builtin. In scalar context, return the next 1322 | directory entry (ie file or directory name), or undef on end of directory. 1323 | In list context, return all directory entries. 1324 | 1325 | Note that `readdir` does not return the special `.` and `..` entries. 1326 | 1327 | - readline 1328 | 1329 | Same as `getline`. 1330 | 1331 | - readlink 1332 | 1333 | Calls Perl's readlink function on the link represented by the object. 1334 | Instead of returning the file path, it returns a new IO::All object using 1335 | the file path. 1336 | 1337 | - recv 1338 | 1339 | Proxy for IO::Socket::recv 1340 | 1341 | - rename 1342 | 1343 | my $new = $io->rename('new-name'); 1344 | 1345 | Calls Perl's rename function and returns an IO::All object for the renamed 1346 | file. Returns false if the rename failed. 1347 | 1348 | - rewind 1349 | 1350 | Proxy for IO::Dir::rewind 1351 | 1352 | - rmdir 1353 | 1354 | Delete the directory represented by the IO::All object. 1355 | 1356 | - rmtree 1357 | 1358 | Delete the directory represented by the IO::All object and all the files and 1359 | directories beneath it. Proxy for File::Path::rmtree. 1360 | 1361 | - scalar 1362 | 1363 | Deprecated. Same as `all()`. 1364 | 1365 | - seek 1366 | 1367 | Proxy for IO::Handle::seek. If you use seek on an unopened file, it will be 1368 | opened for both read and write. 1369 | 1370 | - send 1371 | 1372 | Proxy for IO::Socket::send 1373 | 1374 | - shutdown 1375 | 1376 | Proxy for IO::Socket::shutdown 1377 | 1378 | - slurp 1379 | 1380 | Read all file content in one operation. Returns the file content as a 1381 | string. In list context returns every line in the file. 1382 | 1383 | - stat 1384 | 1385 | Proxy for IO::Handle::stat 1386 | 1387 | - sysread 1388 | 1389 | Proxy for IO::Handle::sysread 1390 | 1391 | - syswrite 1392 | 1393 | Proxy for IO::Handle::syswrite 1394 | 1395 | - tail 1396 | 1397 | Return the last 10 lines of a file. Takes an optional argument which is the 1398 | number of lines to return. Works as expected in list and scalar context. Is 1399 | subject to the current line separator. 1400 | 1401 | - tell 1402 | 1403 | Proxy for IO::Handle::tell 1404 | 1405 | - throw 1406 | 1407 | This is an internal method that gets called whenever there is an error. It 1408 | could be useful to override it in a subclass, to provide more control in 1409 | error handling. 1410 | 1411 | - touch 1412 | 1413 | Update the atime and mtime values for a file or directory. Creates an empty 1414 | file if the file does not exist. 1415 | 1416 | - truncate 1417 | 1418 | Proxy for IO::Handle::truncate 1419 | 1420 | - type 1421 | 1422 | Returns a string indicated the type of io object. Possible values are: 1423 | 1424 | file 1425 | dir 1426 | link 1427 | socket 1428 | string 1429 | pipe 1430 | 1431 | Returns undef if type is not determinable. 1432 | 1433 | - unlink 1434 | 1435 | Unlink (delete) the file represented by the IO::All object. 1436 | 1437 | NOTE: You can unlink a file after it is open, and continue using it until it 1438 | is closed. 1439 | 1440 | - unlock 1441 | 1442 | Release a lock from an object that used the `lock` method. 1443 | 1444 | - utime 1445 | 1446 | Proxy for the utime Perl function. 1447 | 1448 | - write 1449 | 1450 | Opposite of `read` for file operations only. 1451 | 1452 | NOTE: When used with the automatic internal buffer, `write` will clear the 1453 | buffer after writing it. 1454 | 1455 | == Stat Methods 1456 | 1457 | This methods get individual values from a stat call on the file, directory or 1458 | handle represented by the IO::All object. 1459 | 1460 | - atime 1461 | 1462 | Last access time in seconds since the epoch 1463 | 1464 | - blksize 1465 | 1466 | Preferred block size for file system I/O 1467 | 1468 | - blocks 1469 | 1470 | Actual number of blocks allocated 1471 | 1472 | - ctime 1473 | 1474 | Inode change time in seconds since the epoch 1475 | 1476 | - device 1477 | 1478 | Device number of filesystem 1479 | 1480 | - device_id 1481 | 1482 | Device identifier for special files only 1483 | 1484 | - gid 1485 | 1486 | Numeric group id of file's owner 1487 | 1488 | - inode 1489 | 1490 | Inode number 1491 | 1492 | - modes 1493 | 1494 | File mode - type and permissions 1495 | 1496 | - mtime 1497 | 1498 | Last modify time in seconds since the epoch 1499 | 1500 | - nlink 1501 | 1502 | Number of hard links to the file 1503 | 1504 | - size 1505 | 1506 | Total size of file in bytes 1507 | 1508 | - uid 1509 | 1510 | Numeric user id of file's owner 1511 | 1512 | == File::Spec Methods 1513 | 1514 | These methods are all adaptations from File::Spec. Each method actually does 1515 | call the matching File::Spec method, but the arguments and return values 1516 | differ slightly. Instead of being file and directory *names*, they are IO::All 1517 | *objects*. Since IO::All objects stringify to their names, you can generally 1518 | use the methods just like File::Spec. 1519 | 1520 | - abs2rel 1521 | 1522 | Returns the relative path for the absolute path in the IO::All object. Can 1523 | take an optional argument indicating the base path. 1524 | 1525 | - canonpath 1526 | 1527 | Returns the canonical path for the IO::All object. The canonical path is 1528 | the fully resolved path if the file exists, so any symlinks will be 1529 | resolved. 1530 | 1531 | - case_tolerant 1532 | 1533 | Returns 0 or 1 indicating whether the file system is case tolerant. Since 1534 | an active IO::All object is not needed for this function, you can code it 1535 | like: 1536 | 1537 | IO::All->case_tolerant; 1538 | 1539 | or more simply: 1540 | 1541 | io->case_tolerant; 1542 | 1543 | - catdir 1544 | 1545 | Concatenate the directory components together, and return a new IO::All 1546 | object representing the resulting directory. 1547 | 1548 | - catfile 1549 | 1550 | Concatenate the directory and file components together, and return a new 1551 | IO::All object representing the resulting file. 1552 | 1553 | my $contents = io->catfile(qw(dir subdir file))->slurp; 1554 | 1555 | This is a very portable way to read `dir/subdir/file`. 1556 | 1557 | - catpath 1558 | 1559 | Concatenate the volume, directory and file components together, and return a 1560 | new IO::All object representing the resulting file. 1561 | 1562 | - curdir 1563 | 1564 | Returns an IO::All object representing the current directory. 1565 | 1566 | - devnull 1567 | 1568 | Returns an IO::All object representing the `/dev/null` file. 1569 | 1570 | - is_absolute 1571 | 1572 | Returns 0 or 1 indicating whether the `name` field of the IO::All object is 1573 | an absolute path. 1574 | 1575 | - join 1576 | 1577 | Same as `catfile`. 1578 | 1579 | - path 1580 | 1581 | Returns a list of IO::All directory objects for each directory in your path. 1582 | 1583 | - rel2abs 1584 | 1585 | Returns the absolute path for the relative path in the IO::All object. Can 1586 | take an optional argument indicating the base path. 1587 | 1588 | - rootdir 1589 | 1590 | Returns an IO::All object representing the root directory on your file 1591 | system. 1592 | 1593 | - splitdir 1594 | 1595 | Returns a list of the directory components of a path in an IO::All object. 1596 | 1597 | - splitpath 1598 | 1599 | Returns a volume directory and file component of a path in an IO::All 1600 | object. 1601 | 1602 | - tmpdir 1603 | 1604 | Returns an IO::All object representing a temporary directory on your file 1605 | system. 1606 | 1607 | - updir 1608 | 1609 | Returns an IO::All object representing the current parent directory. 1610 | 1611 | = Operational Notes 1612 | 1613 | - Reblessing 1614 | 1615 | Each IO::All object gets reblessed into an IO::All::* object as soon as 1616 | IO::All can determine what type of object it should be. Sometimes it gets 1617 | reblessed more than once: 1618 | 1619 | my $io = io('mydbm.db'); 1620 | $io->dbm('DB_File'); 1621 | $io->{foo} = 'bar'; 1622 | 1623 | In the first statement, $io has a reference value of 'IO::All::File', if 1624 | `mydbm.db` exists. In the second statement, the object is reblessed into 1625 | class 'IO::All::DBM'. 1626 | 1627 | - Auto-Open 1628 | 1629 | An IO::All object will automatically be opened as soon as there is enough 1630 | contextual information to know what type of object it is, and what mode it 1631 | should be opened for. This is usually when the first read or write operation 1632 | is invoked but might be sooner. 1633 | 1634 | - Auto-Mode 1635 | 1636 | The mode for an object to be opened with is determined heuristically unless 1637 | specified explicitly. 1638 | 1639 | - Auto-Close 1640 | 1641 | For input, IO::All objects will automatically be closed after EOF (or EOD). 1642 | For output, the object closes when it goes out of scope. 1643 | 1644 | To keep input objects from closing at EOF, do this: 1645 | 1646 | $io->autoclose(0); 1647 | 1648 | - Explicit open and close 1649 | 1650 | You can always call `open` and `close` explicitly, if you need that level of 1651 | control. To test if an object is currently open, use the `is_open` method. 1652 | 1653 | - Overload 1654 | 1655 | Overloaded operations return the target object, if one exists. 1656 | 1657 | This would set `$xxx` to the IO::All object: 1658 | 1659 | my $xxx = $contents > io('file.txt'); 1660 | 1661 | While this would set `$xxx` to the content string: 1662 | 1663 | my $xxx = $contents < io('file.txt'); 1664 | 1665 | = Stability 1666 | 1667 | The goal of the IO::All project is to continually refine the module to be as 1668 | simple and consistent to use as possible. Therefore, in the early stages of 1669 | the project, I will not hesitate to break backwards compatibility with other 1670 | versions of IO::All if I can find an easier and clearer way to do a particular 1671 | thing. 1672 | 1673 | IO is tricky stuff. There is definitely more work to be done. On the other 1674 | hand, this module relies heavily on very stable existing IO modules; so it may 1675 | work fairly well. 1676 | 1677 | I am sure you will find many unexpected "features". Please send all problems, 1678 | ideas and suggestions to ingy@cpan.org. 1679 | 1680 | == Known Bugs and Deficiencies 1681 | 1682 | Not all possible combinations of objects and methods have been tested. There 1683 | are many many combinations. All of the examples have been tested. If you find 1684 | a bug with a particular combination of calls, let me know. 1685 | 1686 | If you call a method that does not make sense for a particular object, the 1687 | result probably won't make sense. Little attempt is made to check for improper 1688 | usage. 1689 | 1690 | = Credits 1691 | 1692 | A lot of people have sent in suggestions, that have become a part of IO::All. 1693 | Thank you. 1694 | 1695 | Special thanks to Ian Langworth for continued testing and patching. 1696 | 1697 | Thank you Simon Cozens for tipping me off to the overloading possibilities. 1698 | 1699 | Finally, thanks to Autrijus Tang, for always having one more good idea. 1700 | 1701 | (It seems IO::All of it to a lot of people!) 1702 | 1703 | = Repository and Community 1704 | 1705 | The IO::All module can be found on CPAN and on GitHub: 1706 | [http://github.com/ingydotnet/io-all-pm]. 1707 | 1708 | Please join the IO::All discussion on #io-all on irc.perl.org. 1709 | 1710 | <<>> 1711 | -------------------------------------------------------------------------------- /doc/IO/All/DBM.swim: -------------------------------------------------------------------------------- 1 | IO::All::DBM 2 | ============ 3 | 4 | DBM Support for IO::All 5 | 6 | = Synopsis 7 | 8 | See [IO::All]. 9 | 10 | = Description 11 | 12 | <<>> 13 | -------------------------------------------------------------------------------- /doc/IO/All/Dir.swim: -------------------------------------------------------------------------------- 1 | IO::All::Dir 2 | ============ 3 | 4 | Directory Support for IO::All 5 | 6 | = Synopsis 7 | 8 | See [IO::All]. 9 | 10 | = Description 11 | 12 | <<>> 13 | -------------------------------------------------------------------------------- /doc/IO/All/File.swim: -------------------------------------------------------------------------------- 1 | IO::All::File 2 | ============= 3 | 4 | File Support for IO::All 5 | 6 | = Synopsis 7 | 8 | See [IO::All]. 9 | 10 | = Description 11 | 12 | <<>> 13 | -------------------------------------------------------------------------------- /doc/IO/All/Filesys.swim: -------------------------------------------------------------------------------- 1 | IO::All::Filesys 2 | ================ 3 | 4 | File System Methods Mixin for IO::All 5 | 6 | = Synopsis 7 | 8 | See [IO::All]. 9 | 10 | = Description 11 | 12 | <<>> 13 | -------------------------------------------------------------------------------- /doc/IO/All/Link.swim: -------------------------------------------------------------------------------- 1 | IO::All::Link 2 | ============= 3 | 4 | Link Support for IO::All 5 | 6 | = Synopsis 7 | 8 | See [IO::All]. 9 | 10 | = Description 11 | 12 | <<>> 13 | -------------------------------------------------------------------------------- /doc/IO/All/MLDBM.swim: -------------------------------------------------------------------------------- 1 | IO::All::MLDBM 2 | ============== 3 | 4 | MLDBM Support for IO::All 5 | 6 | = Synopsis 7 | 8 | See [IO::All]. 9 | 10 | = Description 11 | 12 | <<>> 13 | -------------------------------------------------------------------------------- /doc/IO/All/Pipe.swim: -------------------------------------------------------------------------------- 1 | IO::All::Pipe 2 | ============= 3 | 4 | Pipe Support for IO::All 5 | 6 | = Synopsis 7 | 8 | See [IO::All]. 9 | 10 | = Description 11 | 12 | <<>> 13 | -------------------------------------------------------------------------------- /doc/IO/All/STDIO.swim: -------------------------------------------------------------------------------- 1 | IO::All::STDIO 2 | ============== 3 | 4 | STDIO Support for IO::All 5 | 6 | = Synopsis 7 | 8 | See [IO::All]. 9 | 10 | = Description 11 | 12 | <<>> 13 | -------------------------------------------------------------------------------- /doc/IO/All/Socket.swim: -------------------------------------------------------------------------------- 1 | IO::All::Socket 2 | =============== 3 | 4 | Socket Support for IO::All 5 | 6 | = Synopsis 7 | 8 | See [IO::All]. 9 | 10 | = Description 11 | 12 | <<>> 13 | -------------------------------------------------------------------------------- /doc/IO/All/String.swim: -------------------------------------------------------------------------------- 1 | IO::All::String 2 | =============== 3 | 4 | String Support for IO::All 5 | 6 | = Synopsis 7 | 8 | See [IO::All]. 9 | 10 | = Description 11 | 12 | <<>> 13 | -------------------------------------------------------------------------------- /doc/IO/All/Temp.swim: -------------------------------------------------------------------------------- 1 | IO::All::Temp 2 | ============= 3 | 4 | Temporary File Support for IO::All 5 | 6 | = Synopsis 7 | 8 | See [IO::All]. 9 | 10 | = Description 11 | 12 | <<>> 13 | -------------------------------------------------------------------------------- /eg/create-cat-to.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # create-cat-to.pl 4 | # cat to a file that can be created. 5 | 6 | use strict; 7 | use warnings; 8 | 9 | use IO::All; 10 | 11 | my $filename = shift(@ARGV); 12 | 13 | # Create a file called $filename, including all leading components. 14 | io('-') > io->file($filename)->assert; 15 | -------------------------------------------------------------------------------- /lib/IO/All.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package IO::All; 3 | our $VERSION = '0.87'; 4 | 5 | require Carp; 6 | # So one can use Carp::carp "$message" - without the parenthesis. 7 | sub Carp::carp; 8 | 9 | use IO::All::Base -base; 10 | 11 | use File::Spec(); 12 | use Symbol(); 13 | use Fcntl; 14 | use Cwd (); 15 | 16 | our @EXPORT = qw(io); 17 | 18 | #=============================================================================== 19 | # Object creation and setup methods 20 | #=============================================================================== 21 | my $autoload = { 22 | qw( 23 | touch file 24 | 25 | dir_handle dir 26 | All dir 27 | all_files dir 28 | All_Files dir 29 | all_dirs dir 30 | All_Dirs dir 31 | all_links dir 32 | All_Links dir 33 | mkdir dir 34 | mkpath dir 35 | next dir 36 | 37 | stdin stdio 38 | stdout stdio 39 | stderr stdio 40 | 41 | socket_handle socket 42 | accept socket 43 | shutdown socket 44 | 45 | readlink link 46 | symlink link 47 | ) 48 | }; 49 | 50 | # XXX - These should die if the given argument exists but is not a 51 | # link, dbm, etc. 52 | sub link { require IO::All::Link; goto &IO::All::Link::link; } 53 | sub dbm { require IO::All::DBM; goto &IO::All::DBM::dbm; } 54 | sub mldbm { require IO::All::MLDBM; goto &IO::All::MLDBM::mldbm; } 55 | 56 | sub autoload { my $self = shift; $autoload; } 57 | 58 | sub AUTOLOAD { 59 | my $self = shift; 60 | my $method = $IO::All::AUTOLOAD; 61 | $method =~ s/.*:://; 62 | my $pkg = ref($self) || $self; 63 | $self->throw(qq{Can't locate object method "$method" via package "$pkg"}) 64 | if $pkg ne $self->_package; 65 | my $class = $self->_autoload_class($method); 66 | my $foo = "$self"; 67 | bless $self, $class; 68 | $self->$method(@_); 69 | } 70 | 71 | sub _autoload_class { 72 | my $self = shift; 73 | my $method = shift; 74 | my $class_id = $self->autoload->{$method} || $method; 75 | my $ucfirst_class_name = 'IO::All::' . ucfirst($class_id); 76 | my $ucfirst_class_fn = "IO/All/" . ucfirst($class_id) . ".pm"; 77 | return $ucfirst_class_name if $INC{$ucfirst_class_fn}; 78 | return "IO::All::\U$class_id" if $INC{"IO/All/\U$class_id\E.pm"}; 79 | require IO::All::Temp; 80 | if (eval "require $ucfirst_class_name; 1") { 81 | my $class = $ucfirst_class_name; 82 | my $return = $class->can('new') 83 | ? $class 84 | : do { # (OS X hack) 85 | my $value = $INC{$ucfirst_class_fn}; 86 | delete $INC{$ucfirst_class_fn}; 87 | $INC{"IO/All/\U$class_id\E.pm"} = $value; 88 | "IO::All::\U$class_id"; 89 | }; 90 | return $return; 91 | } 92 | elsif (eval "require IO::All::\U$class_id; 1") { 93 | return "IO::All::\U$class_id"; 94 | } 95 | $self->throw("Can't find a class for method '$method'"); 96 | } 97 | 98 | sub new { 99 | my $self = shift; 100 | my $package = ref($self) || $self; 101 | my $new = bless Symbol::gensym(), $package; 102 | $new->_package($package); 103 | $new->_copy_from($self) if ref($self); 104 | my $name = shift; 105 | return $name if UNIVERSAL::isa($name, 'IO::All'); 106 | return $new->_init unless defined $name; 107 | return $new->handle($name) 108 | if UNIVERSAL::isa($name, 'GLOB') or ref(\ $name) eq 'GLOB'; 109 | # WWW - link is first because a link to a dir returns true for 110 | # both -l and -d. 111 | return $new->link($name) if -l $name; 112 | return $new->file($name) if -f $name; 113 | return $new->dir($name) if -d $name; 114 | return $new->$1($name) if $name =~ /^([a-z]{3,8}):/; 115 | return $new->socket($name) if $name =~ /^[\w\-\.]*:\d{1,5}$/; 116 | return $new->pipe($name) if $name =~ s/^\s*\|\s*// or $name =~ s/\s*\|\s*$//; 117 | return $new->string if $name eq '$'; 118 | return $new->stdio if $name eq '-'; 119 | return $new->stderr if $name eq '='; 120 | return $new->temp if $name eq '?'; 121 | $new->name($name); 122 | $new->_init; 123 | } 124 | 125 | sub _copy_from { 126 | my $self = shift; 127 | my $other = shift; 128 | for (keys(%{*$other})) { 129 | # XXX Need to audit exclusions here 130 | next if /^(_handle|io_handle|is_open)$/; 131 | *$self->{$_} = *$other->{$_}; 132 | } 133 | } 134 | 135 | sub handle { 136 | my $self = shift; 137 | $self->_handle(shift) if @_; 138 | return $self->_init; 139 | } 140 | 141 | #=============================================================================== 142 | # Overloading support 143 | #=============================================================================== 144 | my $old_warn_handler = $SIG{__WARN__}; 145 | $SIG{__WARN__} = sub { 146 | if ($_[0] !~ /^Useless use of .+ \(.+\) in void context/) { 147 | goto &$old_warn_handler if $old_warn_handler; 148 | warn(@_); 149 | } 150 | }; 151 | 152 | use overload '""' => '_overload_stringify'; 153 | use overload '|' => '_overload_bitwise_or'; 154 | use overload '<<' => '_overload_left_bitshift'; 155 | use overload '>>' => '_overload_right_bitshift'; 156 | use overload '<' => '_overload_less_than'; 157 | use overload '>' => '_overload_greater_than'; 158 | use overload 'cmp' => '_overload_cmp'; 159 | use overload '${}' => '_overload_string_deref'; 160 | use overload '@{}' => '_overload_array_deref'; 161 | use overload '%{}' => '_overload_hash_deref'; 162 | use overload '&{}' => '_overload_code_deref'; 163 | 164 | sub _overload_bitwise_or { shift->_overload_handler(@_, '|' ); } 165 | sub _overload_left_bitshift { shift->_overload_handler(@_, '<<'); } 166 | sub _overload_right_bitshift { shift->_overload_handler(@_, '>>'); } 167 | sub _overload_less_than { shift->_overload_handler(@_, '<' ); } 168 | sub _overload_greater_than { shift->_overload_handler(@_, '>' ); } 169 | sub _overload_string_deref { shift->_overload_handler(@_, '${}'); } 170 | sub _overload_array_deref { shift->_overload_handler(@_, '@{}'); } 171 | sub _overload_hash_deref { shift->_overload_handler(@_, '%{}'); } 172 | sub _overload_code_deref { shift->_overload_handler(@_, '&{}'); } 173 | 174 | sub _overload_handler { 175 | my ($self) = @_; 176 | my $method = $self->_get_overload_method(@_); 177 | $self->$method(@_); 178 | } 179 | 180 | my $op_swap = { 181 | '>' => '<', '>>' => '<<', 182 | '<' => '>', '<<' => '>>', 183 | }; 184 | 185 | sub _overload_table { 186 | my $self = shift; 187 | ( 188 | '* > *' => '_overload_any_to_any', 189 | '* < *' => '_overload_any_from_any', 190 | '* >> *' => '_overload_any_addto_any', 191 | '* << *' => '_overload_any_addfrom_any', 192 | 193 | '* < scalar' => '_overload_scalar_to_any', 194 | '* > scalar' => '_overload_any_to_scalar', 195 | '* << scalar' => '_overload_scalar_addto_any', 196 | '* >> scalar' => '_overload_any_addto_scalar', 197 | ) 198 | }; 199 | 200 | sub _get_overload_method { 201 | my ($self, $arg1, $arg2, $swap, $operator) = @_; 202 | if ($swap) { 203 | $operator = $op_swap->{$operator} || $operator; 204 | } 205 | my $arg1_type = $self->_get_argument_type($arg1); 206 | my $table1 = { $arg1->_overload_table }; 207 | 208 | if ($operator =~ /\{\}$/) { 209 | my $key = "$operator $arg1_type"; 210 | return $table1->{$key} || $self->_overload_undefined($key); 211 | } 212 | 213 | my $arg2_type = $self->_get_argument_type($arg2); 214 | my @table2 = UNIVERSAL::isa($arg2, "IO::All") 215 | ? ($arg2->_overload_table) 216 | : (); 217 | my $table = { %$table1, @table2 }; 218 | 219 | my @keys = ( 220 | "$arg1_type $operator $arg2_type", 221 | "* $operator $arg2_type", 222 | ); 223 | push @keys, "$arg1_type $operator *", "* $operator *" 224 | unless $arg2_type =~ /^(scalar|array|hash|code|ref)$/; 225 | 226 | for (@keys) { 227 | return $table->{$_} 228 | if defined $table->{$_}; 229 | } 230 | 231 | return $self->_overload_undefined($keys[0]); 232 | } 233 | 234 | sub _get_argument_type { 235 | my $self = shift; 236 | my $argument = shift; 237 | my $ref = ref($argument); 238 | return 'scalar' unless $ref; 239 | return 'code' if $ref eq 'CODE'; 240 | return 'array' if $ref eq 'ARRAY'; 241 | return 'hash' if $ref eq 'HASH'; 242 | return 'ref' unless $argument->isa('IO::All'); 243 | $argument->file 244 | if defined $argument->pathname and not $argument->type; 245 | return $argument->type || 'unknown'; 246 | } 247 | 248 | sub _overload_cmp { 249 | my ($self, $other, $swap) = @_; 250 | $self = defined($self) ? $self.'' : $self; 251 | ($self, $other) = ($other, $self) if $swap; 252 | $self cmp $other; 253 | } 254 | 255 | sub _overload_stringify { 256 | my $self = shift; 257 | my $name = $self->pathname; 258 | return defined($name) ? $name : overload::StrVal($self); 259 | } 260 | 261 | sub _overload_undefined { 262 | my $self = shift; 263 | require Carp; 264 | my $key = shift; 265 | Carp::carp "Undefined behavior for overloaded IO::All operation: '$key'" 266 | if $^W; 267 | return '_overload_noop'; 268 | } 269 | 270 | sub _overload_noop { 271 | my $self = shift; 272 | return; 273 | } 274 | 275 | sub _overload_any_addfrom_any { 276 | $_[1]->append($_[2]->all); 277 | $_[1]; 278 | } 279 | 280 | sub _overload_any_addto_any { 281 | $_[2]->append($_[1]->all); 282 | $_[2]; 283 | } 284 | 285 | sub _overload_any_from_any { 286 | $_[1]->close if $_[1]->is_file and $_[1]->is_open; 287 | $_[1]->print($_[2]->all); 288 | $_[1]; 289 | } 290 | 291 | sub _overload_any_to_any { 292 | $_[2]->close if $_[2]->is_file and $_[2]->is_open; 293 | $_[2]->print($_[1]->all); 294 | $_[2]; 295 | } 296 | 297 | sub _overload_any_to_scalar { 298 | $_[2] = $_[1]->all; 299 | } 300 | 301 | sub _overload_any_addto_scalar { 302 | $_[2] .= $_[1]->all; 303 | $_[2]; 304 | } 305 | 306 | sub _overload_scalar_addto_any { 307 | $_[1]->append($_[2]); 308 | $_[1]; 309 | } 310 | 311 | sub _overload_scalar_to_any { 312 | local $\; 313 | $_[1]->close if $_[1]->is_file and $_[1]->is_open; 314 | $_[1]->print($_[2]); 315 | $_[1]; 316 | } 317 | 318 | #=============================================================================== 319 | # Private Accessors 320 | #=============================================================================== 321 | field '_package'; 322 | field _strict => undef; 323 | field _layers => []; 324 | field _handle => undef; 325 | field _constructor => undef; 326 | field _partial_spec_class => undef; 327 | 328 | #=============================================================================== 329 | # Public Accessors 330 | #=============================================================================== 331 | chain block_size => 1024; 332 | chain errors => undef; 333 | field io_handle => undef; 334 | field is_open => 0; 335 | chain mode => undef; 336 | chain name => undef; 337 | chain perms => undef; 338 | chain separator => $/; 339 | field type => ''; 340 | 341 | sub _spec_class { 342 | my $self = shift; 343 | 344 | my $ret = 'File::Spec'; 345 | if (my $partial = $self->_partial_spec_class(@_)) { 346 | $ret .= '::' . $partial; 347 | eval "require $ret"; 348 | } 349 | 350 | return $ret 351 | } 352 | 353 | sub pathname {my $self = shift; $self->name(@_) } 354 | 355 | #=============================================================================== 356 | # Chainable option methods (write only) 357 | #=============================================================================== 358 | option 'assert'; 359 | option 'autoclose' => 1; 360 | option 'backwards'; 361 | option 'chomp'; 362 | option 'confess'; 363 | option 'lock'; 364 | option 'rdonly'; 365 | option 'rdwr'; 366 | option 'strict'; 367 | 368 | #=============================================================================== 369 | # IO::Handle proxy methods 370 | #=============================================================================== 371 | proxy 'autoflush'; 372 | proxy 'eof'; 373 | proxy 'fileno'; 374 | proxy 'stat'; 375 | proxy 'tell'; 376 | proxy 'truncate'; 377 | 378 | #=============================================================================== 379 | # IO::Handle proxy methods that open the handle if needed 380 | #=============================================================================== 381 | proxy_open print => '>'; 382 | proxy_open printf => '>'; 383 | proxy_open sysread => O_RDONLY; 384 | proxy_open syswrite => O_CREAT | O_WRONLY; 385 | proxy_open seek => $^O eq 'MSWin32' ? '<' : '+<'; 386 | proxy_open 'getc'; 387 | 388 | #=============================================================================== 389 | # Tie Interface 390 | #=============================================================================== 391 | sub tie { my $self = shift; tie *$self, $self; } 392 | 393 | sub TIEHANDLE { 394 | return $_[0] if ref $_[0]; 395 | my $class = shift; 396 | my $self = bless Symbol::gensym(), $class; 397 | $self->init(@_); 398 | } 399 | 400 | sub READLINE { 401 | goto &getlines if wantarray; 402 | goto &getline; 403 | } 404 | 405 | 406 | sub DESTROY { 407 | my $self = shift; 408 | no warnings; 409 | unless ( $] < 5.008 ) { 410 | untie *$self if tied *$self; 411 | } 412 | $self->close if $self->is_open; 413 | } 414 | 415 | sub BINMODE { my $self = shift; CORE::binmode *$self->io_handle; } 416 | 417 | { 418 | no warnings; 419 | *GETC = \&getc; 420 | *PRINT = \&print; 421 | *PRINTF = \&printf; 422 | *READ = \&read; 423 | *WRITE = \&write; 424 | *SEEK = \&seek; 425 | *TELL = \&getpos; 426 | *EOF = \&eof; 427 | *CLOSE = \&close; 428 | *FILENO = \&fileno; 429 | } 430 | 431 | #=============================================================================== 432 | # File::Spec Interface 433 | #=============================================================================== 434 | sub canonpath { 435 | my $self = shift; 436 | eval { Cwd::abs_path($self->pathname); 0 } || 437 | File::Spec->canonpath($self->pathname) 438 | } 439 | 440 | sub catdir { 441 | my $self = shift; 442 | my @args = grep defined, $self->name, @_; 443 | $self->_constructor->()->dir(File::Spec->catdir(@args)); 444 | } 445 | sub catfile { 446 | my $self = shift; 447 | my @args = grep defined, $self->name, @_; 448 | $self->_constructor->()->file(File::Spec->catfile(@args)); 449 | } 450 | sub join { shift->catfile(@_); } 451 | sub curdir { shift->_constructor->()->dir(File::Spec->curdir); } 452 | sub devnull { shift->_constructor->()->file(File::Spec->devnull); } 453 | sub rootdir { shift->_constructor->()->dir(File::Spec->rootdir); } 454 | sub tmpdir { shift->_constructor->()->dir(File::Spec->tmpdir); } 455 | sub updir { shift->_constructor->()->dir(File::Spec->updir); } 456 | sub case_tolerant{File::Spec->case_tolerant; } 457 | sub is_absolute { File::Spec->file_name_is_absolute(shift->pathname); } 458 | sub path { my $self = shift; map { $self->_constructor->()->dir($_) } File::Spec->path; } 459 | sub splitpath { File::Spec->splitpath(shift->pathname); } 460 | sub splitdir { File::Spec->splitdir(shift->pathname); } 461 | sub catpath { my $self=shift; $self->_constructor->(File::Spec->catpath(@_)); } 462 | sub abs2rel { File::Spec->abs2rel(shift->pathname, @_); } 463 | sub rel2abs { File::Spec->rel2abs(shift->pathname, @_); } 464 | 465 | #=============================================================================== 466 | # Public IO Action Methods 467 | #=============================================================================== 468 | sub absolute { 469 | my $self = shift; 470 | $self->pathname(File::Spec->rel2abs($self->pathname)) 471 | unless $self->is_absolute; 472 | $self->is_absolute(1); 473 | return $self; 474 | } 475 | 476 | sub all { 477 | my $self = shift; 478 | $self->_assert_open('<'); 479 | local $/; 480 | my $all = $self->io_handle->getline; 481 | $self->_error_check; 482 | $self->_autoclose && $self->close; 483 | return $all; 484 | } 485 | 486 | sub append { 487 | my $self = shift; 488 | $self->_assert_open('>>'); 489 | $self->print(@_); 490 | } 491 | 492 | sub appendln { 493 | my $self = shift; 494 | $self->_assert_open('>>'); 495 | $self->println(@_); 496 | } 497 | 498 | sub binary { 499 | my $self = shift; 500 | CORE::binmode($self->io_handle) if $self->is_open; 501 | push @{$self->_layers}, ":raw"; 502 | return $self; 503 | } 504 | 505 | sub binmode { 506 | my $self = shift; 507 | my $layer = shift; 508 | $self->_sane_binmode($layer) if $self->is_open; 509 | push @{$self->_layers}, $layer; 510 | return $self; 511 | } 512 | 513 | sub _sane_binmode { 514 | my ($self, $layer) = @_; 515 | $layer 516 | ? CORE::binmode($self->io_handle, $layer) 517 | : CORE::binmode($self->io_handle); 518 | } 519 | 520 | sub buffer { 521 | my $self = shift; 522 | if (not @_) { 523 | *$self->{buffer} = do {my $x = ''; \ $x} 524 | unless exists *$self->{buffer}; 525 | return *$self->{buffer}; 526 | } 527 | my $buffer_ref = ref($_[0]) ? $_[0] : \ $_[0]; 528 | $$buffer_ref = '' unless defined $$buffer_ref; 529 | *$self->{buffer} = $buffer_ref; 530 | return $self; 531 | } 532 | 533 | sub clear { 534 | my $self = shift; 535 | my $buffer = *$self->{buffer}; 536 | $$buffer = ''; 537 | return $self; 538 | } 539 | 540 | sub close { 541 | my $self = shift; 542 | return unless $self->is_open; 543 | $self->is_open(0); 544 | my $io_handle = $self->io_handle; 545 | $self->io_handle(undef); 546 | $self->mode(undef); 547 | $io_handle->close(@_) 548 | if defined $io_handle; 549 | return $self; 550 | } 551 | 552 | sub empty { 553 | my $self = shift; 554 | my $message = 555 | "Can't call empty on an object that is neither file nor directory"; 556 | $self->throw($message); 557 | } 558 | 559 | sub exists {my $self = shift; -e $self->pathname } 560 | 561 | sub getline { 562 | my $self = shift; 563 | return $self->getline_backwards 564 | if $self->_backwards; 565 | $self->_assert_open('<'); 566 | my $line; 567 | { 568 | local $/ = @_ ? shift(@_) : $self->separator; 569 | $line = $self->io_handle->getline; 570 | chomp($line) if $self->_chomp and defined $line; 571 | } 572 | $self->_error_check; 573 | return $line if defined $line; 574 | $self->close if $self->_autoclose; 575 | return undef; 576 | } 577 | 578 | sub getlines { 579 | my $self = shift; 580 | return $self->getlines_backwards 581 | if $self->_backwards; 582 | $self->_assert_open('<'); 583 | my @lines; 584 | { 585 | local $/ = @_ ? shift(@_) : $self->separator; 586 | @lines = $self->io_handle->getlines; 587 | if ($self->_chomp) { 588 | chomp for @lines; 589 | } 590 | } 591 | $self->_error_check; 592 | return @lines if @lines; 593 | $self->close if $self->_autoclose; 594 | return (); 595 | } 596 | 597 | sub is_dir { UNIVERSAL::isa(shift, 'IO::All::Dir'); } 598 | sub is_dbm { UNIVERSAL::isa(shift, 'IO::All::DBM'); } 599 | sub is_file { UNIVERSAL::isa(shift, 'IO::All::File'); } 600 | sub is_link { UNIVERSAL::isa(shift, 'IO::All::Link'); } 601 | sub is_mldbm { UNIVERSAL::isa(shift, 'IO::All::MLDBM'); } 602 | sub is_socket { UNIVERSAL::isa(shift, 'IO::All::Socket'); } 603 | sub is_stdio { UNIVERSAL::isa(shift, 'IO::All::STDIO'); } 604 | sub is_string { UNIVERSAL::isa(shift, 'IO::All::String'); } 605 | sub is_temp { UNIVERSAL::isa(shift, 'IO::All::Temp'); } 606 | sub length { length ${shift->buffer}; } 607 | 608 | sub open { 609 | my $self = shift; 610 | return $self if $self->is_open; 611 | $self->is_open(1); 612 | my ($mode, $perms) = @_; 613 | $self->mode($mode) if defined $mode; 614 | $self->mode('<') unless defined $self->mode; 615 | $self->perms($perms) if defined $perms; 616 | my @args; 617 | unless ($self->is_dir) { 618 | push @args, $self->mode; 619 | push @args, $self->perms if defined $self->perms; 620 | } 621 | if (defined $self->pathname and not $self->type) { 622 | $self->file; 623 | return $self->open(@args); 624 | } 625 | elsif (defined $self->_handle and 626 | not $self->io_handle->opened 627 | ) { 628 | # XXX Not tested 629 | $self->io_handle->fdopen($self->_handle, @args); 630 | } 631 | $self->_set_binmode; 632 | } 633 | 634 | sub println { 635 | my $self = shift; 636 | $self->print(map {/\n\z/ ? ($_) : ($_, "\n")} @_); 637 | } 638 | 639 | sub read { 640 | my $self = shift; 641 | $self->_assert_open('<'); 642 | my $length = (@_ or $self->type eq 'dir') 643 | ? $self->io_handle->read(@_) 644 | : $self->io_handle->read( 645 | ${$self->buffer}, 646 | $self->block_size, 647 | $self->length, 648 | ); 649 | $self->_error_check; 650 | return $length || $self->_autoclose && $self->close && 0; 651 | } 652 | 653 | { 654 | no warnings; 655 | *readline = \&getline; 656 | } 657 | 658 | # deprecated 659 | sub scalar { 660 | my $self = shift; 661 | $self->all(@_); 662 | } 663 | 664 | sub slurp { 665 | my $self = shift; 666 | my $slurp = $self->all; 667 | return $slurp unless wantarray; 668 | my $separator = $self->separator; 669 | if ($self->_chomp) { 670 | local $/ = $separator; 671 | map {chomp; $_} split /(?<=\Q$separator\E)/, $slurp; 672 | } 673 | else { 674 | split /(?<=\Q$separator\E)/, $slurp; 675 | } 676 | } 677 | 678 | sub utf8 { 679 | my $self = shift; 680 | if ($] < 5.008) { 681 | die "IO::All -utf8 not supported on Perl older than 5.8"; 682 | } 683 | $self->encoding('UTF-8'); 684 | return $self; 685 | } 686 | 687 | sub _has_utf8 { 688 | grep { $_ eq ':encoding(UTF-8)' } @{shift->_layers} 689 | } 690 | 691 | sub encoding { 692 | my $self = shift; 693 | my $encoding = shift; 694 | if ($] < 5.008) { 695 | die "IO::All -encoding not supported on Perl older than 5.8"; 696 | } 697 | die "No valid encoding string sent" if !$encoding; 698 | $self->_set_encoding($encoding) if $self->is_open and $encoding; 699 | push @{$self->_layers}, ":encoding($encoding)"; 700 | return $self; 701 | } 702 | 703 | sub _set_encoding { 704 | my ($self, $encoding) = @_; 705 | return CORE::binmode($self->io_handle, ":encoding($encoding)"); 706 | } 707 | 708 | sub write { 709 | my $self = shift; 710 | $self->_assert_open('>'); 711 | my $length = @_ 712 | ? $self->io_handle->write(@_) 713 | : $self->io_handle->write(${$self->buffer}, $self->length); 714 | $self->_error_check; 715 | $self->clear unless @_; 716 | return $length; 717 | } 718 | 719 | #=============================================================================== 720 | # Implementation methods. Subclassable. 721 | #=============================================================================== 722 | sub throw { 723 | my $self = shift; 724 | require Carp; 725 | ; 726 | return &{$self->errors}(@_) 727 | if $self->errors; 728 | return Carp::confess(@_) 729 | if $self->_confess; 730 | return Carp::croak(@_); 731 | } 732 | 733 | #=============================================================================== 734 | # Private instance methods 735 | #=============================================================================== 736 | sub _assert_dirpath { 737 | my $self = shift; 738 | my $dir_name = shift; 739 | return $dir_name if ((! CORE::length($dir_name)) or 740 | -d $dir_name or 741 | CORE::mkdir($dir_name, $self->perms || 0755) or 742 | do { 743 | require File::Path; 744 | File::Path::mkpath($dir_name, 0, $self->perms || 0755 ); 745 | } or 746 | $self->throw("Can't make $dir_name")); 747 | } 748 | 749 | sub _assert_open { 750 | my $self = shift; 751 | return if $self->is_open; 752 | $self->file unless $self->type; 753 | return $self->open(@_); 754 | } 755 | 756 | sub _error_check { 757 | my $self = shift; 758 | my $saved_error = $!; 759 | return unless $self->io_handle->can('error'); 760 | return unless $self->io_handle->error; 761 | $self->throw($saved_error); 762 | } 763 | 764 | sub _set_binmode { 765 | my $self = shift; 766 | $self->_sane_binmode($_) for @{$self->_layers}; 767 | return $self; 768 | } 769 | 770 | #=============================================================================== 771 | # Stat Methods 772 | #=============================================================================== 773 | BEGIN { 774 | no strict 'refs'; 775 | my @stat_fields = qw( 776 | device inode modes nlink uid gid device_id size atime mtime 777 | ctime blksize blocks 778 | ); 779 | foreach my $stat_field_idx (0 .. $#stat_fields) 780 | { 781 | my $idx = $stat_field_idx; 782 | my $name = $stat_fields[$idx]; 783 | 784 | *$name = sub { 785 | my $self = shift; 786 | return (stat($self->io_handle || $self->pathname))[$idx]; 787 | }; 788 | } 789 | } 790 | 791 | -------------------------------------------------------------------------------- /lib/IO/All/Base.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package IO::All::Base; 3 | 4 | use Fcntl; 5 | 6 | sub import { 7 | my $class = shift; 8 | my $flag = $_[0] || ''; 9 | my $package = caller; 10 | no strict 'refs'; 11 | if ($flag eq '-base') { 12 | push @{$package . "::ISA"}, $class; 13 | *{$package . "::$_"} = \&$_ 14 | for qw'field const option chain proxy proxy_open'; 15 | } 16 | elsif ($flag eq -mixin) { 17 | mixin_import(scalar(caller(0)), $class, @_); 18 | } 19 | else { 20 | my @flags = @_; 21 | for my $export (@{$class . '::EXPORT'}) { 22 | *{$package . "::$export"} = $export eq 'io' 23 | ? $class->_generate_constructor(@flags) 24 | : \&{$class . "::$export"}; 25 | } 26 | } 27 | } 28 | 29 | sub _generate_constructor { 30 | my $class = shift; 31 | my (@flags, %flags, $key); 32 | for (@_) { 33 | if (s/^-//) { 34 | push @flags, $_; 35 | $flags{$_} = 1; 36 | $key = $_; 37 | } 38 | else { 39 | $flags{$key} = $_ if $key; 40 | } 41 | } 42 | my $constructor; 43 | $constructor = sub { 44 | my $self = $class->new(@_); 45 | for (@flags) { 46 | $self->$_($flags{$_}); 47 | } 48 | $self->_constructor($constructor); 49 | return $self; 50 | } 51 | } 52 | 53 | sub _init { 54 | my $self = shift; 55 | $self->io_handle(undef); 56 | $self->is_open(0); 57 | return $self; 58 | } 59 | 60 | #=============================================================================== 61 | # Closure generating functions 62 | #=============================================================================== 63 | sub option { 64 | my $package = caller; 65 | my ($field, $default) = @_; 66 | $default ||= 0; 67 | field("_$field", $default); 68 | no strict 'refs'; 69 | *{"${package}::$field"} = 70 | sub { 71 | my $self = shift; 72 | *$self->{"_$field"} = @_ ? shift(@_) : 1; 73 | return $self; 74 | }; 75 | } 76 | 77 | sub chain { 78 | my $package = caller; 79 | my ($field, $default) = @_; 80 | no strict 'refs'; 81 | *{"${package}::$field"} = 82 | sub { 83 | my $self = shift; 84 | if (@_) { 85 | *$self->{$field} = shift; 86 | return $self; 87 | } 88 | return $default unless exists *$self->{$field}; 89 | return *$self->{$field}; 90 | }; 91 | } 92 | 93 | sub field { 94 | my $package = caller; 95 | my ($field, $default) = @_; 96 | no strict 'refs'; 97 | return if defined &{"${package}::$field"}; 98 | *{"${package}::$field"} = 99 | sub { 100 | my $self = shift; 101 | unless (exists *$self->{$field}) { 102 | *$self->{$field} = 103 | ref($default) eq 'ARRAY' ? [] : 104 | ref($default) eq 'HASH' ? {} : 105 | $default; 106 | } 107 | return *$self->{$field} unless @_; 108 | *$self->{$field} = shift; 109 | }; 110 | } 111 | 112 | sub const { 113 | my $package = caller; 114 | my ($field, $default) = @_; 115 | no strict 'refs'; 116 | return if defined &{"${package}::$field"}; 117 | *{"${package}::$field"} = sub { $default }; 118 | } 119 | 120 | sub proxy { 121 | my $package = caller; 122 | my ($proxy) = @_; 123 | no strict 'refs'; 124 | return if defined &{"${package}::$proxy"}; 125 | *{"${package}::$proxy"} = 126 | sub { 127 | my $self = shift; 128 | my @return = $self->io_handle->$proxy(@_); 129 | $self->_error_check; 130 | wantarray ? @return : $return[0]; 131 | }; 132 | } 133 | 134 | sub proxy_open { 135 | my $package = caller; 136 | my ($proxy, @args) = @_; 137 | no strict 'refs'; 138 | return if defined &{"${package}::$proxy"}; 139 | my $method = sub { 140 | my $self = shift; 141 | $self->_assert_open(@args); 142 | my @return = $self->io_handle->$proxy(@_); 143 | $self->_error_check; 144 | wantarray ? @return : $return[0]; 145 | }; 146 | *{"$package\::$proxy"} = 147 | (@args and $args[0] eq '>') ? 148 | sub { 149 | my $self = shift; 150 | $self->$method(@_); 151 | return $self; 152 | } 153 | : $method; 154 | } 155 | 156 | sub mixin_import { 157 | my $target_class = shift; 158 | $target_class = caller(0) 159 | if $target_class eq 'mixin'; 160 | my $mixin_class = shift 161 | or die "Nothing to mixin"; 162 | eval "require $mixin_class"; 163 | my $pseudo_class = CORE::join '-', $target_class, $mixin_class; 164 | my %methods = mixin_methods($mixin_class); 165 | no strict 'refs'; 166 | no warnings; 167 | @{"$pseudo_class\::ISA"} = @{"$target_class\::ISA"}; 168 | @{"$target_class\::ISA"} = ($pseudo_class); 169 | for (keys %methods) { 170 | *{"$pseudo_class\::$_"} = $methods{$_}; 171 | } 172 | } 173 | 174 | sub mixin_methods { 175 | my $mixin_class = shift; 176 | no strict 'refs'; 177 | my %methods = all_methods($mixin_class); 178 | map { 179 | $methods{$_} 180 | ? ($_, \ &{"$methods{$_}\::$_"}) 181 | : ($_, \ &{"$mixin_class\::$_"}) 182 | } (keys %methods); 183 | } 184 | 185 | sub all_methods { 186 | no strict 'refs'; 187 | my $class = shift; 188 | my %methods = map { 189 | ($_, $class) 190 | } grep { 191 | defined &{"$class\::$_"} and not /^_/ 192 | } keys %{"$class\::"}; 193 | return (%methods); 194 | } 195 | 196 | 1; 197 | -------------------------------------------------------------------------------- /lib/IO/All/DBM.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package IO::All::DBM; 3 | 4 | use IO::All::File -base; 5 | use Fcntl; 6 | 7 | field _dbm_list => []; 8 | field '_dbm_class'; 9 | field _dbm_extra => []; 10 | 11 | sub dbm { 12 | my $self = shift; 13 | bless $self, __PACKAGE__; 14 | $self->_dbm_list([@_]); 15 | return $self; 16 | } 17 | 18 | sub _assert_open { 19 | my $self = shift; 20 | return $self->tied_file 21 | if $self->tied_file; 22 | $self->open; 23 | } 24 | 25 | sub assert_filepath { 26 | my $self = shift; 27 | $self->SUPER::assert_filepath(@_); 28 | if ($self->_rdonly and not -e $self->pathname) { 29 | my $rdwr = $self->_rdwr; 30 | $self->assert(0)->rdwr(1)->rdonly(0)->open; 31 | $self->close; 32 | $self->assert(1)->rdwr($rdwr)->rdonly(1); 33 | } 34 | } 35 | 36 | sub open { 37 | my $self = shift; 38 | $self->is_open(1); 39 | return $self->tied_file if $self->tied_file; 40 | $self->assert_filepath if $self->_assert; 41 | my $dbm_list = $self->_dbm_list; 42 | my @dbm_list = @$dbm_list ? @$dbm_list : 43 | (qw(DB_File GDBM_File NDBM_File ODBM_File SDBM_File)); 44 | my $dbm_class; 45 | for my $module (@dbm_list) { 46 | (my $file = "$module.pm") =~ s{::}{/}g; 47 | if (defined $INC{$file} || eval "eval 'use $module; 1'") { 48 | $self->_dbm_class($module); 49 | last; 50 | } 51 | } 52 | $self->throw("No module available for IO::All DBM operation") 53 | unless defined $self->_dbm_class; 54 | my $mode = $self->_rdonly ? O_RDONLY : O_RDWR; 55 | if ($self->_dbm_class eq 'DB_File::Lock') { 56 | $self->_dbm_class->import; 57 | my $type = eval '$DB_HASH'; die $@ if $@; 58 | # XXX Not sure about this warning 59 | warn "Using DB_File::Lock in IO::All without the rdonly or rdwr method\n" 60 | if not ($self->_rdwr or $self->_rdonly); 61 | my $flag = $self->_rdwr ? 'write' : 'read'; 62 | $mode = $self->_rdwr ? O_RDWR : O_RDONLY; 63 | $self->_dbm_extra([$type, $flag]); 64 | } 65 | $mode |= O_CREAT if $mode & O_RDWR; 66 | $self->mode($mode); 67 | $self->perms(0666) unless defined $self->perms; 68 | return $self->tie_dbm; 69 | } 70 | 71 | sub tie_dbm { 72 | my $self = shift; 73 | my $hash; 74 | my $filename = $self->name; 75 | my $db = tie %$hash, $self->_dbm_class, $filename, $self->mode, $self->perms, 76 | @{$self->_dbm_extra} 77 | or $self->throw("Can't open '$filename' as DBM file:\n$!"); 78 | $self->add_utf8_dbm_filter($db) 79 | if $self->_has_utf8; 80 | $self->tied_file($hash); 81 | } 82 | 83 | sub add_utf8_dbm_filter { 84 | my $self = shift; 85 | my $db = shift; 86 | $db->filter_store_key(sub { utf8::encode($_) }); 87 | $db->filter_store_value(sub { utf8::encode($_) }); 88 | $db->filter_fetch_key(sub { utf8::decode($_) }); 89 | $db->filter_fetch_value(sub { utf8::decode($_) }); 90 | } 91 | 92 | 1; 93 | -------------------------------------------------------------------------------- /lib/IO/All/Dir.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package IO::All::Dir; 3 | 4 | use Scalar::Util 'blessed'; 5 | use File::Glob 'bsd_glob'; 6 | use IO::All::Filesys -base; 7 | use IO::All -base; 8 | use IO::Dir; 9 | 10 | #=============================================================================== 11 | const type => 'dir'; 12 | option 'sort' => 1; 13 | chain filter => undef; 14 | option 'deep'; 15 | field 'chdir_from'; 16 | 17 | #=============================================================================== 18 | sub dir { 19 | my $self = shift; 20 | my $had_prev = blessed($self) && $self->pathname; 21 | 22 | bless $self, __PACKAGE__ unless $had_prev; 23 | if (@_ && @_ > 1 || @_ && $had_prev) { 24 | $self->name( 25 | $self->_spec_class->catdir( 26 | ($self->pathname ? ($self->pathname) : () ), 27 | @_, 28 | ) 29 | ) 30 | } elsif (@_) { 31 | $self->name($_[0]) 32 | } 33 | return $self->_init; 34 | } 35 | 36 | sub dir_handle { 37 | my $self = shift; 38 | bless $self, __PACKAGE__; 39 | $self->_handle(shift) if @_; 40 | return $self->_init; 41 | } 42 | 43 | #=============================================================================== 44 | sub _assert_open { 45 | my $self = shift; 46 | return if $self->is_open; 47 | $self->open; 48 | } 49 | 50 | sub open { 51 | my $self = shift; 52 | $self->is_open(1); 53 | $self->_assert_dirpath($self->pathname) 54 | if $self->pathname and $self->_assert; 55 | my $handle = IO::Dir->new; 56 | $self->io_handle($handle); 57 | $handle->open($self->pathname) 58 | or $self->throw($self->open_msg); 59 | return $self; 60 | } 61 | 62 | sub open_msg { 63 | my $self = shift; 64 | my $name = defined $self->pathname 65 | ? " '" . $self->pathname . "'" 66 | : ''; 67 | return qq{Can't open directory$name:\n$!}; 68 | } 69 | 70 | sub exists { -d shift->pathname } 71 | 72 | #=============================================================================== 73 | sub All { 74 | my $self = shift; 75 | $self->all(0); 76 | } 77 | 78 | sub all { 79 | my $self = shift; 80 | my $depth = @_ ? shift(@_) : $self->_deep ? 0 : 1; 81 | my $first = not @_; 82 | my @all; 83 | while (my $io = $self->next) { 84 | push @all, $io; 85 | push(@all, $io->all($depth - 1, 1)) 86 | if $depth != 1 and $io->is_dir; 87 | } 88 | @all = grep {&{$self->filter}} @all 89 | if $self->filter; 90 | return @all unless $first and $self->_sort; 91 | return sort {$a->pathname cmp $b->pathname} @all; 92 | } 93 | 94 | sub All_Dirs { 95 | my $self = shift; 96 | $self->all_dirs(0); 97 | } 98 | 99 | sub all_dirs { 100 | my $self = shift; 101 | grep {$_->is_dir} $self->all(@_); 102 | } 103 | 104 | sub All_Files { 105 | my $self = shift; 106 | $self->all_files(0); 107 | } 108 | 109 | sub all_files { 110 | my $self = shift; 111 | grep {$_->is_file} $self->all(@_); 112 | } 113 | 114 | sub All_Links { 115 | my $self = shift; 116 | $self->all_links(0); 117 | } 118 | 119 | sub all_links { 120 | my $self = shift; 121 | grep {$_->is_link} $self->all(@_); 122 | } 123 | 124 | sub chdir { 125 | my $self = shift; 126 | require Cwd; 127 | $self->chdir_from(Cwd::cwd()); 128 | CORE::chdir($self->pathname); 129 | return $self; 130 | } 131 | 132 | sub empty { 133 | my $self = shift; 134 | my $dh; 135 | opendir($dh, $self->pathname) or die; 136 | while (my $dir = readdir($dh)) { 137 | return 0 unless $dir =~ /^\.{1,2}$/; 138 | } 139 | return 1; 140 | } 141 | 142 | sub mkdir { 143 | my $self = shift; 144 | defined($self->perms) 145 | ? (CORE::mkdir($self->pathname, $self->perms) or die "mkdir failed: $!") 146 | : (CORE::mkdir($self->pathname) or die "mkdir failed: $!"); 147 | return $self; 148 | } 149 | 150 | sub mkpath { 151 | my $self = shift; 152 | require File::Path; 153 | File::Path::mkpath($self->pathname, @_); 154 | return $self; 155 | } 156 | 157 | sub file { 158 | my ($self, @rest) = @_; 159 | 160 | return $self->_constructor->()->file($self->pathname, @rest) 161 | } 162 | 163 | sub next { 164 | my $self = shift; 165 | $self->_assert_open; 166 | my $name = $self->readdir; 167 | return unless defined $name; 168 | my $io = $self->_constructor->(File::Spec->catfile($self->pathname, $name)); 169 | $io->absolute if $self->is_absolute; 170 | return $io; 171 | } 172 | 173 | sub readdir { 174 | my $self = shift; 175 | $self->_assert_open; 176 | if (wantarray) { 177 | my @return = grep { 178 | not /^\.{1,2}$/ 179 | } $self->io_handle->read; 180 | $self->close; 181 | if ($self->_has_utf8) { utf8::decode($_) for (@return) } 182 | return @return; 183 | } 184 | my $name = '.'; 185 | while ($name =~ /^\.{1,2}$/) { 186 | $name = $self->io_handle->read; 187 | unless (defined $name) { 188 | $self->close; 189 | return; 190 | } 191 | } 192 | if ($self->_has_utf8) { utf8::decode($name) } 193 | return $name; 194 | } 195 | 196 | sub rmdir { 197 | my $self = shift; 198 | rmdir $self->pathname; 199 | } 200 | 201 | sub rmtree { 202 | my $self = shift; 203 | require File::Path; 204 | File::Path::rmtree($self->pathname, @_); 205 | } 206 | 207 | sub glob { 208 | my ($self, @rest) = @_; 209 | 210 | map {; 211 | my $ret = $self->_constructor->($_); 212 | $ret->absolute if $self->is_absolute; 213 | $ret 214 | } bsd_glob $self->_spec_class->catdir( $self->pathname, @rest ); 215 | } 216 | 217 | sub copy { 218 | my ($self, $new) = @_; 219 | 220 | require File::Copy::Recursive; 221 | 222 | File::Copy::Recursive::dircopy($self->name, $new) 223 | or die "failed to copy $self to $new: $!"; 224 | $self->_constructor->($new) 225 | } 226 | 227 | sub DESTROY { 228 | my $self = shift; 229 | CORE::chdir($self->chdir_from) 230 | if $self->chdir_from; 231 | # $self->SUPER::DESTROY(@_); 232 | } 233 | 234 | #=============================================================================== 235 | sub _overload_table { 236 | ( 237 | '${} dir' => '_overload_as_scalar', 238 | '@{} dir' => '_overload_as_array', 239 | '%{} dir' => '_overload_as_hash', 240 | ) 241 | } 242 | 243 | sub _overload_as_scalar { 244 | \ $_[1]; 245 | } 246 | 247 | sub _overload_as_array { 248 | [ $_[1]->all ]; 249 | } 250 | 251 | sub _overload_as_hash { 252 | +{ 253 | map { 254 | (my $name = $_->pathname) =~ s/.*[\/\\]//; 255 | ($name, $_); 256 | } $_[1]->all 257 | }; 258 | } 259 | 260 | 1; 261 | -------------------------------------------------------------------------------- /lib/IO/All/File.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package IO::All::File; 3 | 4 | use IO::All::Filesys -base; 5 | use IO::All -base; 6 | use IO::File; 7 | use File::Copy (); 8 | 9 | #=============================================================================== 10 | const type => 'file'; 11 | field tied_file => undef; 12 | 13 | #=============================================================================== 14 | sub file { 15 | my $self = shift; 16 | bless $self, __PACKAGE__; 17 | # should we die here if $self->name is already set and there are args? 18 | if (@_ && @_ > 1) { 19 | $self->name( $self->_spec_class->catfile( @_ ) ) 20 | } elsif (@_) { 21 | $self->name($_[0]) 22 | } 23 | return $self->_init; 24 | } 25 | 26 | sub file_handle { 27 | my $self = shift; 28 | bless $self, __PACKAGE__; 29 | $self->_handle(shift) if @_; 30 | return $self->_init; 31 | } 32 | 33 | #=============================================================================== 34 | sub assert_filepath { 35 | my $self = shift; 36 | my $name = $self->pathname 37 | or return; 38 | my $directory; 39 | (undef, $directory) = File::Spec->splitpath($self->pathname); 40 | $self->_assert_dirpath($directory); 41 | } 42 | 43 | sub assert_open_backwards { 44 | my $self = shift; 45 | return if $self->is_open; 46 | require File::ReadBackwards; 47 | my $file_name = $self->pathname; 48 | my $io_handle = File::ReadBackwards->new($file_name) 49 | or $self->throw("Can't open $file_name for backwards:\n$!"); 50 | $self->io_handle($io_handle); 51 | $self->is_open(1); 52 | } 53 | 54 | sub _assert_open { 55 | my $self = shift; 56 | return if $self->is_open; 57 | $self->mode(shift) unless $self->mode; 58 | $self->open; 59 | } 60 | 61 | sub assert_tied_file { 62 | my $self = shift; 63 | return $self->tied_file || do { 64 | eval {require Tie::File}; 65 | $self->throw("Tie::File required for file array operations:\n$@") 66 | if $@; 67 | my $array_ref = do { my @array; \@array }; 68 | my $name = $self->pathname; 69 | my @options = $self->_rdonly ? (mode => O_RDONLY) : (); 70 | push @options, (recsep => $self->separator); 71 | tie @$array_ref, 'Tie::File', $name, @options; 72 | $self->throw("Can't tie 'Tie::File' to '$name':\n$!") 73 | unless tied @$array_ref; 74 | $self->tied_file($array_ref); 75 | }; 76 | } 77 | 78 | sub open { 79 | my $self = shift; 80 | $self->is_open(1); 81 | $self->assert_filepath if $self->_assert; 82 | my ($mode, $perms) = @_; 83 | $self->mode($mode) if defined $mode; 84 | $self->mode('<') unless defined $self->mode; 85 | $self->perms($perms) if defined $perms; 86 | my @args = ($self->mode); 87 | push @args, $self->perms if defined $self->perms; 88 | if (defined $self->pathname) { 89 | $self->io_handle(IO::File->new); 90 | $self->io_handle->open($self->pathname, @args) 91 | or $self->throw($self->open_msg); 92 | } 93 | elsif (defined $self->_handle and 94 | not $self->io_handle->opened 95 | ) { 96 | # XXX Not tested 97 | $self->io_handle->fdopen($self->_handle, @args); 98 | } 99 | $self->set_lock; 100 | $self->_set_binmode; 101 | } 102 | 103 | sub exists { -f shift->pathname } 104 | 105 | my %mode_msg = ( 106 | '>' => 'output', 107 | '<' => 'input', 108 | '>>' => 'append', 109 | ); 110 | sub open_msg { 111 | my $self = shift; 112 | my $name = defined $self->pathname 113 | ? " '" . $self->pathname . "'" 114 | : ''; 115 | my $direction = defined $mode_msg{$self->mode} 116 | ? ' for ' . $mode_msg{$self->mode} 117 | : ''; 118 | return qq{Can't open file$name$direction:\n$!}; 119 | } 120 | 121 | #=============================================================================== 122 | sub copy { 123 | my ($self, $new) = @_; 124 | 125 | File::Copy::copy($self->name, $new) 126 | or die "failed to copy $self to $new: $!"; 127 | $self->file($new) 128 | } 129 | 130 | sub close { 131 | my $self = shift; 132 | return unless $self->is_open; 133 | $self->is_open(0); 134 | my $io_handle = $self->io_handle; 135 | $self->unlock; 136 | $self->io_handle(undef); 137 | $self->mode(undef); 138 | if (my $tied_file = $self->tied_file) { 139 | if (ref($tied_file) eq 'ARRAY') { 140 | untie @$tied_file; 141 | } 142 | else { 143 | untie %$tied_file; 144 | } 145 | $self->tied_file(undef); 146 | return 1; 147 | } 148 | $io_handle->close(@_) 149 | if defined $io_handle; 150 | return $self; 151 | } 152 | 153 | sub empty { 154 | my $self = shift; 155 | -z $self->pathname; 156 | } 157 | 158 | sub filepath { 159 | my $self = shift; 160 | my ($volume, $path) = $self->splitpath; 161 | return File::Spec->catpath($volume, $path, ''); 162 | } 163 | 164 | sub getline_backwards { 165 | my $self = shift; 166 | $self->assert_open_backwards; 167 | return $self->io_handle->readline; 168 | } 169 | 170 | sub getlines_backwards { 171 | my $self = shift; 172 | my @lines; 173 | while (defined (my $line = $self->getline_backwards)) { 174 | push @lines, $line; 175 | } 176 | return @lines; 177 | } 178 | 179 | sub head { 180 | my $self = shift; 181 | my $lines = shift || 10; 182 | my @return; 183 | $self->close; 184 | 185 | LINES: 186 | while ($lines--) { 187 | if (defined (my $l = $self->getline)) { 188 | push @return, $l; 189 | } 190 | else { 191 | last LINES; 192 | } 193 | } 194 | 195 | $self->close; 196 | return wantarray ? @return : join '', @return; 197 | } 198 | 199 | sub tail { 200 | my $self = shift; 201 | my $lines = shift || 10; 202 | my @return; 203 | $self->close; 204 | while ($lines--) { 205 | unshift @return, ($self->getline_backwards or last); 206 | } 207 | $self->close; 208 | return wantarray ? @return : join '', @return; 209 | } 210 | 211 | sub touch { 212 | my $self = shift; 213 | return $self->SUPER::touch(@_) 214 | if -e $self->pathname; 215 | return $self if $self->is_open; 216 | my $mode = $self->mode; 217 | $self->mode('>>')->open->close; 218 | $self->mode($mode); 219 | return $self; 220 | } 221 | 222 | sub unlink { 223 | my $self = shift; 224 | unlink $self->pathname; 225 | } 226 | 227 | #=============================================================================== 228 | sub _overload_table { 229 | my $self = shift; 230 | ( 231 | $self->SUPER::_overload_table(@_), 232 | 'file > file' => '_overload_file_to_file', 233 | 'file < file' => '_overload_file_from_file', 234 | '${} file' => '_overload_file_as_scalar', 235 | '@{} file' => '_overload_file_as_array', 236 | '%{} file' => '_overload_file_as_dbm', 237 | ) 238 | } 239 | 240 | sub _overload_file_to_file { 241 | require File::Copy; 242 | File::Copy::copy($_[1]->pathname, $_[2]->pathname); 243 | $_[2]; 244 | } 245 | 246 | sub _overload_file_from_file { 247 | require File::Copy; 248 | File::Copy::copy($_[2]->pathname, $_[1]->pathname); 249 | $_[1]; 250 | } 251 | 252 | sub _overload_file_as_array { 253 | $_[1]->assert_tied_file; 254 | } 255 | 256 | sub _overload_file_as_dbm { 257 | $_[1]->dbm 258 | unless $_[1]->isa('IO::All::DBM'); 259 | $_[1]->_assert_open; 260 | } 261 | 262 | sub _overload_file_as_scalar { 263 | my $scalar = $_[1]->scalar; 264 | return \$scalar; 265 | } 266 | 267 | 1; 268 | -------------------------------------------------------------------------------- /lib/IO/All/Filesys.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package IO::All::Filesys; 3 | 4 | use IO::All::Base -base; 5 | use Fcntl qw(:flock); 6 | 7 | my %spec_map = ( 8 | unix => 'Unix', 9 | win32 => 'Win32', 10 | vms => 'VMS', 11 | mac => 'Mac', 12 | os2 => 'OS2', 13 | ); 14 | sub os { 15 | my ($self, $type) = @_; 16 | 17 | my ($v, $d, $f) = $self->_spec_class->splitpath($self->name); 18 | my @d = $self->_spec_class->splitdir($d); 19 | 20 | $self->_spec_class($spec_map{$type}); 21 | 22 | $self->name( $self->_spec_class->catfile( @d, $f ) ); 23 | 24 | return $self 25 | } 26 | 27 | sub exists { my $self = shift; -e $self->name } 28 | 29 | sub filename { 30 | my $self = shift; 31 | my $filename; 32 | (undef, undef, $filename) = $self->splitpath; 33 | return $filename; 34 | } 35 | 36 | sub ext { 37 | my $self = shift; 38 | 39 | return $1 if $self->filename =~ m/\.([^\.]+)$/ 40 | } 41 | { 42 | no warnings 'once'; 43 | *extension = \&ext; 44 | } 45 | 46 | sub mimetype { 47 | require File::MimeInfo; 48 | return File::MimeInfo::mimetype($_[0]->filename) 49 | } 50 | 51 | sub is_absolute { 52 | my $self = shift; 53 | return *$self->{is_absolute} = shift if @_; 54 | return *$self->{is_absolute} 55 | if defined *$self->{is_absolute}; 56 | *$self->{is_absolute} = IO::All::is_absolute($self) ? 1 : 0; 57 | } 58 | 59 | sub is_executable { my $self = shift; -x $self->name } 60 | sub is_readable { my $self = shift; -r $self->name } 61 | sub is_writable { my $self = shift; -w $self->name } 62 | { 63 | no warnings 'once'; 64 | *is_writeable = \&is_writable; 65 | } 66 | 67 | sub pathname { 68 | my $self = shift; 69 | return *$self->{pathname} = shift if @_; 70 | return *$self->{pathname} if defined *$self->{pathname}; 71 | return $self->name; 72 | } 73 | 74 | sub relative { 75 | my $self = shift; 76 | if (my $base = $_[0]) { 77 | $self->pathname(File::Spec->abs2rel($self->pathname, $base)) 78 | } elsif ($self->is_absolute) { 79 | $self->pathname(File::Spec->abs2rel($self->pathname)) 80 | } 81 | $self->is_absolute(0); 82 | return $self; 83 | } 84 | 85 | sub rename { 86 | my $self = shift; 87 | my $new = shift; 88 | rename($self->name, "$new") 89 | ? UNIVERSAL::isa($new, 'IO::All') 90 | ? $new 91 | : $self->_constructor->($new) 92 | : undef; 93 | } 94 | 95 | sub set_lock { 96 | my $self = shift; 97 | return unless $self->_lock; 98 | my $io_handle = $self->io_handle; 99 | my $flag = $self->mode =~ /^>>?$/ 100 | ? LOCK_EX 101 | : LOCK_SH; 102 | flock $io_handle, $flag; 103 | } 104 | 105 | sub stat { 106 | my $self = shift; 107 | return IO::All::stat($self, @_) 108 | if $self->is_open; 109 | CORE::stat($self->pathname); 110 | } 111 | 112 | sub touch { 113 | my $self = shift; 114 | $self->utime; 115 | } 116 | 117 | sub unlock { 118 | my $self = shift; 119 | flock $self->io_handle, LOCK_UN 120 | if $self->_lock; 121 | } 122 | 123 | sub utime { 124 | my $self = shift; 125 | my $atime = shift; 126 | my $mtime = shift; 127 | $atime = time unless defined $atime; 128 | $mtime = $atime unless defined $mtime; 129 | utime($atime, $mtime, $self->name); 130 | return $self; 131 | } 132 | 133 | 1; 134 | -------------------------------------------------------------------------------- /lib/IO/All/Link.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package IO::All::Link; 3 | 4 | use IO::All::File -base; 5 | 6 | const type => 'link'; 7 | 8 | sub link { 9 | my $self = shift; 10 | bless $self, __PACKAGE__; 11 | $self->name(shift) if @_; 12 | $self->_init; 13 | } 14 | 15 | sub readlink { 16 | my $self = shift; 17 | $self->_constructor->(CORE::readlink($self->name)); 18 | } 19 | 20 | sub symlink { 21 | my $self = shift; 22 | my $target = shift; 23 | $self->assert_filepath if $self->_assert; 24 | CORE::symlink($target, $self->pathname); 25 | } 26 | 27 | sub AUTOLOAD { 28 | my $self = shift; 29 | our $AUTOLOAD; 30 | (my $method = $AUTOLOAD) =~ s/.*:://; 31 | my $target = $self->target; 32 | unless ($target) { 33 | $self->throw("Can't call $method on symlink"); 34 | return; 35 | } 36 | $target->$method(@_); 37 | } 38 | 39 | sub target { 40 | my $self = shift; 41 | return *$self->{target} if *$self->{target}; 42 | my %seen; 43 | my $link = $self; 44 | my $new; 45 | while ($new = $link->readlink) { 46 | my $type = $new->type or return; 47 | last if $type eq 'file'; 48 | last if $type eq 'dir'; 49 | return unless $type eq 'link'; 50 | return if $seen{$new->name}++; 51 | $link = $new; 52 | } 53 | *$self->{target} = $new; 54 | } 55 | 56 | sub exists { -l shift->pathname } 57 | 58 | 1; 59 | -------------------------------------------------------------------------------- /lib/IO/All/MLDBM.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package IO::All::MLDBM; 3 | 4 | use IO::All::DBM -base; 5 | 6 | field _serializer => 'Data::Dumper'; 7 | 8 | sub mldbm { 9 | my $self = shift; 10 | bless $self, __PACKAGE__; 11 | my ($serializer) = grep { /^(Storable|Data::Dumper|FreezeThaw)$/ } @_; 12 | $self->_serializer($serializer) if defined $serializer; 13 | my @dbm_list = grep { not /^(Storable|Data::Dumper|FreezeThaw)$/ } @_; 14 | $self->_dbm_list([@dbm_list]); 15 | return $self; 16 | } 17 | 18 | sub tie_dbm { 19 | my $self = shift; 20 | my $filename = $self->name; 21 | my $dbm_class = $self->_dbm_class; 22 | my $serializer = $self->_serializer; 23 | eval "use MLDBM qw($dbm_class $serializer)"; 24 | $self->throw("Can't open '$filename' as MLDBM:\n$@") if $@; 25 | my $hash; 26 | my $db = tie %$hash, 'MLDBM', $filename, $self->mode, $self->perms, 27 | @{$self->_dbm_extra} 28 | or $self->throw("Can't open '$filename' as MLDBM file:\n$!"); 29 | $self->add_utf8_dbm_filter($db) 30 | if $self->_has_utf8; 31 | $self->tied_file($hash); 32 | } 33 | 34 | 1; 35 | -------------------------------------------------------------------------------- /lib/IO/All/Pipe.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package IO::All::Pipe; 3 | 4 | use IO::All -base; 5 | use IO::File; 6 | 7 | const type => 'pipe'; 8 | 9 | sub pipe { 10 | my $self = shift; 11 | bless $self, __PACKAGE__; 12 | $self->name(shift) if @_; 13 | return $self->_init; 14 | } 15 | 16 | sub _assert_open { 17 | my $self = shift; 18 | return if $self->is_open; 19 | $self->mode(shift) unless $self->mode; 20 | $self->open; 21 | } 22 | 23 | sub open { 24 | my $self = shift; 25 | $self->is_open(1); 26 | require IO::Handle; 27 | $self->io_handle(IO::Handle->new) 28 | unless defined $self->io_handle; 29 | my $command = $self->name; 30 | $command =~ s/(^\||\|$)//; 31 | my $mode = shift || $self->mode || '<'; 32 | my $pipe_mode = 33 | $mode eq '>' ? '|-' : 34 | $mode eq '<' ? '-|' : 35 | $self->throw("Invalid usage mode '$mode' for pipe"); 36 | CORE::open($self->io_handle, $pipe_mode, $command); 37 | $self->_set_binmode; 38 | } 39 | 40 | my %mode_msg = ( 41 | '>' => 'output', 42 | '<' => 'input', 43 | '>>' => 'append', 44 | ); 45 | sub open_msg { 46 | my $self = shift; 47 | my $name = defined $self->name 48 | ? " '" . $self->name . "'" 49 | : ''; 50 | my $direction = defined $mode_msg{$self->mode} 51 | ? ' for ' . $mode_msg{$self->mode} 52 | : ''; 53 | return qq{Can't open pipe$name$direction:\n$!}; 54 | } 55 | 56 | 1; 57 | -------------------------------------------------------------------------------- /lib/IO/All/STDIO.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package IO::All::STDIO; 3 | 4 | use IO::All -base; 5 | use IO::File; 6 | 7 | const type => 'stdio'; 8 | 9 | sub stdio { 10 | my $self = shift; 11 | bless $self, __PACKAGE__; 12 | return $self->_init; 13 | } 14 | 15 | sub stdin { 16 | my $self = shift; 17 | $self->open('<'); 18 | return $self; 19 | } 20 | 21 | sub stdout { 22 | my $self = shift; 23 | $self->open('>'); 24 | return $self; 25 | } 26 | 27 | sub stderr { 28 | my $self = shift; 29 | $self->open_stderr; 30 | return $self; 31 | } 32 | 33 | sub open { 34 | my $self = shift; 35 | $self->is_open(1); 36 | my $mode = shift || $self->mode || '<'; 37 | my $fileno = $mode eq '>' 38 | ? fileno(STDOUT) 39 | : fileno(STDIN); 40 | $self->io_handle(IO::File->new); 41 | $self->io_handle->fdopen($fileno, $mode); 42 | $self->_set_binmode; 43 | } 44 | 45 | sub open_stderr { 46 | my $self = shift; 47 | $self->is_open(1); 48 | $self->io_handle(IO::File->new); 49 | $self->io_handle->fdopen(fileno(STDERR), '>') ? $self : 0; 50 | } 51 | 52 | # XXX Add overload support 53 | 54 | 1; 55 | -------------------------------------------------------------------------------- /lib/IO/All/Socket.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package IO::All::Socket; 3 | 4 | use IO::All -base; 5 | use IO::Socket; 6 | 7 | const type => 'socket'; 8 | field _listen => undef; 9 | option 'fork'; 10 | const domain_default => 'localhost'; 11 | chain domain => undef; 12 | chain port => undef; 13 | proxy_open 'recv'; 14 | proxy_open 'send'; 15 | 16 | sub socket { 17 | my $self = shift; 18 | bless $self, __PACKAGE__; 19 | $self->name(shift) if @_; 20 | return $self->_init; 21 | } 22 | 23 | sub socket_handle { 24 | my $self = shift; 25 | bless $self, __PACKAGE__; 26 | $self->_handle(shift) if @_; 27 | return $self->_init; 28 | } 29 | 30 | sub accept { 31 | my $self = shift; 32 | use POSIX ":sys_wait_h"; 33 | sub REAPER { 34 | while (waitpid(-1, WNOHANG) > 0) {} 35 | $SIG{CHLD} = \&REAPER; 36 | } 37 | local $SIG{CHLD}; 38 | $self->_listen(1); 39 | $self->_assert_open; 40 | my $server = $self->io_handle; 41 | my $socket; 42 | while (1) { 43 | $socket = $server->accept; 44 | last unless $self->_fork; 45 | next unless defined $socket; 46 | $SIG{CHLD} = \&REAPER; 47 | my $pid = CORE::fork; 48 | $self->throw("Unable to fork for IO::All::accept") 49 | unless defined $pid; 50 | last unless $pid; 51 | close $socket; 52 | undef $socket; 53 | } 54 | close $server if $self->_fork; 55 | my $io = ref($self)->new->socket_handle($socket); 56 | $io->io_handle($socket); 57 | $io->is_open(1); 58 | return $io; 59 | } 60 | 61 | sub shutdown { 62 | my $self = shift; 63 | my $how = @_ ? shift : 2; 64 | my $handle = $self->io_handle; 65 | $handle->shutdown(2) 66 | if defined $handle; 67 | } 68 | 69 | sub _assert_open { 70 | my $self = shift; 71 | return if $self->is_open; 72 | $self->mode(shift) unless $self->mode; 73 | $self->open; 74 | } 75 | 76 | sub open { 77 | my $self = shift; 78 | return if $self->is_open; 79 | $self->is_open(1); 80 | $self->get_socket_domain_port; 81 | my @args = $self->_listen 82 | ? ( 83 | LocalAddr => $self->domain, 84 | LocalPort => $self->port, 85 | Proto => 'tcp', 86 | Listen => 1, 87 | Reuse => 1, 88 | ) 89 | : ( 90 | PeerAddr => $self->domain, 91 | PeerPort => $self->port, 92 | Proto => 'tcp', 93 | ); 94 | my $socket = IO::Socket::INET->new(@args) 95 | or $self->throw("Can't open socket"); 96 | $self->io_handle($socket); 97 | $self->_set_binmode; 98 | } 99 | 100 | sub get_socket_domain_port { 101 | my $self = shift; 102 | my ($domain, $port); 103 | ($domain, $port) = split /:/, $self->name 104 | if defined $self->name; 105 | $self->domain($domain) unless defined $self->domain; 106 | $self->domain($self->domain_default) unless $self->domain; 107 | $self->port($port) unless defined $self->port; 108 | return $self; 109 | } 110 | 111 | sub _overload_table { 112 | my $self = shift; 113 | ( 114 | $self->SUPER::_overload_table(@_), 115 | '&{} socket' => '_overload_socket_as_code', 116 | ) 117 | } 118 | 119 | sub _overload_socket_as_code { 120 | my $self = shift; 121 | sub { 122 | my $coderef = shift; 123 | while ($self->is_open) { 124 | $_ = $self->getline; 125 | &$coderef($self); 126 | } 127 | } 128 | } 129 | 130 | sub _overload_any_from_any { 131 | my $self = shift; 132 | $self->SUPER::_overload_any_from_any(@_); 133 | $self->close; 134 | } 135 | 136 | sub _overload_any_to_any { 137 | my $self = shift; 138 | $self->SUPER::_overload_any_to_any(@_); 139 | $self->close; 140 | } 141 | 142 | 1; 143 | -------------------------------------------------------------------------------- /lib/IO/All/String.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package IO::All::String; 3 | 4 | use IO::All -base; 5 | 6 | const type => 'string'; 7 | 8 | sub string_ref { 9 | my ($self, $ref) = @_; 10 | 11 | no strict 'refs'; 12 | *$self->{ref} = $ref if exists $_[1]; 13 | 14 | return *$self->{ref} 15 | } 16 | 17 | sub string { 18 | my $self = shift; 19 | bless $self, __PACKAGE__; 20 | $self->_init; 21 | } 22 | 23 | sub open { 24 | my $self = shift; 25 | my $str = ''; 26 | my $ref = \$str; 27 | $self->string_ref($ref); 28 | open my $fh, '+<', $ref; 29 | $self->io_handle($fh); 30 | $self->_set_binmode; 31 | $self->is_open(1); 32 | } 33 | 34 | 1; 35 | -------------------------------------------------------------------------------- /lib/IO/All/Temp.pm: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | package IO::All::Temp; 3 | 4 | use IO::All::File -base; 5 | 6 | sub temp { 7 | my $self = shift; 8 | bless $self, __PACKAGE__; 9 | my $temp_file = IO::File::new_tmpfile() 10 | or $self->throw("Can't create temporary file"); 11 | $self->io_handle($temp_file); 12 | $self->_error_check; 13 | $self->autoclose(0); 14 | $self->is_open(1); 15 | return $self; 16 | } 17 | 18 | 1; 19 | -------------------------------------------------------------------------------- /note/Design.st: -------------------------------------------------------------------------------- 1 | ^ Introduction 2 | 3 | Perl provides all the foundational functionality for Input/Output in all its 4 | myriad forms. 5 | 6 | Unforatunately using all these primitives is unnecessarily tedious. IO::All 7 | was introduced in 2005 as a proof of concept that IO operations could all be 8 | pleasantly simple and consistent. 9 | 10 | While IO::All is off to a good start, it is not completely polished. It is 11 | time for a rewrite. It makes sense to have a solid plan/specification, before 12 | writing the code. This document is intended to be just that. 13 | 14 | ^ Current Design Concepts 15 | 16 | * Export one function, `io`, that acts constructs an IO::All object. 17 | 18 | ^ Current Deficiencies 19 | -------------------------------------------------------------------------------- /note/Design.swim: -------------------------------------------------------------------------------- 1 | = Introduction 2 | 3 | This is a design document for an upcoming version of IO::All. 4 | 5 | IO::All is a Perl module that attempts to make all Input/Output operations in 6 | Perl, as simple and normal as possible. IO::All has been in existence since 7 | 2004. It is useful and somewhat extensible, but has a number of 8 | inconsistencies, flaws and misgivings. 9 | 10 | This document will propose a better way to do it, and will also discuss how to 11 | move the current API forward to the new API. 12 | 13 | = Basic Principles of how IO::All should work 14 | 15 | * IO::All provides a single entry point function called `io`. 16 | * `use IO::All` should make this function available in a lexical scope. 17 | * Currently this scope is 'package' scope. 18 | * Would be nice, but maybe not possible to have true lexical scope. 19 | * The `io` function is custom to its scope 20 | * The behavior it provides depends on the state of the scope 21 | * The behavior it provides also depends on the arguments passed to `use 22 | IO::All` 23 | * `io` returns an IO::All object 24 | * The IO::All object has no I/O capabilities 25 | * Further method calls invoke a context, causing the IO::All object to 26 | rebless itself it something useful like IO::All::File. 27 | * Certain methods force a rebless 28 | * `file(...), dir(...), socket(...), etc 29 | * These methods are more or less hard-coded currently 30 | * Options to `use IO::All` that begin with a `-`, cause a method to be called 31 | on each new IO::All object. 32 | * use IO::All -encoding => 'big5'; # causes: 33 | * io('foo')->print('hi'); # to mean: 34 | * io('foo')->encoding('big5')->print('hi'); 35 | * IO::All operations generally return other IO::All objects 36 | * Often they return themselves ($self) for chaining 37 | * IO::All needs to be completely and consistently extensible 38 | * The extensions that ship with IO-All should be the same as third party 39 | extensions 40 | * Extensions register capabilities with IO::All (tied to a scope) 41 | * IO::All operations can be strict or loose. Strict always throws errors on 42 | any possible error condition. Strict or loose should be determined by the 43 | presence of `use strict` in the scope (possibly). 44 | * IO::All currently uses a big set of overloaded operations by default. This 45 | is loved by some and hated by others. It should probably be off by default 46 | for 2.0. 47 | 48 | = IO::All Extensions 49 | 50 | Currently the extension API is fairly muddy. I would like the new API to 51 | require something like this: 52 | 53 | { 54 | use strict; 55 | use IO::All -overload; 56 | use IO::All::PrintingPress; 57 | 58 | my $io = io('path:to:printing:press#1'); 59 | # is ref($io), 'IO::All'; 60 | $io->print('IO::All'); # calls IO::All::PrintingPress::print 61 | # is ref($io), 'IO::All::PrintingPress'; 62 | } 63 | 64 | So you need to load any extensions that you want to use, within the scope that 65 | you want them in. Exceptions are IO::All::File and IO::All::Dir, which are 66 | automatically loaded, unless you say: 67 | 68 | use IO::All -none; 69 | 70 | Extensions can register 2 things: 71 | 72 | 1. Register a method (or methods) that will force a rebless in that class. 73 | 2. Register a regexp (or function) that will cause a rebless when the input 74 | to io(...) matches. 75 | 76 | These things are register according to the scope of the IO::All, so that the 77 | `io` function will do the right things. 78 | 79 | = Transition to the new API 80 | 81 | It needs to be determined if the changes that need to be made are too 82 | destructive to coexist with the current IO::All. That determination obviously 83 | cannot be made until the new design is complete. 84 | 85 | If it is not too destructive, IO::All and its extensions can be brought 86 | forward. 87 | 88 | If it is too destructive, here is one proposed solution: 89 | 90 | Support IO::All 2 ; 91 | 92 | The version '2' will load IO::All2 (or something) and no version will load the 93 | old code. 94 | 95 | It is important to assure that the old and new interfaces can coexist in the 96 | same process space. 97 | 98 | In the IO::All2 scenario, we would need to figure out if the current IO::All 99 | extensions also needed forwarding. 100 | 101 | -------------------------------------------------------------------------------- /note/ToDo: -------------------------------------------------------------------------------- 1 | == 0.42 2 | - Can't sort io->all_files 3 | - Test on OS X 4 | - Return 0 or 1 on fail or success 5 | - Die on failure with -strict option. 6 | - Fix mst's bug 7 | - perl -MIO::All -e '${io("/tmp")}' 8 | 9 | 0.30 release 10 | - IO::All::STDIO -> IO::All::Stdio (downcase) 11 | - No dependency on Tie::File 12 | - Fix test failures 13 | - Test the interface with 3rd party modules 14 | - New methods: 15 | - file->empty dir->empty 16 | - touch 17 | - file->all 18 | - add stubs in IO::All that throw errors for these (type undetermined) 19 | 20 | 21 | 22 | - Use '=' for STDERR 23 | - Support piping open: '|foo', 'foo|' 24 | - Maybe even: '|foo|' 25 | 26 | - $io->separator 27 | - $io->ending 28 | - $io->end 29 | - $io->sep 30 | 31 | - overloading 32 | # read all files recursively 33 | $files << io('dir'); 34 | io('dir') >> $files; 35 | 36 | - email support (Mail::Send) 37 | - irc support 38 | - blog support (Atom) 39 | - http support (LWP) 40 | - ftp support 41 | - dav support 42 | - ldap support 43 | - pop support 44 | - smtp support 45 | 46 | - Serial Support 47 | - Win32::SerialPort 48 | - Device::SerialPort 49 | -------------------------------------------------------------------------------- /note/method_list: -------------------------------------------------------------------------------- 1 | C, 2 | C, 3 | C, 4 | C, 5 | C, 6 | C, 7 | C, 8 | C, 9 | C, 10 | C, 11 | C, 12 | C, 13 | C, 14 | C, 15 | C, 16 | C, 17 | C, 18 | C, 19 | C, 20 | C, 21 | C, 22 | C, 23 | C, 24 | C, 25 | C, 26 | C, 27 | C, 28 | C, 29 | C, 30 | C, 31 | C, 32 | C, 33 | C, 34 | C, 35 | C, 36 | C, 37 | C, 38 | C, 39 | C, 40 | C, 41 | C, 42 | C, 43 | C, 44 | C, 45 | C, 46 | C, 47 | C, 48 | C, 49 | C, 50 | C, 51 | C, 52 | C, 53 | C, 54 | C, 55 | C, 56 | C, 57 | C, 58 | C, 59 | C, 60 | C, 61 | C, 62 | C, 63 | C, 64 | C, 65 | C, 66 | C, 67 | C, 68 | C, 69 | C, 70 | C, 71 | C, 72 | C, 73 | C, 74 | C, 75 | C, 76 | C, 77 | C, 78 | C, 79 | C, 80 | C, 81 | C, 82 | C, 83 | C, 84 | C, 85 | C, 86 | C, 87 | C, 88 | C, 89 | C, 90 | C, 91 | C, 92 | C, 93 | C, 94 | C, 95 | C, 96 | C, 97 | C, 98 | C, 99 | C, 100 | C, 101 | C, 102 | C, 103 | C, 104 | C, 105 | C, 106 | C, 107 | C, 108 | C, 109 | C, 110 | C, 111 | C, 112 | C, 113 | C, 114 | C, 115 | C, 116 | C, 117 | C, 118 | C, 119 | C, 120 | C, 121 | C, 122 | C, 123 | C, 124 | C, 125 | C, 126 | C, 127 | C, 128 | C, 129 | C, 130 | C, 131 | C, 132 | C, 133 | C, 134 | C, 135 | C, 136 | C, 137 | C, 138 | C, 139 | C, 140 | C, 141 | C, 142 | C, 143 | C, 144 | C, 145 | C, 146 | C, 147 | C, 148 | C, 149 | C, 150 | C, 151 | C, 152 | C, 153 | C, 154 | C, 155 | C, 156 | C, 157 | C, 158 | C, 159 | C, 160 | C, 161 | C, 162 | C, 163 | C, 164 | -------------------------------------------------------------------------------- /test/IO_All_Test.pm: -------------------------------------------------------------------------------- 1 | package IO_All_Test; 2 | use File::Path; 3 | @EXPORT = qw( 4 | del_output_dir 5 | o_dir 6 | test_file_contents 7 | test_file_contents2 8 | test_matching_files 9 | read_file_lines 10 | flip_slash f 11 | $output_dir 12 | ); 13 | use strict; 14 | use base 'Exporter'; 15 | use Test::More (); 16 | 17 | sub test_file_contents { 18 | my ($data, $file) = @_; 19 | Test::More::is($data, read_file($file)); 20 | } 21 | 22 | sub test_file_contents2 { 23 | my ($file, $data) = @_; 24 | Test::More::is(read_file($file), $data); 25 | } 26 | 27 | sub test_matching_files { 28 | my ($file1, $file2) = @_; 29 | Test::More::is(read_file($file1), read_file($file2)); 30 | } 31 | 32 | sub read_file { 33 | my ($file) = @_; 34 | local(*FILE, $/); 35 | open FILE, $file 36 | or die "Can't open $file for input:\n$!"; 37 | return scalar ; 38 | } 39 | 40 | sub read_file_lines { 41 | my ($file) = @_; 42 | local(*FILE); 43 | open FILE, $file or die $!; 44 | (); 45 | } 46 | 47 | sub flip_slash { 48 | my $string = shift; 49 | if ($^O =~ /^mswin32$/i) { 50 | $string =~ s/\//\\/g; 51 | } 52 | return $string; 53 | } 54 | { 55 | no warnings; 56 | *f = \&flip_slash; 57 | } 58 | 59 | use vars qw($output_dir); 60 | 61 | BEGIN { 62 | use FindBin qw($Script); 63 | use File::Temp qw(tempdir); 64 | my $t = -e 't' ? 't' : 'test'; 65 | 66 | if ($Script =~ m{([\w\-]+)\.t\z}) { 67 | $output_dir = "$t/output__$1"; 68 | } 69 | else { 70 | $output_dir = tempdir("$t/output__XXXXXXXX"); 71 | } 72 | } 73 | 74 | sub o_dir 75 | { 76 | return $output_dir; 77 | } 78 | 79 | sub del_output_dir 80 | { 81 | File::Path::rmtree($output_dir); 82 | } 83 | 84 | # TODO : this common directory that is deleted and recreated may prevent 85 | # running the tests in parallel. 86 | BEGIN { 87 | if (-d $output_dir) 88 | { 89 | del_output_dir(); 90 | } 91 | File::Path::mkpath($output_dir); 92 | } 93 | 94 | 1; 95 | -------------------------------------------------------------------------------- /test/IO_Dumper.pm: -------------------------------------------------------------------------------- 1 | package IO_Dumper; 2 | use strict; 3 | use warnings; 4 | use IO::All -base; 5 | 6 | our @EXPORT = 'io'; 7 | 8 | sub io { return IO_Dumper->new(@_) }; 9 | 10 | package IO::All::Filesys; 11 | use Data::Dumper; 12 | sub dump { 13 | my $self = shift; 14 | local $Data::Dumper::Indent = 1; 15 | local $Data::Dumper::Sortkeys = 1; 16 | $self->print(Data::Dumper::Dumper(@_)); 17 | return $self; 18 | } 19 | 20 | 1; 21 | -------------------------------------------------------------------------------- /test/RT81224.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 1; 4 | use IO::All -utf8; 5 | my $warnings = 0; 6 | $SIG{__WARN__} = sub { $warnings++ }; 7 | my $img = io("$t/img.jpg")->binary->all; 8 | ok(!$warnings, 'no unicode warnings'); 9 | -------------------------------------------------------------------------------- /test/absolute.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use Test::More tests => 4; 3 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 4 | use IO::All; 5 | use IO_All_Test; 6 | use diagnostics; 7 | 8 | my $io = io($0); 9 | 10 | $io->absolute; 11 | is("$io", File::Spec->rel2abs($0)); 12 | $io->relative; 13 | is($io->pathname, File::Spec->abs2rel($0)); 14 | 15 | ok(io($t)->absolute->next->is_absolute); 16 | 17 | # url like test 18 | { 19 | my $io = io->file($0); 20 | $io->absolute; 21 | is( 22 | $io->relative(io->file($0)->absolute->filepath) 23 | ->os('unix')->name, 24 | "$t/absolute.t", 25 | 'relative with base', 26 | ); 27 | } 28 | 29 | del_output_dir(); 30 | -------------------------------------------------------------------------------- /test/accept.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More tests => 20; 4 | use IO_All_Test; 5 | use IO::All; 6 | use IO::Socket::INET; 7 | 8 | # This test tests for the ability of a non-forking socket to handle more 9 | # than one connection. 10 | 11 | my $pid = fork(); 12 | if (! $pid) 13 | { 14 | # Let the child process listen on a port 15 | my $port = 5555; 16 | my $accepted = 0; 17 | my $start = time; 18 | while (1) 19 | { 20 | # Log the port to a file. 21 | open my $out, ">", o_dir() . "/server-port.t"; 22 | print {$out} $port; 23 | close($out); 24 | 25 | my $server = io("localhost:$port"); 26 | 27 | eval { 28 | for my $count (1 .. 10) 29 | { 30 | my $connection = $server->accept(); 31 | $accepted = 1; 32 | $connection->print(sprintf("Ingy-%.2d", $count)); 33 | $connection->close(); 34 | } 35 | }; 36 | if ($accepted) 37 | { 38 | # We have a listening socket on a port, so we can continue 39 | last; 40 | } 41 | last if time > $start + 10 42 | } 43 | continue 44 | { 45 | # Try a different port. 46 | $port++; 47 | } 48 | exit(0); 49 | } 50 | # Let the parent process handle the testing. 51 | 52 | # Wait a little for the client to find a port. 53 | sleep(1); 54 | 55 | open my $in, "<", o_dir() . "/server-port.t"; 56 | my $port = <$in>; 57 | close($in); 58 | 59 | # TEST*2*10 60 | for my $c (1 .. 10) 61 | { 62 | my $sock = IO::Socket::INET->new( 63 | PeerAddr => "localhost", 64 | PeerPort => $port, 65 | Proto => "tcp" 66 | ); 67 | 68 | ok(defined($sock), "Checking for validity of sock No. $c"); 69 | 70 | if (!defined($sock)) 71 | { 72 | last; 73 | } 74 | 75 | my $data; 76 | $sock->recv($data, 7); 77 | 78 | $sock->close(); 79 | 80 | is ($data, sprintf("Ingy-%.2d", $c), "Checking for connection No. $c."); 81 | } 82 | 83 | waitpid($pid, 0); 84 | 85 | del_output_dir(); 86 | -------------------------------------------------------------------------------- /test/all.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 30; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my $expected1 = "$t/mydir/dir1;$t/mydir/dir2;$t/mydir/file1;$t/mydir/file2;$t/mydir/file3"; 8 | my $expected2 = "$t/mydir/dir1;$t/mydir/dir1/dira;$t/mydir/dir1/file1;$t/mydir/dir2;$t/mydir/dir2/file1;$t/mydir/file1;$t/mydir/file2;$t/mydir/file3"; 9 | my $expected3 = "$t/mydir/dir1;$t/mydir/dir1/dira;$t/mydir/dir1/dira/dirx;$t/mydir/dir1/file1;$t/mydir/dir2;$t/mydir/dir2/file1;$t/mydir/file1;$t/mydir/file2;$t/mydir/file3"; 10 | my $expected4 = "$t/mydir/dir1;$t/mydir/dir1/dira;$t/mydir/dir1/dira/dirx;$t/mydir/dir1/dira/dirx/file1;$t/mydir/dir1/file1;$t/mydir/dir2;$t/mydir/dir2/file1;$t/mydir/file1;$t/mydir/file2;$t/mydir/file3"; 11 | my $expected_files1 = "$t/mydir/file1;$t/mydir/file2;$t/mydir/file3"; 12 | my $expected_files2 = "$t/mydir/dir1/file1;$t/mydir/dir2/file1;$t/mydir/file1;$t/mydir/file2;$t/mydir/file3"; 13 | my $expected_files4 = "$t/mydir/dir1/dira/dirx/file1;$t/mydir/dir1/file1;$t/mydir/dir2/file1;$t/mydir/file1;$t/mydir/file2;$t/mydir/file3"; 14 | my $expected_dirs1 = "$t/mydir/dir1;$t/mydir/dir2"; 15 | my $expected_dirs2 = "$t/mydir/dir1;$t/mydir/dir1/dira;$t/mydir/dir2"; 16 | my $expected_dirs3 = "$t/mydir/dir1;$t/mydir/dir1/dira;$t/mydir/dir1/dira/dirx;$t/mydir/dir2"; 17 | my $expected_filt1 = "$t/mydir/dir1/dira;$t/mydir/dir1/dira/dirx"; 18 | my $expected_filt2 = "$t/mydir/dir1/dira/dirx"; 19 | 20 | sub prep { join ';', grep { not /CVS|\.svn/ } @_ } 21 | 22 | is(prep(io("$t/mydir")->all), f$expected1); 23 | is(prep(io("$t/mydir")->all(1)), f$expected1); 24 | is(prep(io("$t/mydir")->all(2)), f$expected2); 25 | is(prep(io("$t/mydir")->all(3)), f$expected3); 26 | is(prep(io("$t/mydir")->all(4)), f$expected4); 27 | is(prep(io("$t/mydir")->all(5)), f$expected4); 28 | is(prep(io("$t/mydir")->all(0)), f$expected4); 29 | is(prep(io("$t/mydir")->All), f$expected4); 30 | is(prep(io("$t/mydir")->deep->all), f$expected4); 31 | is(prep(io("$t/mydir")->all_files), f$expected_files1); 32 | is(prep(io("$t/mydir")->all_files(1)), f$expected_files1); 33 | is(prep(io("$t/mydir")->all_files(2)), f$expected_files2); 34 | is(prep(io("$t/mydir")->all_files(3)), f$expected_files2); 35 | is(prep(io("$t/mydir")->all_files(4)), f$expected_files4); 36 | is(prep(io("$t/mydir")->all_files(5)), f$expected_files4); 37 | is(prep(io("$t/mydir")->all_files(0)), f$expected_files4); 38 | is(prep(io("$t/mydir")->All_Files), f$expected_files4); 39 | is(prep(io("$t/mydir")->deep->all_files), f$expected_files4); 40 | is(prep(io("$t/mydir")->All_Files(2)), f$expected_files4); 41 | is(prep(io("$t/mydir")->all_dirs), f$expected_dirs1); 42 | is(prep(io("$t/mydir")->all_dirs(1)), f$expected_dirs1); 43 | is(prep(io("$t/mydir")->all_dirs(2)), f$expected_dirs2); 44 | is(prep(io("$t/mydir")->all_dirs(3)), f$expected_dirs3); 45 | is(prep(io("$t/mydir")->all_dirs(4)), f$expected_dirs3); 46 | is(prep(io("$t/mydir")->all_dirs(5)), f$expected_dirs3); 47 | is(prep(io("$t/mydir")->all_dirs(0)), f$expected_dirs3); 48 | is(prep(io("$t/mydir")->All_Dirs), f$expected_dirs3); 49 | is(prep(io("$t/mydir")->deep->all_dirs), f$expected_dirs3); 50 | is(prep(io("$t/mydir")->filter(sub {/dira/})->All_Dirs), f$expected_filt1); 51 | is(prep(io("$t/mydir")->filter(sub {/x/})->All_Dirs), f$expected_filt2); 52 | 53 | del_output_dir(); 54 | -------------------------------------------------------------------------------- /test/all2.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 2; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | test_file_contents(io->file("$t/all2.t")->all, "$t/all2.t"); 8 | test_file_contents(io->file("$t/all2.t")->scalar, "$t/all2.t"); 9 | 10 | del_output_dir(); 11 | -------------------------------------------------------------------------------- /test/append.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | plan((lc($^O) eq 'mswin32' and defined $ENV{PERL5_CPANPLUS_IS_RUNNING}) 8 | ? (skip_all => "CPANPLUS/MSWin32 breaks this") 9 | : ($] < 5.008003) 10 | ? (skip_all => 'Broken on older perls') 11 | : (tests => 4) 12 | ); 13 | 14 | { 15 | my $log = io->file(o_dir() . "/myappend.txt")->mode('>>')->open(); 16 | 17 | $log->print("Hello World!\n"); 18 | 19 | $log->close(); 20 | } 21 | 22 | { 23 | # TEST 24 | ok (scalar(-f o_dir() . "/myappend.txt"), "myappend.txt exists."); 25 | 26 | my $contents = _slurp(o_dir() . "/myappend.txt"); 27 | 28 | # TEST 29 | is ($contents, "Hello World!\n", "contents of the file are OK."); 30 | } 31 | 32 | 33 | { 34 | my $log = io->file(o_dir() . "/myappend.txt")->mode('>>')->open(); 35 | 36 | $log->print("Message No. 2!\n"); 37 | 38 | $log->close(); 39 | } 40 | 41 | { 42 | # TEST 43 | ok (scalar(-f o_dir() . "/myappend.txt"), "myappend.txt exists."); 44 | 45 | my $contents = _slurp(o_dir() . "/myappend.txt"); 46 | 47 | # TEST 48 | is ($contents, "Hello World!\nMessage No. 2!\n", 49 | "Second append was ok."); 50 | } 51 | 52 | sub _slurp 53 | { 54 | my $filename = shift; 55 | 56 | open my $in, "<", $filename 57 | or die "Cannot open '$filename' for slurping - $!"; 58 | 59 | local $/; 60 | my $contents = <$in>; 61 | 62 | close($in); 63 | 64 | return $contents; 65 | } 66 | 67 | del_output_dir(); 68 | -------------------------------------------------------------------------------- /test/assert.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More tests => 8; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | use Cwd qw(getcwd); 8 | 9 | { 10 | ok(not -e o_dir() . '/newpath/hello.txt'); 11 | ok(not -e o_dir() . '/newpath'); 12 | my $io = io(o_dir() . '/newpath/hello.txt')->assert; 13 | ok(not -e o_dir() . '/newpath'); 14 | "Hello\n" > $io; 15 | ok(-f o_dir() . '/newpath/hello.txt'); 16 | } 17 | 18 | { 19 | my $orig_path = getcwd(); 20 | 21 | chdir(o_dir() . '/newpath'); 22 | # Bug http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=733680 23 | "Hello" > io->file('foobar')->assert; 24 | 25 | ok( -f 'foobar'); 26 | is( scalar (-s 'foobar'), 5); 27 | 28 | "12345678" > io->file('./1_8')->assert; 29 | 30 | ok( -f '1_8', "Dot-slash-assert."); 31 | is( scalar (-s '1_8'), 8, "Size is 8."); 32 | 33 | chdir($orig_path); 34 | } 35 | 36 | del_output_dir(); 37 | -------------------------------------------------------------------------------- /test/assert2.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More tests => 4; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | ok(io(o_dir() . '/xxx/yyy/zzz.db')->dbm->assert->{foo} = "bar"); 8 | ok( 9 | -f o_dir() . '/xxx/yyy/zzz.db' or 10 | -f o_dir() . '/xxx/yyy/zzz.db.dir' or 11 | -f o_dir() . '/xxx/yyy/zzz.db.db' 12 | ); 13 | SKIP: { 14 | skip "requires MLDBM", 2 15 | unless eval { require MLDBM; 1}; 16 | ok(io(o_dir() . '/xxx/yyy/zzz2.db')->assert->mldbm->{foo} = ["bar"]); 17 | ok(-f o_dir() . '/xxx/yyy/zzz2.db' or -f o_dir() . '/xxx/yyy/zzz.db.dir'); 18 | } 19 | del_output_dir(); 20 | -------------------------------------------------------------------------------- /test/autotie.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use File::Spec::Functions; 4 | use Test::More; 5 | use IO::All; 6 | use IO_All_Test; 7 | 8 | my $f = catfile($t, 'mystuff'); 9 | my @lines = read_file_lines($f); 10 | plan(tests => 1 + @lines + 1 + 7); 11 | 12 | { 13 | my $io = io($f)->tie; 14 | is($io->autoclose(0) . '', $f); 15 | while (<$io>) { 16 | is($_, shift @lines); 17 | } 18 | ok(close $io); 19 | } 20 | 21 | { 22 | my $f = catfile($t, 'mystuff2'); 23 | my @lines = ('This ', 'is ', 'a ', 'silly ', "example\n"); 24 | my $io = io($f)->separator(q( ))->tie; 25 | is($io->autoclose(0) . '', $f); 26 | while (<$io>) { 27 | is($_, shift @lines, $_); 28 | } 29 | ok(close $io); 30 | } 31 | 32 | del_output_dir(); 33 | -------------------------------------------------------------------------------- /test/backwards.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | plan((eval {require File::ReadBackwards; 1}) 8 | ? (tests => 2) 9 | : (skip_all => "requires File::ReadBackwards") 10 | ); 11 | 12 | my @reversed; 13 | my $io = io("$t/mystuff"); 14 | $io->backwards; 15 | while (my $line = $io->getline) { 16 | push @reversed, $line; 17 | } 18 | 19 | test_file_contents(join('', reverse @reversed), "$t/mystuff"); 20 | 21 | @reversed = io("$t/mystuff")->backwards->getlines; 22 | 23 | test_file_contents(join('', reverse @reversed), "$t/mystuff"); 24 | 25 | del_output_dir(); 26 | -------------------------------------------------------------------------------- /test/binary_utf8.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use utf8; 4 | 5 | use Test::More tests => 8; 6 | 7 | use IO::All; 8 | use IO_All_Test; 9 | 10 | my $f = io->file(o_dir(), 'binary_utf8')->name; 11 | 12 | io($f)->open('>')->binary->binmode('crlf')->print("\n"); 13 | is(-s $f, 2, "layers of a filehandle are correctly edited if defined after opening it"); 14 | 15 | io($f)->binary->binmode('crlf')->print("\n"); 16 | is(-s $f, 2, "layers of a filehandle are correctly edited if defined before opening it"); 17 | 18 | io($f)->binary->utf8->print("\n"); 19 | is(-s $f, 1, "a filehandle marked binary should never mangle newlines"); 20 | 21 | io($f)->open('>')->binary->encoding('UTF-8')->print("ö\n"); 22 | is(-s $f, 3, ":raw and utf8 encoding work correctly if defined after opening fh"); 23 | 24 | io($f)->binary->encoding('UTF-8')->print("ö\n"); 25 | is(-s $f, 3, ":raw and utf8 encoding work correctly if defined before opening fh"); 26 | 27 | io($f)->open('>')->binmode->encoding('UTF-8')->print("ö\n"); 28 | is(-s $f, 3, "binmode functions correctly without args after opening it"); 29 | 30 | io($f)->encoding('UTF-8')->binmode->print("ö\n"); 31 | is(-s $f, 2, "binmode functions correctly without args before opening it"); 32 | 33 | io($f)->binary->encoding('UTF-8')->binmode->print("ö\n"); 34 | is(-s $f, 2, "binmode functions correctly without args before opening it"); 35 | 36 | del_output_dir(); 37 | -------------------------------------------------------------------------------- /test/chdir.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 1; 4 | use IO::All; 5 | use IO_All_Test; 6 | use Cwd; 7 | 8 | { 9 | my $dir = io($t)->chdir; 10 | is((io(io->curdir->absolute->pathname)->splitdir)[-1], $t); 11 | } 12 | 13 | del_output_dir(); 14 | -------------------------------------------------------------------------------- /test/chomp.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More 'no_plan'; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my $io = io("$t/chomp.t")->chomp; 8 | for ($io->slurp) { 9 | ok(not /\n/); 10 | } 11 | $io->close; 12 | 13 | for ($io->chomp->separator('io')->getlines) { 14 | ok(not /io/); 15 | } 16 | 17 | del_output_dir(); 18 | -------------------------------------------------------------------------------- /test/construct.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 18; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my $io1 = IO::All->new("$t/mystuff"); 8 | is(ref($io1), 'IO::All::File'); 9 | test_file_contents($$io1, "$t/mystuff"); 10 | 11 | my $io2 = io("$t/mystuff"); 12 | is(ref($io2), 'IO::All::File'); 13 | test_file_contents($$io2, "$t/mystuff"); 14 | 15 | my $io3 = io->file("$t/mystuff"); 16 | is(ref($io3), 'IO::All::File'); 17 | test_file_contents($$io3, "$t/mystuff"); 18 | 19 | my $io4 = $io3->file("$t/construct.t"); 20 | is(ref($io4), 'IO::All::File'); 21 | test_file_contents($$io4, "$t/construct.t"); 22 | 23 | my $io5 = io->dir("$t/mydir"); 24 | is(ref($io5), 'IO::All::Dir'); 25 | is(join('+', map $_->filename, grep {! /CVS|\.svn/} $io5->all), 'dir1+dir2+file1+file2+file3'); 26 | 27 | my $io6 = io->rdonly->new->file("$t/construct.t"); 28 | ok($io6->_rdonly); 29 | 30 | SKIP: { 31 | eval {require Tie::File}; 32 | skip "requires Tie::File", 1 if $@; 33 | 34 | test_file_contents(join('', map {"$_\n"} @$io6), "$t/construct.t"); 35 | } 36 | 37 | my $io7 = io->socket('foo.com:80')->get_socket_domain_port; 38 | ok($io7->is_socket); 39 | is($io7->domain, 'foo.com'); 40 | is($io7->port, '80'); 41 | 42 | my $io8 = io(':8000')->get_socket_domain_port; 43 | ok($io8->is_socket); 44 | is($io8->domain, 'localhost'); 45 | is($io8->port, '8000'); 46 | 47 | del_output_dir(); 48 | -------------------------------------------------------------------------------- /test/copy.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 4; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my $ret = io->file("$t/img.jpg")->copy(o_dir() . '/img.jpg'); 8 | ok(io->file("$t/img.jpg")->binary->all eq $ret->binary->all, 'file copied correctly'); 9 | is(f($ret->name), f(io->file(o_dir(), 'img.jpg')->name), 'copy returns new obj'); 10 | 11 | SKIP: { 12 | skip 'requires File::Copy::Recursive', 2 13 | unless eval { require File::Copy::Recursive; 1 }; 14 | 15 | my $lib = io->dir('lib'); 16 | my $ret = $lib->copy(o_dir() . '/station'); 17 | my $orig =()= $lib->All; 18 | my $new =()= $ret->All; 19 | is($new, $orig, 'dir copied correctly'); 20 | is($ret->name, io->dir(o_dir() . '/station')->name, 'copy returns new obj'); 21 | }; 22 | 23 | del_output_dir(); 24 | -------------------------------------------------------------------------------- /test/data/head_test.txt: -------------------------------------------------------------------------------- 1 | 1 2 | 2 3 | 0 4 | 3 5 | 4 6 | 5 7 | 6 8 | 7 9 | 8 10 | 9 11 | 10 12 | 11 13 | 12 14 | 13 15 | 14 16 | 15 17 | 16 18 | 17 19 | 18 20 | 19 21 | 20 22 | -------------------------------------------------------------------------------- /test/dbm.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | 4 | my $db_file; 5 | BEGIN { 6 | use Config; 7 | foreach (qw/SDBM_File GDBM_File ODBM_File NDBM_File DB_File/) { 8 | if ($Config{extensions} =~ /\b$_\b/) { 9 | $db_file = $_; 10 | last; 11 | } 12 | } 13 | } 14 | 15 | use Test::More defined($db_file) 16 | ? (tests => 2) 17 | : (skip_all => 'No DBM modules available'); 18 | 19 | use IO::All; 20 | use IO_All_Test; 21 | 22 | { 23 | my $db = io(o_dir() . '/mydbm')->dbm($db_file); 24 | $db->{fortytwo} = 42; 25 | $db->{foo} = 'bar'; 26 | 27 | is(join('', sort keys %$db), 'foofortytwo'); 28 | is(join('', sort values %$db), '42bar'); 29 | } 30 | 31 | del_output_dir(); 32 | -------------------------------------------------------------------------------- /test/devnull.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More tests => 2; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | ok("xxx" > io->devnull); 8 | ok(io->devnull->print("yyy")); 9 | 10 | del_output_dir(); 11 | -------------------------------------------------------------------------------- /test/empty.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More tests => 5; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my $d = io(o_dir() . '/empty'); 8 | ok($d->mkdir); 9 | ok($d->empty); 10 | 11 | my $f = io(o_dir() . '/file'); 12 | ok($f->touch->touch); 13 | ok($f->empty); 14 | 15 | eval {io('qwerty')->empty}; 16 | like($@, qr"Can't call empty"); 17 | 18 | 19 | del_output_dir(); 20 | -------------------------------------------------------------------------------- /test/encoding.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More; 4 | use IO_All_Test; 5 | 6 | BEGIN { 7 | eval { require PerlIO::encoding }; 8 | plan(skip_all => 'no PerlIO::encoding') if $@; 9 | plan(($] < 5.008003) 10 | ? (skip_all => 'Broken on older perls') 11 | : (tests => 4) 12 | ); 13 | } 14 | 15 | package Normal; 16 | 17 | use IO::All; 18 | 19 | package UTF8; 20 | 21 | use IO::All -utf8; 22 | 23 | package Big5; 24 | 25 | use IO::All -encoding => 'big5'; 26 | 27 | package main; 28 | 29 | isnt Normal::io("$t/text.big5")->all, 30 | Normal::io("$t/text.utf8")->all, 31 | 'big5 and utf8 tests are different'; 32 | 33 | isnt Normal::io("$t/text.big5")->all, 34 | Big5::io("$t/text.big5")->all, 35 | 'Read big5 with different io-s does not match'; 36 | 37 | is UTF8::io("$t/text.utf8")->all, 38 | Big5::io("$t/text.big5")->all, 39 | 'Big5 text matches utf8 text after read'; 40 | 41 | is Normal::io("$t/text.utf8")->utf8->all, 42 | Normal::io("$t/text.big5")->encoding('big5')->all, 43 | 'Big5 text matches utf8 text after read'; 44 | 45 | 46 | del_output_dir(); 47 | -------------------------------------------------------------------------------- /test/error1.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More tests => 2; 4 | use IO::All; 5 | 6 | my $t1 = io('quack'); 7 | eval { 8 | $t1->slurp; 9 | }; 10 | like($@, qr{^Can't open file 'quack' for input:}); 11 | 12 | my $t2 = io('t/xxxxx'); 13 | eval { 14 | $t2->next; 15 | }; 16 | like($@, qr{^Can't open directory 't/xxxxx':}); 17 | -------------------------------------------------------------------------------- /test/file_spec.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 33; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my $path = f("$t/file_spec.t"); 8 | like(io("././$t/file_spec.t")->canonpath, qr/\Q$path\E$/, 'give full canonical path for real files' ); 9 | is(io("././$t/file_spec.t")->ext, 't'); 10 | is(io("././$t/file_spec.t")->extension, 't'); 11 | $path = f("$t/bogus"); 12 | like(io("././$t/bogus")->canonpath, qr/\Q$path\E$/, 'give full canonical path for files that could exist'); 13 | is(join(';', grep {! /CVS|\.svn/} io->catdir($t, 'mydir')->all), f "$t/mydir/dir1;$t/mydir/dir2;$t/mydir/file1;$t/mydir/file2;$t/mydir/file3"); 14 | test_file_contents(io->catfile($t, 'mystuff')->scalar, "$t/mystuff"); 15 | test_file_contents(io->join($t, 'mystuff')->scalar, "$t/mystuff"); 16 | is(ref(io->devnull), 'IO::All::File'); 17 | ok(io->devnull->print('IO::All')); 18 | # Not supporting class calls anymore. Objects only. 19 | # ok(IO::All->devnull->print('IO::All')); 20 | ok(io->rootdir->is_dir); 21 | ok(io->tmpdir->is_dir); 22 | ok(io->updir->is_dir); 23 | like(io->case_tolerant, qr/^[01]$/); 24 | ok(io('/foo/bar')->is_absolute); 25 | ok(not io('foo/bar')->is_absolute); 26 | { 27 | # if this fails on other OSes more examples for PATH will need to be made 28 | local $ENV{PATH} = 29 | $^O eq 'MSWin32' 30 | ? 'C:\PROGRAM FILES\COMMON FILES\MICROSOFT SHARED\WINDOWS LIVE;C:\PROGRAM FILES (X86)\COMMON FILES\MICROSOFT SHARED\WINDOWS LIVE;C:\PROGRAM FILES (X86)\INTEL\ICLS CLIENT\;C:\PROGRAM FILES\INTEL\ICLS CLIENT\;C:\Windows\SYSTEM32;C:\Windows;C:\Windows\SYSTEM32\WBEM;C:\Windows\SYSTEM32\WINDOWSPOWERSHELL\V1.0\;;C:\PROGRAM FILES (X86)\INTEL\OPENCL SDK\2.0\BIN\X86;C:\PROGRAM FILES (X86)\INTEL\OPENCL SDK\2.0\BIN\X64;C:\PROGRAM FILES\COMMON FILES\LENOVO;C:\PROGRAM FILES (X86)\WINDOWS LIVE\SHARED;C:\PROGRAM FILES (X86)\LENOVO\ACCESS CONNECTIONS\;C:\SWTOOLS\READYAPPS;C:\PROGRAM FILES (X86)\SYMANTEC\VIP ACCESS CLIENT\;C:\PROGRAM FILES (X86)\COMMON FILES\LENOVO;C:\PROGRAM FILES\INTEL\INTEL(R) MANAGEMENT ENGINE COMPONENTS\DAL;C:\PROGRAM FILES\INTEL\INTEL(R) MANAGEMENT ENGINE COMPONENTS\IPT;C:\PROGRAM FILES (X86)\INTEL\INTEL(R) MANAGEMENT ENGINE COMPONENTS\DAL;C:\PROGRAM FILES (X86)\INTEL\INTEL(R) MANAGEMENT ENGINE COMPONENTS\IPT;C:\PROGRAM FILES\INTEL\WIFI\BIN\;C:\PROGRAM FILES\COMMON FILES\INTEL\WIRELESSCOMMON\;C:\Program Files\ThinkPad\Bluetooth Software\;C:\Program Files\ThinkPad\Bluetooth Software\syswow64;C:\Program Files\MiKTeX 2.9\miktex\bin\x64\;C:\Dwimperl\perl\bin;C:\Dwimperl\perl\site\bin;C:\Dwimperl\c\bin;C:\Program Files\Intel\WiFi\bin\;C:\Program Files\Common Files\Intel\WirelessCommon' 31 | : '/home/frew/.plenv/bin:/home/frew/node/bin::/home/frew/code/git-super-status/bin:/opt/bin:/home/frew/code/teatime/bin:/home/frew/bin:/home/frew/code/dotfiles/bin:/home/frew/Dropbox/bin:/home/frew/Dropbox/go/bin:/home/frew/Dropbox/node/bin:/opt/bin:/home/frew/.plenv/bin:/home/frew/node/bin:/home/frew/code/git-super-status/bin:/opt/bin:/home/frew/code/teatime/bin:/home/frew/bin:/home/frew/code/dotfiles/bin:/home/frew/Dropbox/bin:/home/frew/Dropbox/go/bin:/home/frew/Dropbox/node/bin:/home/frew/.plenv/shims:/home/frew/perl5/perlbrew/bin:/home/frew/perl5/perlbrew/perls/perl-5.16.0/bin:/usr/lib/lightdm/lightdm:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/home/frew/.zsh/adenosine/bin:/home/frew/.zsh/adenosine/bin'; 32 | my $expected = $^O eq 'MSWin32' ? 31 : 36; 33 | my @path1 = io->path; 34 | is scalar( @path1 ), $expected, "expected amount of PATH entries returned"; 35 | } 36 | my ($v, $d, $f) = io('foo/bar')->splitpath; 37 | is($d, 'foo/'); 38 | is($f, 'bar'); 39 | my @dirs = io('foo/bar/baz')->splitdir; 40 | is(scalar(@dirs), 3); 41 | is(join('+', @dirs), 'foo+bar+baz'); 42 | test_file_contents(io->catpath('', $t, 'mystuff')->scalar, "$t/mystuff"); 43 | is(io('/foo/bar/baz')->abs2rel('/foo'), f 'bar/baz'); 44 | is(io('foo/bar/baz')->rel2abs('/moo'), f '/moo/foo/bar/baz'); 45 | 46 | is("".io->dir('doo/foo')->catdir('goo', 'hoo'), f 'doo/foo/goo/hoo'); 47 | is("".io->dir->catdir('goo', 'hoo'), f 'goo/hoo'); 48 | is("".io->catdir('goo', 'hoo'), f 'goo/hoo'); 49 | 50 | is("".io->file('doo/foo')->catfile('goo', 'hoo'), f 'doo/foo/goo/hoo'); 51 | is("".io->file->catfile('goo', 'hoo'), f 'goo/hoo'); 52 | is("".io->catfile('goo', 'hoo'), f 'goo/hoo'); 53 | 54 | is("".io->file('goo', 'hoo', 'bar.txt'), f 'goo/hoo/bar.txt'); 55 | is("".io->dir('goo', 'hoo'), f 'goo/hoo'); 56 | 57 | is("".io->dir('goo', 'hoo')->dir('boo', 'foo'), f 'goo/hoo/boo/foo'); 58 | is("".io->dir('goo', 'hoo')->dir('boo'), f 'goo/hoo/boo'); 59 | del_output_dir(); 60 | -------------------------------------------------------------------------------- /test/file_subclass.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More tests => 5; 4 | use IO_Dumper; 5 | use IO_All_Test; 6 | 7 | my $hash = { 8 | red => 'square', 9 | yellow => 'circle', 10 | pink => 'triangle', 11 | }; 12 | 13 | my $io = io->file(o_dir() . '/dump2')->dump($hash); 14 | ok(-f o_dir() . '/dump2'); 15 | ok($io->close); 16 | ok(-s o_dir() . '/dump2'); 17 | 18 | my $VAR1; 19 | my $a = do './' . (o_dir() . '/dump2'); 20 | my $b = eval join('',); 21 | is_deeply($a,$b); 22 | 23 | ok($io->unlink); 24 | 25 | del_output_dir(); 26 | 27 | package main; 28 | __END__ 29 | $VAR1 = { 30 | 'pink' => 'triangle', 31 | 'red' => 'square', 32 | 'yellow' => 'circle' 33 | }; 34 | -------------------------------------------------------------------------------- /test/fileno.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | plan((lc($^O) eq 'mswin32' and defined $ENV{PERL5_CPANPLUS_IS_RUNNING}) 8 | ? (skip_all => "CPANPLUS/MSWin32 breaks this") 9 | : ($] < 5.008003) 10 | ? (skip_all => 'Broken on older perls') 11 | : (tests => 7) 12 | ); 13 | 14 | is(io('-')->mode('<')->open->fileno, 0); 15 | is(io('-')->mode('>')->open->fileno, 1); 16 | is(io('=')->fileno, 2); 17 | 18 | is(io->stdin->fileno, 0); 19 | is(io->stdout->fileno, 1); 20 | is(io->stderr->fileno, 2); 21 | 22 | ok(io(o_dir() . '/xxx')->open('>')->fileno > 2); 23 | 24 | 25 | del_output_dir(); 26 | -------------------------------------------------------------------------------- /test/glob.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 1; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my @foo = sort map $_->filename, 8 | io()->dir($t, 'mydir')->glob('f*'); 9 | is_deeply(\@foo, [qw( file1 file2 file3 )]); 10 | 11 | del_output_dir(); 12 | -------------------------------------------------------------------------------- /test/head.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use File::Spec; 7 | use Test::More tests => 2; 8 | 9 | use IO::All; 10 | 11 | my $t = -e 't' ? 't' : 'test'; 12 | my $fn = File::Spec->catfile(File::Spec->curdir, $t, 'data', 'head_test.txt'); 13 | 14 | { 15 | # See: https://github.com/ingydotnet/io-all-pm/issues/44 16 | 17 | # TEST 18 | is_deeply( 19 | [io->file($fn)->chomp->head()], 20 | [qw( 21 | 1 22 | 2 23 | 0 24 | 3 25 | 4 26 | 5 27 | 6 28 | 7 29 | 8 30 | 9 31 | ) 32 | ], 33 | "Read the first 10 lines with chomp (should not stop at 0).", 34 | ); 35 | 36 | # TEST 37 | is_deeply( 38 | [io->file($fn)->chomp->head(5)], 39 | [qw( 40 | 1 41 | 2 42 | 0 43 | 3 44 | 4 45 | ) 46 | ], 47 | "Read the first 5 lines.", 48 | ); 49 | } 50 | 51 | -------------------------------------------------------------------------------- /test/img.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ingydotnet/io-all-pm/2c8ab8f4ec5cf2c6c44cc0bfdb8b8ff50a01eeb9/test/img.jpg -------------------------------------------------------------------------------- /test/import_flags.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More; 4 | use IO_All_Test; 5 | 6 | BEGIN { 7 | plan(($] < 5.008003) 8 | ? (skip_all => 'Broken on older perls') 9 | : (tests => 16) 10 | ); 11 | } 12 | 13 | package One; 14 | use IO::All -strict; 15 | 16 | 17 | package Two; 18 | use IO::All -utf8; 19 | 20 | 21 | package Three; 22 | use IO::All -strict, -utf8; 23 | 24 | 25 | package Four; 26 | use IO::All -foo; 27 | 28 | 29 | package main; 30 | main::ok(defined &One::io, 'io is exported to One'); 31 | main::ok(defined &Two::io, 'io is exported to Two'); 32 | main::ok(defined &Three::io, 'io is exported to Three'); 33 | main::ok(defined &Four::io, 'io is exported to Four'); 34 | 35 | my $io1 = One::io('xxx'); 36 | ok $io1->_strict, 37 | 'strict flag set on object 1'; 38 | ok not($io1->_has_utf8), 39 | 'utf8 flag not set on object 1'; 40 | 41 | my $io2 = Two::io('xxx'); 42 | ok not($io2->_strict), 43 | 'strict flag not set on object 2'; 44 | ok $io2->_has_utf8, 45 | 'utf8 flag set on object 2'; 46 | 47 | my $io3 = Three::io('xxx'); 48 | ok $io3->_strict, 49 | 'strict flag set on object 3'; 50 | ok $io3->_has_utf8, 51 | 'utf8 flag set on object 3'; 52 | 53 | eval "Four::io('xxx')"; 54 | like $@, qr/Can't find a class for method 'foo'/, 55 | '-foo flag causes error'; 56 | 57 | my $io2b = $io2->catfile('yyy'); 58 | is $io2b->name, f('xxx/yyy'), 59 | 'catfile name is correct'; 60 | ok not($io2b->_strict), 61 | 'strict flag not set on object 2b (propagated from 2)'; 62 | ok $io2b->_has_utf8, 63 | 'utf8 flag set on object 2b (propagated from 2)'; 64 | 65 | my $io2c = Two::io('aaa')->curdir; 66 | # use Data::Dumper; 67 | # die Dumper \%{*$io2c}; 68 | ok not($io2c->_strict), 69 | 'strict flag not set on object 2c (propagated from 2)'; 70 | ok $io2c->_has_utf8, 71 | 'utf8 flag set on object 2c (propagated from 2)'; 72 | 73 | 74 | del_output_dir(); 75 | -------------------------------------------------------------------------------- /test/in-place.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More tests => 5; 7 | use IO::All; 8 | use File::Temp qw/tempdir/; 9 | 10 | { 11 | my $tempdir = tempdir( CLEANUP => 1); 12 | 13 | my $f = sub { return io->catfile($tempdir, 'test.txt') }; 14 | 15 | $f->()->print(<<'EOF'); 16 | #One 17 | #Two 18 | #Three 19 | #Four 20 | EOF 21 | 22 | # Test that the array overloading of IO::All can be modified to 23 | # produce new contents. 24 | foreach my $line (@{$f->()}) 25 | { 26 | # TEST*4 27 | ok (($line =~ s{\A#}{}), 'Done substitution.'); 28 | } 29 | 30 | # TEST 31 | is (scalar($f->()->slurp()), <<'EOF', 'File contents were modified.'); 32 | One 33 | Two 34 | Three 35 | Four 36 | EOF 37 | } 38 | -------------------------------------------------------------------------------- /test/inline_subclass.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | 4 | package IO::Dumper; 5 | use IO::All -base; 6 | use Data::Dumper; 7 | 8 | our @EXPORT = 'io'; 9 | 10 | sub io { return IO::Dumper->new(@_) }; 11 | 12 | package IO::All::Filesys; 13 | sub dump { 14 | my $self = shift; 15 | $self->print(Data::Dumper::Dumper(@_)); 16 | return $self; 17 | } 18 | 19 | package main; 20 | use Test::More tests => 5; 21 | use IO_All_Test; 22 | 23 | IO::Dumper->import; 24 | 25 | my $hash = { 26 | red => 'square', 27 | yellow => 'circle', 28 | pink => 'triangle', 29 | }; 30 | 31 | die if -f o_dir() . '/dump1'; 32 | my $io = io(o_dir() . '/dump1')->file->dump($hash); 33 | ok(-f o_dir() . '/dump1'); 34 | ok($io->close); 35 | ok(-s o_dir() . '/dump1'); 36 | 37 | my $VAR1; 38 | my $a = do './' . (o_dir() . '/dump1'); 39 | my $b = eval join('',); 40 | is_deeply($a,$b); 41 | 42 | ok($io->unlink); 43 | 44 | del_output_dir(); 45 | 46 | __END__ 47 | $VAR1 = { 48 | 'pink' => 'triangle', 49 | 'red' => 'square', 50 | 'yellow' => 'circle' 51 | }; 52 | -------------------------------------------------------------------------------- /test/input.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 12; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | io("$t/input.t") > my $contents; 8 | test_file_contents($contents, "$t/input.t"); 9 | 10 | $contents < io "$t/input.t"; 11 | test_file_contents($contents, "$t/input.t"); 12 | 13 | my $io = io "$t/input.t"; 14 | $contents = $$io; 15 | test_file_contents($contents, "$t/input.t"); 16 | 17 | $contents = $io->slurp; 18 | test_file_contents($contents, "$t/input.t"); 19 | 20 | $contents = $io->scalar; 21 | test_file_contents($contents, "$t/input.t"); 22 | 23 | $contents = join '', $io->getlines; 24 | test_file_contents($contents, "$t/input.t"); 25 | 26 | SKIP: { 27 | eval {require Tie::File}; 28 | skip "requires Tie::File", 2 if $@; 29 | 30 | $io->rdonly; 31 | $contents = join '', map "$_\n", @$io; 32 | test_file_contents($contents, "$t/input.t"); 33 | $io->close; 34 | 35 | $io->tie; 36 | $contents = join '', <$io>; 37 | test_file_contents($contents, "$t/input.t"); 38 | } 39 | 40 | my @lines = io("$t/input.t")->slurp; 41 | ok(@lines > 36); 42 | test_file_contents(join('', @lines), "$t/input.t"); 43 | 44 | my $old_contents = $contents; 45 | $contents << io("$t/input.t"); 46 | is($contents, $old_contents . $old_contents); 47 | 48 | is(io("$t/input.t") >> $contents, ($old_contents x 3)); 49 | 50 | del_output_dir(); 51 | -------------------------------------------------------------------------------- /test/link.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More; 4 | use IO::All; 5 | use IO_All_Test; 6 | use Cwd qw(abs_path); 7 | 8 | my $cwd = abs_path('.'); 9 | eval { symlink("$cwd/lib/IO/All.pm", o_dir() . '/IO-All-file-link') or die $! }; 10 | 11 | if ($@ or not (-e o_dir() . '/IO-All-file-link' and -l o_dir() . '/IO-All-file-link')) { 12 | plan skip_all => 'Cannot call symlink on this platform'; 13 | } 14 | else { 15 | plan tests => 7; 16 | } 17 | 18 | my $file_link = io(o_dir() . '/IO-All-file-link'); 19 | ok($file_link->is_link, 'Link to file is a link (not a file)'); 20 | my $file_target = $file_link->readlink; 21 | ok(! $file_target->is_link, 'readlink returns file object, not link' ); 22 | is($file_target->filename, 'All.pm', 'link target is expected file' ); 23 | 24 | symlink("$cwd/lib/IO", o_dir() . '/IO-All-dir-link'); 25 | 26 | my $dir_link = io(o_dir() . '/IO-All-dir-link'); 27 | ok($dir_link->is_link, 'Link to dir is a link (not a dir)'); 28 | my $dir_target = $dir_link->readlink; 29 | ok(! $dir_target->is_link, 'readlink returns dir object, not link' ); 30 | ok($dir_target->is_dir, 'readlink returns dir object, not link' ); 31 | is($dir_target->filename, 'IO', 'link target is expected dir' ); 32 | 33 | 34 | 35 | del_output_dir(); 36 | -------------------------------------------------------------------------------- /test/link2.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More; 4 | use IO::All; 5 | use IO_All_Test; 6 | use Cwd qw(abs_path); 7 | 8 | my $linkname = o_dir() . '/mylink'; 9 | 10 | my $cwd = abs_path('.'); 11 | eval { symlink("$t/mydir", $linkname) or die $! }; 12 | 13 | if ($@ or not -l $linkname) { 14 | plan skip_all => 'Cannot call symlink on this platform'; 15 | } 16 | else { 17 | plan tests => 2; 18 | } 19 | 20 | my $io = io($linkname); 21 | 22 | my @files = $io->all_files; 23 | is(scalar @files, 3); 24 | 25 | @files = $io->All_Files; 26 | is(scalar @files, 6); 27 | 28 | 29 | del_output_dir(); 30 | -------------------------------------------------------------------------------- /test/lock.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use IO::All; 4 | use IO_All_Test; 5 | 6 | # XXX This needs to be fixed!!! 7 | $^O !~ /^(cygwin|hpux)$/ 8 | ? print "1..3\n" 9 | : do { print "1..0 # skip - locking problems on $^O\n"; exit(0) }; 10 | 11 | { 12 | my $io1 = io(o_dir() . '/foo')->lock; 13 | $io1->println('line 1'); 14 | 15 | my $pid; 16 | ($pid = fork) or do { 17 | my $io2 = io(o_dir() . '/foo')->lock; 18 | foreach (1 .. 3) { 19 | print "not " unless($io2->getline eq "line $_\n"); 20 | print "ok $_\n"; 21 | } 22 | exit; 23 | }; 24 | 25 | sleep 1; 26 | $io1->println('line 2'); 27 | $io1->println('line 3'); 28 | $io1->unlock; 29 | 30 | waitpid($pid, 0); 31 | } 32 | 33 | del_output_dir(); 34 | 35 | 1; 36 | -------------------------------------------------------------------------------- /test/mldbm.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | plan((eval {require MLDBM; 1}) 8 | ? (tests => 4) 9 | : (skip_all => "requires MLDBM") 10 | ); 11 | 12 | my $io = io(o_dir() . '/mldbm')->mldbm('SDBM_File', 'Data::Dumper'); 13 | $io->{test} = { qw( foo foolsgold bar bargain baz bazzarro ) }; 14 | $io->{test2} = [ 1..4 ]; 15 | $io->close; 16 | 17 | my $io2 = io(o_dir() . '/mldbm')->mldbm('SDBM_File', 'Data::Dumper'); 18 | is(scalar(@{[%$io2]}), 4); 19 | is(scalar(@{[%{$io2->{test}}]}), 6); 20 | is($io2->{test}{bar}, 'bargain'); 21 | is($io2->{test2}[3], 4); 22 | 23 | 24 | del_output_dir(); 25 | -------------------------------------------------------------------------------- /test/morestuff: -------------------------------------------------------------------------------- 1 | More stuff 2 | is pure fluff. 3 | Off the cuff. 4 | -------------------------------------------------------------------------------- /test/mydir/dir1/dira/dirx/file1: -------------------------------------------------------------------------------- 1 | test 2 | -------------------------------------------------------------------------------- /test/mydir/dir1/file1: -------------------------------------------------------------------------------- 1 | file1 is fun 2 | yo 3 | -------------------------------------------------------------------------------- /test/mydir/dir2/file1: -------------------------------------------------------------------------------- 1 | file1 is fun 2 | yo 3 | -------------------------------------------------------------------------------- /test/mydir/file1: -------------------------------------------------------------------------------- 1 | file1 is fun 2 | yo 3 | -------------------------------------------------------------------------------- /test/mydir/file2: -------------------------------------------------------------------------------- 1 | file2 is woohoo 2 | yo 3 | -------------------------------------------------------------------------------- /test/mydir/file3: -------------------------------------------------------------------------------- 1 | file3 is whee 2 | yo 3 | -------------------------------------------------------------------------------- /test/mystuff: -------------------------------------------------------------------------------- 1 | My stuff 2 | is quite enough. 3 | No bluff. 4 | -------------------------------------------------------------------------------- /test/mystuff2: -------------------------------------------------------------------------------- 1 | This is a silly example 2 | -------------------------------------------------------------------------------- /test/new.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 4; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my $filename = f $t . '/mydir/file1'; 8 | 9 | my $file = io($filename); 10 | ok($file->isa('IO::All::File'), 'string passed to io() is returned as a file'); 11 | is($file->name, $filename, 'name() is the same as the string'); 12 | 13 | my $file2 = io($file); 14 | ok($file2->isa('IO::All::File'), 'IO::All::File object passed to io() is returned as a file'); 15 | is($file2->name, $filename, 'name() is the same as the original string'); 16 | 17 | del_output_dir(); 18 | -------------------------------------------------------------------------------- /test/os.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More tests => 14; 4 | use IO::All; 5 | 6 | is("".io->file(qw(foo bar baz biff))->os('unix'), 'foo/bar/baz/biff'); 7 | is("".io->file(qw(foo bar baz biff))->os('win32'), 'foo\bar\baz\biff'); 8 | is("".io->file(qw(foo bar baz biff))->os('win32')->os('unix'), 'foo/bar/baz/biff'); 9 | is("".io->file(qw(foo bar baz biff))->os('unix')->os('win32'), 'foo\bar\baz\biff'); 10 | { 11 | local $TODO = 'unix drops drive'; 12 | is("".io->file(qw(C: foo bar baz biff))->os('unix')->os('win32'), 'C:\foo\bar\baz\biff'); 13 | is("".io->dir(qw(C: foo bar baz biff))->os('unix')->os('win32'), 'C:\foo\bar\baz\biff'); 14 | } 15 | is("".io->file(qw(C: foo bar baz biff))->os('win32')->os('unix'), '/foo/bar/baz/biff'); 16 | 17 | is("".io->dir(qw(foo bar baz biff))->os('unix'), 'foo/bar/baz/biff'); 18 | is("".io->dir(qw(foo bar baz biff))->os('win32'), 'foo\bar\baz\biff'); 19 | is("".io->dir(qw(foo bar baz biff))->os('win32')->os('unix'), 'foo/bar/baz/biff'); 20 | is("".io->dir(qw(foo bar baz biff))->os('unix')->os('win32'), 'foo\bar\baz\biff'); 21 | is("".io->dir(qw(C: foo bar baz biff))->os('win32')->os('unix'), '/foo/bar/baz/biff'); 22 | 23 | is("".io->dir('')->os('unix'), ''); 24 | is("".io->file('')->os('unix'), ''); 25 | -------------------------------------------------------------------------------- /test/overload.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 26; 4 | use IO_All_Test; 5 | use IO::All; 6 | 7 | unlink(o_dir() . '/overload1'); 8 | unlink(o_dir() . '/overload2'); 9 | unlink(o_dir() . '/overload3'); 10 | unlink(o_dir() . '/tmp/mystuff') if -e o_dir() . '/tmp/mystuff'; 11 | rmdir(o_dir() . '/tmp') if -d o_dir() . '/tmp';; 12 | 13 | my $data < io("$t/mystuff"); 14 | test_file_contents($data, "$t/mystuff"); 15 | my $data1 = $data; 16 | my $data2 = $data . $data; 17 | $data << io("$t/mystuff"); 18 | is($data, $data2); 19 | $data < io("$t/mystuff"); 20 | is($data, $data1); 21 | 22 | io("$t/mystuff") > $data; 23 | test_file_contents($data, "$t/mystuff"); 24 | io("$t/mystuff") >> $data; 25 | is($data, $data2); 26 | io("$t/mystuff") > $data; 27 | is($data, $data1); 28 | 29 | $data > io(o_dir() . '/overload1'); 30 | test_file_contents($data, o_dir() . '/overload1'); 31 | $data > io(o_dir() . '/overload1'); 32 | test_file_contents($data, o_dir() . '/overload1'); 33 | $data >> io(o_dir() . '/overload1'); 34 | test_file_contents($data2, o_dir() . '/overload1'); 35 | 36 | io(o_dir() . '/overload1') < $data; 37 | test_file_contents($data, o_dir() . '/overload1'); 38 | io(o_dir() . '/overload1') < $data; 39 | test_file_contents($data, o_dir() . '/overload1'); 40 | io(o_dir() . '/overload1') << $data; 41 | test_file_contents($data2, o_dir() . '/overload1'); 42 | 43 | $data > io(o_dir() . '/overload1'); 44 | test_file_contents($data, o_dir() . '/overload1'); 45 | io(o_dir() . '/overload1') > io(o_dir() . '/overload2'); 46 | test_matching_files(o_dir() . '/overload1', o_dir() . '/overload2'); 47 | io(o_dir() . '/overload3') < io(o_dir() . '/overload2'); 48 | test_matching_files(o_dir() . '/overload1', o_dir() . '/overload3'); 49 | io(o_dir() . '/overload3') << io(o_dir() . '/overload2'); 50 | io(o_dir() . '/overload1') >> io(o_dir() . '/overload2'); 51 | test_matching_files(o_dir() . '/overload2', o_dir() . '/overload3'); 52 | test_file_contents($data2, o_dir() . '/overload3'); 53 | 54 | # io(o_dir() . '/tmp/') < io("$testdir/mystuff"); 55 | # test_file_contents($data1, o_dir() . "/tmp/mystuff"); 56 | # io(o_dir() . '/tmp/') << io("$testdir/mystuff"); 57 | # test_file_contents($data2, o_dir() . "/tmp/mystuff"); 58 | # io("$testdir/mystuff") > io(o_dir() . '/tmp/'); 59 | # test_file_contents($data1, o_dir() . "/tmp/mystuff"); 60 | # io("$testdir/mystuff") >> io(o_dir() . '/tmp/'); 61 | # test_file_contents($data2, o_dir() . "/tmp/mystuff"); 62 | 63 | is(io('foo') . '', 'foo'); 64 | 65 | is("@{io $t . '/mydir'}", 66 | flip_slash 67 | "$t/mydir/dir1 $t/mydir/dir2 $t/mydir/file1 $t/mydir/file2 $t/mydir/file3", 68 | ); 69 | 70 | is(join(' ', sort keys %{io "$t/mydir"}), 71 | 'dir1 dir2 file1 file2 file3', 72 | ); 73 | 74 | is(join(' ', sort map {"$_"} values %{io "$t/mydir"}), 75 | flip_slash 76 | "$t/mydir/dir1 $t/mydir/dir2 $t/mydir/file1 $t/mydir/file2 $t/mydir/file3", 77 | ); 78 | 79 | ${io("$t/mystuff")} . ${io("$t/mystuff")} > io(o_dir() . '/overload1'); 80 | test_file_contents2(o_dir() . '/overload1', $data2); 81 | 82 | ${io("$t/mystuff")} . "xxx\n" . ${io("$t/mystuff")} > io(o_dir() . '/overload1'); 83 | $data < io("$t/mystuff"); 84 | my $cat3 = $data . "xxx\n" . $data; 85 | test_file_contents2(o_dir() . '/overload1', $cat3); 86 | 87 | is "" . ${io($t)}, $t, "scalar overload of directory (for mst)"; 88 | 89 | #because it broke lots of modules via File::Spec::Win32::catfile/catdir 90 | my ($f1,$f2) = io->dir( o_dir() )->all; 91 | ok $f1 ne "", 'string operations overload'; 92 | ok $f1 cmp $f2, 'string operations overload'; 93 | 94 | del_output_dir(); 95 | -------------------------------------------------------------------------------- /test/pipe.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use Test::More tests => 4; 3 | use IO::All; 4 | 5 | my $perl_version < io("$^X -v|"); 6 | ok($perl_version =~ /Larry Wall/); 7 | ok($perl_version =~ /This is perl/); 8 | 9 | io("$^X -v|") > $perl_version; 10 | ok($perl_version =~ /Larry Wall/); 11 | ok($perl_version =~ /This is p(erl|onie)/); 12 | -------------------------------------------------------------------------------- /test/print.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More tests => 2; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my $io1 = io(o_dir() . '/print.t'); 8 | is($io1->print("one\n")->print("two\n")->close->scalar, "one\ntwo\n"); 9 | my $io2 = io(o_dir() . '/print.t'); 10 | is($io2->println("one")->println("two")->close->scalar, "one\ntwo\n"); 11 | 12 | 13 | del_output_dir(); 14 | -------------------------------------------------------------------------------- /test/println.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 1; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my $io = io("$t/println.t"); 8 | my @lines = map {chomp; $_} $io->slurp; 9 | my $temp = io('?'); 10 | $temp->println(@lines); 11 | $temp->seek(0, 0); 12 | my $text = $temp->slurp; 13 | 14 | test_file_contents($text, "$t/println.t"); 15 | 16 | del_output_dir(); 17 | -------------------------------------------------------------------------------- /test/read.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 8; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my $outfile = "$t/out.pm"; 8 | ok(not -f $outfile); 9 | my $input = io('lib/IO/All.pm')->open; 10 | ok(ref $input); 11 | my $output = io($outfile)->open('>'); 12 | ok(ref $output); 13 | my $buffer; 14 | $input->buffer($buffer); 15 | $output->buffer($buffer); 16 | ok(defined $buffer); 17 | $output->write while $input->read; 18 | ok(not length($buffer)); 19 | ok($output->close); 20 | test_matching_files($outfile, 'lib/IO/All.pm'); 21 | ok($output->unlink); 22 | 23 | del_output_dir(); 24 | -------------------------------------------------------------------------------- /test/read_write.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More tests => 2; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my $io = io('lib/IO/All.pm'); 8 | my $buffer; 9 | $io->buffer($buffer); 10 | 1 while $io->read; 11 | ok(length($buffer)); 12 | test_file_contents($buffer, 'lib/IO/All.pm'); 13 | 14 | del_output_dir(); 15 | -------------------------------------------------------------------------------- /test/round_robin.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 9; 4 | use IO::All; 5 | 6 | my $io = io("$t/mystuff"); 7 | my $x = 0; 8 | while (my $line = $io->getline || $io->getline) { 9 | my $expected = ; 10 | is($line, $expected); 11 | last if ++$x >= 8; 12 | } 13 | 14 | is(, "last line\n"); 15 | 16 | __DATA__ 17 | My stuff 18 | is quite enough. 19 | No bluff. 20 | My stuff 21 | is quite enough. 22 | No bluff. 23 | My stuff 24 | is quite enough. 25 | last line 26 | -------------------------------------------------------------------------------- /test/rt-41819.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | use IO::All; 3 | 4 | plan 'skip_all' unless -d '/dev'; 5 | plan tests => 1; 6 | 7 | my $io = io('/dev'); 8 | my $path; 9 | 10 | my $f = $path->name while ($path = $io->next()); 11 | pass 'It works now'; 12 | -------------------------------------------------------------------------------- /test/scalar.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 2; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my $io = io("$t/scalar.t"); 8 | my @list = $io->scalar; 9 | ok(@list == 1); 10 | test_file_contents($list[0], "$t/scalar.t"); 11 | 12 | del_output_dir(); 13 | -------------------------------------------------------------------------------- /test/seek.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 1; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | { 8 | my $string < (io("$t/mystuff") > io(o_dir() . '/seek')); 9 | my $io = io(o_dir() . '/seek'); 10 | $io->seek(index($string, 'quite'), 0); 11 | is($io->getline, "quite enough.\n"); 12 | } 13 | 14 | del_output_dir(); 15 | -------------------------------------------------------------------------------- /test/separator.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More tests => 4; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | join('', ) > io(o_dir() . '/separator1'); 8 | my $io = io(o_dir() . '/separator1'); 9 | $io->separator('t'); 10 | my @chunks = $io->slurp; 11 | is(scalar @chunks, 3); 12 | is($chunks[0], "one\nt"); 13 | is($chunks[1], "wo\nt"); 14 | is($chunks[2], "hree\nfour\n"); 15 | 16 | del_output_dir(); 17 | 18 | __DATA__ 19 | one 20 | two 21 | three 22 | four 23 | -------------------------------------------------------------------------------- /test/stat.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 14; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my ($dev, $ino, $modes, $nlink, $uid, $gid, $rdev, 8 | $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat("$t/stat.t"); 9 | 10 | my $io = io("$t/stat.t"); 11 | is($io->device, $dev); 12 | is($io->inode, $ino); 13 | is($io->modes, $modes); 14 | is($io->nlink, $nlink); 15 | is($io->uid, $uid); 16 | is($io->gid, $gid); 17 | is($io->device_id, $rdev); 18 | is($io->size, $size); 19 | ok(($io->atime == $atime) || ($io->atime == ($atime+1))); 20 | is($io->mtime, $mtime); 21 | is($io->ctime, $ctime); 22 | is($io->blksize, $blksize); 23 | is($io->blocks, $blocks); 24 | 25 | my @stat = $io->stat; 26 | ok(defined $stat[0]); 27 | 28 | del_output_dir(); 29 | -------------------------------------------------------------------------------- /test/string_open.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More tests => 1; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | my $s = io('$'); 8 | $s->append("write 1\n"); 9 | my $s1 = "scalar ref: (".$s->string_ref.")"; 10 | $s->append("write 2\n"); 11 | my $s2 = "scalar ref: (".$s->string_ref.")"; 12 | 13 | is($s1, $s2, "Don't create new string object with each write"); 14 | 15 | del_output_dir(); 16 | -------------------------------------------------------------------------------- /test/subtleties.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | use lib -e 't' ? 't' : 'test'; 3 | use Test::More tests => 7; 4 | use IO::All; 5 | 6 | use IO_All_Test; 7 | 8 | my $data = join '', ; 9 | my $io = io(o_dir() . '/subtleties1') < $data; 10 | is("$io", o_dir() . '/subtleties1'); 11 | 12 | ok($io->close); 13 | ok(not $io->close); 14 | 15 | my $data2 = $io->slurp; 16 | $data2 .= $$io; 17 | $data2 << $io; 18 | is($data2, $data x 3); 19 | ok(not $io->close); 20 | 21 | my $io2 = io(io(io('xxx'))); 22 | ok(ref $io2); 23 | ok($io2->isa('IO::All')); 24 | # is("$io2", 'xxx'); 25 | del_output_dir(); 26 | 27 | __DATA__ 28 | test 29 | data 30 | 31 | 32 | -------------------------------------------------------------------------------- /test/synopsis1.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 6; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | # Combine two files into a third 8 | my $my_stuff = io("$t/mystuff")->slurp; 9 | test_file_contents($my_stuff, "$t/mystuff"); 10 | my $more_stuff << io("$t/morestuff"); 11 | test_file_contents($more_stuff, "$t/morestuff"); 12 | io("$t/allstuff")->print($my_stuff, $more_stuff); 13 | ok(-f "$t/allstuff"); 14 | ok(-s "$t/allstuff"); 15 | test_file_contents($my_stuff . $more_stuff, "$t/allstuff"); 16 | ok(unlink("$t/allstuff")); 17 | 18 | del_output_dir(); 19 | -------------------------------------------------------------------------------- /test/synopsis2.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 10; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | # Print name and first line of all files in a directory 8 | my $dir = io("$t/mydir"); 9 | ok($dir->is_dir); 10 | my @results; 11 | while (my $io = $dir->next) { 12 | if ($io->is_file) { 13 | push @results, $io->name . ' - ' . $io->getline; 14 | } 15 | } 16 | 17 | for my $line (sort @results) { 18 | my $dataline = ; 19 | $dataline =~ s/^t\//test\// if -e 'test'; 20 | is($line, flip_slash $dataline); 21 | } 22 | 23 | # Print name of all files recursively 24 | for ( 25 | sort {$a->name cmp $b->name} 26 | grep {! /CVS|\.svn/} io("$t/mydir")->all_files(0) 27 | ) { 28 | my $dataline = ; 29 | $dataline =~ s/^t\//test\// if -e 'test'; 30 | is("$_\n", flip_slash $dataline) 31 | } 32 | 33 | del_output_dir(); 34 | 35 | __END__ 36 | t/mydir/file1 - file1 is fun 37 | t/mydir/file2 - file2 is woohoo 38 | t/mydir/file3 - file3 is whee 39 | t/mydir/dir1/dira/dirx/file1 40 | t/mydir/dir1/file1 41 | t/mydir/dir2/file1 42 | t/mydir/file1 43 | t/mydir/file2 44 | t/mydir/file3 45 | -------------------------------------------------------------------------------- /test/synopsis3.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 3; 4 | use IO_All_Test; 5 | use Config; 6 | 7 | sub fix { 8 | local $_ = shift; 9 | if ($^O eq 'MSWin32') { 10 | s/"/'/g; 11 | return qq{"$_"}; 12 | } 13 | return qq{'$_'}; 14 | } 15 | 16 | undef $/; 17 | # # Copy STDIN to STDOUT 18 | # io('-')->print(io('-')->slurp); 19 | my $test1 = fix 'io("-")->print(io("-")->slurp)'; 20 | open TEST, '-|', qq{$^X -Ilib -MIO::All -e $test1 < $t/mystuff} 21 | or die "open failed: $!"; 22 | test_file_contents(, "$t/mystuff"); 23 | close TEST; 24 | 25 | # # Copy STDIN to STDOUT a block at a time 26 | # my $stdin = io('-'); 27 | # my $stdout = io('-'); 28 | # $stdout->buffer($stdin->buffer); 29 | # $stdout->write while $stdin->read; 30 | my $test2 = fix 'my $stdin = io("-");my $stdout = io("-");$stdout->buffer($stdin->buffer);$stdout->write while $stdin->read'; 31 | open TEST, '-|', qq{$^X -Ilib -MIO::All -e $test2 < $t/mystuff} 32 | or die "open failed: $!"; 33 | test_file_contents(, "$t/mystuff"); 34 | close TEST; 35 | 36 | # # Copy STDIN to a String File one line at a time 37 | # my $stdin = io('-'); 38 | # my $string_out = io('$'); 39 | # while (my $line = $stdin->getline) { 40 | # $string_out->print($line); 41 | # } 42 | my $test3 = fix 'my $stdin = io("-");my $string_out = io(q{$});while (my $line = $stdin->getline("")) {$string_out->print($line)} print ${$string_out->string_ref}'; 43 | open TEST, '-|', qq{$^X -Ilib -MIO::All -e $test3 < $t/mystuff} 44 | or die "open failed: $!"; 45 | test_file_contents(, "$t/mystuff"); 46 | close TEST; 47 | 48 | del_output_dir(); 49 | -------------------------------------------------------------------------------- /test/synopsis5.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 3; 4 | use IO::All; 5 | 6 | # Write some data to a temporary file and retrieve all the paragraphs. 7 | my $data = io("$t/synopsis5.t")->slurp; 8 | 9 | my $temp = io->temp; 10 | ok($temp->print($data)); 11 | ok($temp->seek(0, 0)); 12 | 13 | my @paragraphs = $temp->getlines(''); 14 | is(scalar @paragraphs, 4); 15 | -------------------------------------------------------------------------------- /test/text.big5: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ingydotnet/io-all-pm/2c8ab8f4ec5cf2c6c44cc0bfdb8b8ff50a01eeb9/test/text.big5 -------------------------------------------------------------------------------- /test/text.utf8: -------------------------------------------------------------------------------- 1 | We are noticing that our Big5 greeting --- 2 | 你好, 我是貝爾實驗室的中文語音合成系統 --- is being garbled in 3 | -------------------------------------------------------------------------------- /test/tie.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More tests => 1; 4 | use IO::All; 5 | use IO_All_Test; 6 | 7 | { 8 | my $io = io("$t/tie.t")->tie; 9 | my $file = join '', <$io>; 10 | test_file_contents($file, "$t/tie.t"); 11 | 12 | my $io1 = io(o_dir() . '/tie.t')->tie; 13 | print $io1 "test"; 14 | } 15 | 16 | del_output_dir(); 17 | -------------------------------------------------------------------------------- /test/tie_file.t: -------------------------------------------------------------------------------- 1 | use strict; use warnings; 2 | my $t; use lib ($t = -e 't' ? 't' : 'test'); 3 | use Test::More; 4 | use IO_All_Test; 5 | use IO::All; 6 | 7 | plan((eval {require Tie::File; 1}) 8 | ? (tests => 2) 9 | : (skip_all => "requires Tie::File") 10 | ); 11 | 12 | { 13 | (io(o_dir() . '/tie_file1') < io("$t/tie_file.t"))->close; 14 | my $file = io(o_dir() . '/tie_file1')->rdonly; 15 | is($file->[-1], 'bar'); 16 | is($file->[-2], 'foo'); 17 | 18 | "foo\n" x 3 > io(o_dir() . '/tie_file2'); 19 | io(o_dir() . '/tie_file2')->[1] = 'bar'; 20 | } 21 | 22 | del_output_dir(); 23 | 24 | __END__ 25 | foo 26 | bar 27 | -------------------------------------------------------------------------------- /test/unit/append.pl: -------------------------------------------------------------------------------- 1 | use lib 'lib'; 2 | use IO::All; 3 | 4 | my $io = io('foo'); 5 | $io->append(io($0)->slurp); 6 | 7 | my @stuff = qw(one two three); 8 | $stuff[1] .= "xxx\n"; 9 | 10 | $io->appendln(@stuff); 11 | -------------------------------------------------------------------------------- /test/unit/client.pl: -------------------------------------------------------------------------------- 1 | use lib 'lib'; 2 | use IO::All; 3 | 4 | my $io = io('localhost:12345'); 5 | print while $_ = $io->getline; 6 | -------------------------------------------------------------------------------- /test/unit/println.pl: -------------------------------------------------------------------------------- 1 | use lib 'lib'; 2 | use IO::All; 3 | 4 | my @stuff = qw(one two three); 5 | $stuff[1] .= "xxx\n"; 6 | 7 | io('-')->println(@stuff); 8 | 9 | -------------------------------------------------------------------------------- /test/unit/server.pl: -------------------------------------------------------------------------------- 1 | use lib 'lib'; 2 | use IO::All; 3 | 4 | my $socket = io(':12345')->accept('-fork'); 5 | $socket->print($_) while ; 6 | $socket->close; 7 | 8 | __DATA__ 9 | On your mark, 10 | Get set, 11 | Go! 12 | -------------------------------------------------------------------------------- /test/unit/stdio.pl: -------------------------------------------------------------------------------- 1 | use IO::All; 2 | 3 | my $stdin = io('-'); 4 | my $stdout = io('-'); 5 | $stdout->buffer($stdin->buffer); 6 | $stdout->write while $stdin->read; 7 | -------------------------------------------------------------------------------- /test/unit/test.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use lib 'lib'; 3 | use IO::All; 4 | 5 | io('xxx'); 6 | -------------------------------------------------------------------------------- /test/unit/xxx.pl: -------------------------------------------------------------------------------- 1 | BEGIN {$^W = 1} 2 | use strict; 3 | use IO::All; 4 | 5 | # Copy STDIN to a String File one paragraph at a time 6 | my $stdin = io('-'); 7 | my $string_out = io('$'); 8 | while (my $paragraph = $stdin->getline('')) { 9 | $string_out->print($paragraph); 10 | } 11 | 12 | print ${$string_out->string_ref}; 13 | -------------------------------------------------------------------------------- /test/xxx.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 1; 4 | 5 | use IO::All; 6 | use IO::All::Temp; 7 | use IO::All::String; 8 | use IO::All::Socket; 9 | use IO::All::MLDBM; 10 | use IO::All::Link; 11 | use IO::All::Pipe; 12 | use IO::All::Dir; 13 | use IO::All::Filesys; 14 | use IO::All::File; 15 | use IO::All::DBM; 16 | use IO::All::STDIO; 17 | use IO::All::Base; 18 | 19 | is($INC{'XXX.pm'}, undef, "Don't ship with XXX"); 20 | --------------------------------------------------------------------------------