| 1 | package PerlIO::via;
|
|---|
| 2 | our $VERSION = '0.03';
|
|---|
| 3 | use XSLoader ();
|
|---|
| 4 | XSLoader::load 'PerlIO::via';
|
|---|
| 5 | 1;
|
|---|
| 6 | __END__
|
|---|
| 7 |
|
|---|
| 8 | =head1 NAME
|
|---|
| 9 |
|
|---|
| 10 | PerlIO::via - Helper class for PerlIO layers implemented in perl
|
|---|
| 11 |
|
|---|
| 12 | =head1 SYNOPSIS
|
|---|
| 13 |
|
|---|
| 14 | use PerlIO::via::Layer;
|
|---|
| 15 | open($fh,"<:via(Layer)",...);
|
|---|
| 16 |
|
|---|
| 17 | use Some::Other::Package;
|
|---|
| 18 | open($fh,">:via(Some::Other::Package)",...);
|
|---|
| 19 |
|
|---|
| 20 | =head1 DESCRIPTION
|
|---|
| 21 |
|
|---|
| 22 | The PerlIO::via module allows you to develop PerlIO layers in Perl, without
|
|---|
| 23 | having to go into the nitty gritty of programming C with XS as the interface
|
|---|
| 24 | to Perl.
|
|---|
| 25 |
|
|---|
| 26 | One example module, L<PerlIO::via::QuotedPrint>, is included with Perl
|
|---|
| 27 | 5.8.0, and more example modules are available from CPAN, such as
|
|---|
| 28 | L<PerlIO::via::StripHTML> and L<PerlIO::via::Base64>. The
|
|---|
| 29 | PerlIO::via::StripHTML module for instance, allows you to say:
|
|---|
| 30 |
|
|---|
| 31 | use PerlIO::via::StripHTML;
|
|---|
| 32 | open( my $fh, "<:via(StripHTML)", "index.html" );
|
|---|
| 33 | my @line = <$fh>;
|
|---|
| 34 |
|
|---|
| 35 | to obtain the text of an HTML-file in an array with all the HTML-tags
|
|---|
| 36 | automagically removed.
|
|---|
| 37 |
|
|---|
| 38 | Please note that if the layer is created in the PerlIO::via:: namespace, it
|
|---|
| 39 | does B<not> have to be fully qualified. The PerlIO::via module will prefix
|
|---|
| 40 | the PerlIO::via:: namespace if the specified modulename does not exist as a
|
|---|
| 41 | fully qualified module name.
|
|---|
| 42 |
|
|---|
| 43 | =head1 EXPECTED METHODS
|
|---|
| 44 |
|
|---|
| 45 | To create a Perl module that implements a PerlIO layer in Perl (as opposed to
|
|---|
| 46 | in C using XS as the interface to Perl), you need to supply some of the
|
|---|
| 47 | following subroutines. It is recommended to create these Perl modules in the
|
|---|
| 48 | PerlIO::via:: namespace, so that they can easily be located on CPAN and use
|
|---|
| 49 | the default namespace feature of the PerlIO::via module itself.
|
|---|
| 50 |
|
|---|
| 51 | Please note that this is an area of recent development in Perl and that the
|
|---|
| 52 | interface described here is therefore still subject to change (and hopefully
|
|---|
| 53 | will have better documentation and more examples).
|
|---|
| 54 |
|
|---|
| 55 | In the method descriptions below I<$fh> will be
|
|---|
| 56 | a reference to a glob which can be treated as a perl file handle.
|
|---|
| 57 | It refers to the layer below. I<$fh> is not passed if the layer
|
|---|
| 58 | is at the bottom of the stack, for this reason and to maintain
|
|---|
| 59 | some level of "compatibility" with TIEHANDLE classes it is passed last.
|
|---|
| 60 |
|
|---|
| 61 | =over 4
|
|---|
| 62 |
|
|---|
| 63 | =item $class->PUSHED([$mode[,$fh]])
|
|---|
| 64 |
|
|---|
| 65 | Should return an object or the class, or -1 on failure. (Compare
|
|---|
| 66 | TIEHANDLE.) The arguments are an optional mode string ("r", "w",
|
|---|
| 67 | "w+", ...) and a filehandle for the PerlIO layer below. Mandatory.
|
|---|
| 68 |
|
|---|
| 69 | When layer is pushed as part of an C<open> call, C<PUSHED> will be called
|
|---|
| 70 | I<before> the actual open occurs whether than be via C<OPEN>, C<SYSOPEN>,
|
|---|
| 71 | C<FDOPEN> or by letting lower layer do the open.
|
|---|
| 72 |
|
|---|
| 73 | =item $obj->POPPED([$fh])
|
|---|
| 74 |
|
|---|
| 75 | Optional - layer is about to be removed.
|
|---|
| 76 |
|
|---|
| 77 | =item $obj->UTF8($bellowFlag,[$fh])
|
|---|
| 78 |
|
|---|
| 79 | Optional - if present it will be called immediately after PUSHED has
|
|---|
| 80 | returned. It should return true value if the layer expects data to be
|
|---|
| 81 | UTF-8 encoded. If it returns true result is as if caller had done
|
|---|
| 82 |
|
|---|
| 83 | ":via(YourClass):utf8"
|
|---|
| 84 |
|
|---|
| 85 | If not present of it it returns false, then stream is left with
|
|---|
| 86 | flag clear.
|
|---|
| 87 | The I<$bellowFlag> argument will be true if there is a layer below
|
|---|
| 88 | and that layer was expecting UTF-8.
|
|---|
| 89 |
|
|---|
| 90 |
|
|---|
| 91 | =item $obj->OPEN($path,$mode[,$fh])
|
|---|
| 92 |
|
|---|
| 93 | Optional - if not present lower layer does open.
|
|---|
| 94 | If present called for normal opens after layer is pushed.
|
|---|
| 95 | This function is subject to change as there is no easy way
|
|---|
| 96 | to get lower layer to do open and then regain control.
|
|---|
| 97 |
|
|---|
| 98 | =item $obj->BINMODE([,$fh])
|
|---|
| 99 |
|
|---|
| 100 | Optional - if not available layer is popped on binmode($fh) or when C<:raw>
|
|---|
| 101 | is pushed. If present it should return 0 on success -1 on error and undef
|
|---|
| 102 | to pop the layer.
|
|---|
| 103 |
|
|---|
| 104 | =item $obj->FDOPEN($fd[,$fh])
|
|---|
| 105 |
|
|---|
| 106 | Optional - if not present lower layer does open.
|
|---|
| 107 | If present called for opens which pass a numeric file
|
|---|
| 108 | descriptor after layer is pushed.
|
|---|
| 109 | This function is subject to change as there is no easy way
|
|---|
| 110 | to get lower layer to do open and then regain control.
|
|---|
| 111 |
|
|---|
| 112 | =item $obj->SYSOPEN($path,$imode,$perm,[,$fh])
|
|---|
| 113 |
|
|---|
| 114 | Optional - if not present lower layer does open.
|
|---|
| 115 | If present called for sysopen style opens which pass a numeric mode
|
|---|
| 116 | and permissions after layer is pushed.
|
|---|
| 117 | This function is subject to change as there is no easy way
|
|---|
| 118 | to get lower layer to do open and then regain control.
|
|---|
| 119 |
|
|---|
| 120 | =item $obj->FILENO($fh)
|
|---|
| 121 |
|
|---|
| 122 | Returns a numeric value for Unix-like file descriptor. Return -1 if
|
|---|
| 123 | there isn't one. Optional. Default is fileno($fh).
|
|---|
| 124 |
|
|---|
| 125 | =item $obj->READ($buffer,$len,$fh)
|
|---|
| 126 |
|
|---|
| 127 | Returns the number of octets placed in $buffer (must be less than or
|
|---|
| 128 | equal to $len). Optional. Default is to use FILL instead.
|
|---|
| 129 |
|
|---|
| 130 | =item $obj->WRITE($buffer,$fh)
|
|---|
| 131 |
|
|---|
| 132 | Returns the number of octets from buffer that have been successfully written.
|
|---|
| 133 |
|
|---|
| 134 | =item $obj->FILL($fh)
|
|---|
| 135 |
|
|---|
| 136 | Should return a string to be placed in the buffer. Optional. If not
|
|---|
| 137 | provided must provide READ or reject handles open for reading in
|
|---|
| 138 | PUSHED.
|
|---|
| 139 |
|
|---|
| 140 | =item $obj->CLOSE($fh)
|
|---|
| 141 |
|
|---|
| 142 | Should return 0 on success, -1 on error.
|
|---|
| 143 | Optional.
|
|---|
| 144 |
|
|---|
| 145 | =item $obj->SEEK($posn,$whence,$fh)
|
|---|
| 146 |
|
|---|
| 147 | Should return 0 on success, -1 on error.
|
|---|
| 148 | Optional. Default is to fail, but that is likely to be changed
|
|---|
| 149 | in future.
|
|---|
| 150 |
|
|---|
| 151 | =item $obj->TELL($fh)
|
|---|
| 152 |
|
|---|
| 153 | Returns file postion.
|
|---|
| 154 | Optional. Default to be determined.
|
|---|
| 155 |
|
|---|
| 156 | =item $obj->UNREAD($buffer,$fh)
|
|---|
| 157 |
|
|---|
| 158 | Returns the number of octets from buffer that have been successfully
|
|---|
| 159 | saved to be returned on future FILL/READ calls. Optional. Default is
|
|---|
| 160 | to push data into a temporary layer above this one.
|
|---|
| 161 |
|
|---|
| 162 | =item $obj->FLUSH($fh)
|
|---|
| 163 |
|
|---|
| 164 | Flush any buffered write data. May possibly be called on readable
|
|---|
| 165 | handles too. Should return 0 on success, -1 on error.
|
|---|
| 166 |
|
|---|
| 167 | =item $obj->SETLINEBUF($fh)
|
|---|
| 168 |
|
|---|
| 169 | Optional. No return.
|
|---|
| 170 |
|
|---|
| 171 | =item $obj->CLEARERR($fh)
|
|---|
| 172 |
|
|---|
| 173 | Optional. No return.
|
|---|
| 174 |
|
|---|
| 175 | =item $obj->ERROR($fh)
|
|---|
| 176 |
|
|---|
| 177 | Optional. Returns error state. Default is no error until a mechanism
|
|---|
| 178 | to signal error (die?) is worked out.
|
|---|
| 179 |
|
|---|
| 180 | =item $obj->EOF($fh)
|
|---|
| 181 |
|
|---|
| 182 | Optional. Returns end-of-file state. Default is function of return
|
|---|
| 183 | value of FILL or READ.
|
|---|
| 184 |
|
|---|
| 185 | =back
|
|---|
| 186 |
|
|---|
| 187 | =head1 EXAMPLES
|
|---|
| 188 |
|
|---|
| 189 | Check the PerlIO::via:: namespace on CPAN for examples of PerlIO layers
|
|---|
| 190 | implemented in Perl. To give you an idea how simple the implementation of
|
|---|
| 191 | a PerlIO layer can look, as simple example is included here.
|
|---|
| 192 |
|
|---|
| 193 | =head2 Example - a Hexadecimal Handle
|
|---|
| 194 |
|
|---|
| 195 | Given the following module, PerlIO::via::Hex :
|
|---|
| 196 |
|
|---|
| 197 | package PerlIO::via::Hex;
|
|---|
| 198 |
|
|---|
| 199 | sub PUSHED
|
|---|
| 200 | {
|
|---|
| 201 | my ($class,$mode,$fh) = @_;
|
|---|
| 202 | # When writing we buffer the data
|
|---|
| 203 | my $buf = '';
|
|---|
| 204 | return bless \$buf,$class;
|
|---|
| 205 | }
|
|---|
| 206 |
|
|---|
| 207 | sub FILL
|
|---|
| 208 | {
|
|---|
| 209 | my ($obj,$fh) = @_;
|
|---|
| 210 | my $line = <$fh>;
|
|---|
| 211 | return (defined $line) ? pack("H*", $line) : undef;
|
|---|
| 212 | }
|
|---|
| 213 |
|
|---|
| 214 | sub WRITE
|
|---|
| 215 | {
|
|---|
| 216 | my ($obj,$buf,$fh) = @_;
|
|---|
| 217 | $$obj .= unpack("H*", $buf);
|
|---|
| 218 | return length($buf);
|
|---|
| 219 | }
|
|---|
| 220 |
|
|---|
| 221 | sub FLUSH
|
|---|
| 222 | {
|
|---|
| 223 | my ($obj,$fh) = @_;
|
|---|
| 224 | print $fh $$obj or return -1;
|
|---|
| 225 | $$obj = '';
|
|---|
| 226 | return 0;
|
|---|
| 227 | }
|
|---|
| 228 |
|
|---|
| 229 | 1;
|
|---|
| 230 |
|
|---|
| 231 | the following code opens up an output handle that will convert any
|
|---|
| 232 | output to hexadecimal dump of the output bytes: for example "A" will
|
|---|
| 233 | be converted to "41" (on ASCII-based machines, on EBCDIC platforms
|
|---|
| 234 | the "A" will become "c1")
|
|---|
| 235 |
|
|---|
| 236 | use PerlIO::via::Hex;
|
|---|
| 237 | open(my $fh, ">:via(Hex)", "foo.hex");
|
|---|
| 238 |
|
|---|
| 239 | and the following code will read the hexdump in and convert it
|
|---|
| 240 | on the fly back into bytes:
|
|---|
| 241 |
|
|---|
| 242 | open(my $fh, "<:via(Hex)", "foo.hex");
|
|---|
| 243 |
|
|---|
| 244 | =cut
|
|---|