| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # Copyrights 2011 by Mark Overmeer. | 
| 2 |  |  |  |  |  |  | #  For other contributors see ChangeLog. | 
| 3 |  |  |  |  |  |  | # See the manual pages for details on the licensing terms. | 
| 4 |  |  |  |  |  |  | # Pod stripped from pm file by OODoc 1.07. | 
| 5 | 2 |  |  | 2 |  | 2530 | use warnings; | 
|  | 2 |  |  |  |  | 5 |  | 
|  | 2 |  |  |  |  | 70 |  | 
| 6 | 2 |  |  | 2 |  | 28 | use strict; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 87 |  | 
| 7 |  |  |  |  |  |  |  | 
| 8 |  |  |  |  |  |  | package IOMux::Open; | 
| 9 | 2 |  |  | 2 |  | 11 | use vars '$VERSION'; | 
|  | 2 |  |  |  |  | 5 |  | 
|  | 2 |  |  |  |  | 105 |  | 
| 10 |  |  |  |  |  |  | $VERSION = '0.12'; | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  |  | 
| 13 | 2 |  |  | 2 |  | 47 | use Log::Report 'iomux'; | 
|  | 2 |  |  |  |  | 5 |  | 
|  | 2 |  |  |  |  | 13 |  | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | my %modes = | 
| 16 |  |  |  |  |  |  | ( '-|'  => 'IOMux::Pipe::Read' | 
| 17 |  |  |  |  |  |  | , '|-'  => 'IOMux::Pipe::Write' | 
| 18 |  |  |  |  |  |  | , '|-|' => 'IOMux::IPC' | 
| 19 |  |  |  |  |  |  | , '|=|' => 'IOMux::IPC' | 
| 20 |  |  |  |  |  |  | , '>'   => 'IOMux::File::Write' | 
| 21 |  |  |  |  |  |  | , '>>'  => 'IOMux::File::Write' | 
| 22 |  |  |  |  |  |  | , '<'   => 'IOMux::File::Read' | 
| 23 |  |  |  |  |  |  | , tcp   => 'IOMux::Net::TCP' | 
| 24 |  |  |  |  |  |  | ); | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | sub import(@) | 
| 27 | 3 |  |  | 3 |  | 550 | {   my $class = shift; | 
| 28 | 3 |  |  |  |  | 23 | foreach my $mode (@_) | 
| 29 | 2 | 50 |  |  |  | 13 | {   my $impl = $modes{$mode} | 
| 30 |  |  |  |  |  |  | or error __x"unknown mode {mode} in use {pkg}" | 
| 31 |  |  |  |  |  |  | , mode => $mode, pkg => $class; | 
| 32 | 2 |  |  |  |  | 115 | eval "require $impl"; | 
| 33 | 2 | 50 |  |  |  | 21 | panic $@ if $@; | 
| 34 |  |  |  |  |  |  | } | 
| 35 |  |  |  |  |  |  | } | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | sub new($@) | 
| 39 | 4 |  |  | 4 | 1 | 8 | {   my ($class, $mode) = (shift, shift); | 
| 40 | 4 | 50 |  |  |  | 13 | my $real  = $modes{$mode} | 
| 41 |  |  |  |  |  |  | or error __x"unknown mode '{mode}' to open() on mux", mode => $mode; | 
| 42 |  |  |  |  |  |  |  | 
| 43 | 4 | 50 |  |  |  | 43 | $real->can('open') | 
| 44 |  |  |  |  |  |  | or error __x"package {pkg} for mode '{mode}' not required by {me}" | 
| 45 |  |  |  |  |  |  | , pkg => $real, mode => $mode, me => $class; | 
| 46 |  |  |  |  |  |  |  | 
| 47 | 4 |  |  |  |  | 17 | $real->open($mode, @_); | 
| 48 |  |  |  |  |  |  | } | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | #-------------- | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | 1; |