0: #!/usr/bin/perl -wT
1: 
2: # This is designed to show a homegrown getline routine.
3: # It is intended to be a drop in for modules such as
4: # IO::Socket::SSL which currently (v0.78) does not have a
5: # getline method.
6: # 
7: # To try this out, save the entire chunk to a file and run it.
8: # It will show some tests, and then a benchmark between it,
9: # a straight call to the parent class, and a placebo class which
10: # has the same number of method lookups.  It actually fairs 
11: # pretty well against all the things that perl and the kernel
12: # are doing for you.
13: #
14: # For early adopters, you can actually put this in place in a 
15: # sub class of IO::Socket::SSL and get getline support now. (I've
16: # submitted the code to the author and am waiting to see if it
17: # meets his approval.  I know the code looks simple, but it makes
18: # a lot of things possible.
19: #
20: # TODO: See if I can use Tie::Handle and get <$fh> to work.
21: 
22: ### sample package containing the getline methods
23: package MYO::File;
24: 
25: ### ISA can be any IO::Handle object (including IO::Socket::SSL)
26: use strict;
27: use vars qw(@ISA);
28: use IO::File ();
29: @ISA = qw(IO::File);
30: 
31: ### declare some package globals (to create aliases later
32: use vars qw( $buffer $b_read );
33: 
34: sub new {
35:   my $type  = shift;
36:   my $class = ref($type) || $type || __PACKAGE__;
37:   my $fh    = __PACKAGE__->SUPER::new( @_ );
38: 
39:   return undef unless defined $fh;
40:   
41:   $ { *$fh }{read_length} = 2 ** 11; # (2k)
42:   $ { *$fh }{buffer}      = '';
43:   $ { *$fh }{bytes_read}  = 0;
44:   $ { *$fh }{eol}         = "\012";
45: 
46:   bless $fh, $class;
47: }
48: 
49: sub getline {
50:   @_ == 1 or die 'usage: $io->getline()';
51:   my $fh = shift;
52:   local *buffer = \${ *$fh }{buffer};
53:   local *b_read = \${ *$fh }{bytes_read};
54:   my $read_len  = $ { *$fh }{read_length};
55:   my $eol       = $ { *$fh }{eol};
56: 
57:   my $index = index($buffer, $eol);
58:   
59:   while( $index == -1 ){
60:     $fh->sysread( $buffer, $read_len, length($buffer) )
61:       or return undef;
62:     
63:     $index = index($buffer, $eol);
64:   }
65: 
66:   $index  += length($eol);
67:   $b_read += $index;
68: 
69:   return substr($buffer, 0, $index, '');
70: } 
71: 
72: sub seek {
73:   my $fh = shift;
74:   $fh->SUPER::seek( @_ );
75:   $ { *$fh }{buffer} = '';
76:   $ { *$fh }{bytes_read} = 0;
77: }
78: 
79: sub tell {
80:   my $fh = shift;
81:   $ { *$fh }{bytes_read};
82: }
83: 
84: ### allow for modification of eol
85: sub end_of_line {
86:   my $fh = shift;
87:   return $ { *$fh }{eol} unless @_;
88:   $ { *$fh }{eol} = shift;
89: }
90: 
91: ### allow for modification of read_length
92: sub getline_read_length {
93:   my $fh = shift;
94:   return $ { *$fh }{read_length} unless @_;
95:   $ { *$fh }{read_length} = shift;
96: }
97: 
98: ###------------------------------------------------###
99: 
100: ### control group (check the effect of method lookups
101: package Placebo;
102: use vars qw(@ISA);
103: use IO::File ();
104: @ISA = qw(IO::File);
105: sub getline{ shift()->SUPER::getline() }
106: sub seek{    shift()->SUPER::seek( @_ ) }
107: sub tell{    shift()->SUPER::tell( @_ ) }
108: 
109: ###------------------------------------------------###
110: 
111: ### back to package main to do some tests
112: package main;
113: 
114: use IO::File ();
115: 
116: ### set up three file handles
117: my $fh1 =  IO::File->new($0,'r');
118: my $fh2 = MYO::File->new($0,'r');
119: my $fh3 =   Placebo->new($0,'r');
120: 
121: ### read line test
122: for( 1..3 ){
123:   print "$_ fh1: ".$fh1->getline();
124:   print "$_ fh2: ".$fh2->getline();
125:   print "$_ fh3: ".$fh3->getline();
126: }
127: 
128: ### seek and tell test
129: print "tell fh1: ", $fh1->tell(), "\n";
130: print "tell fh2: ", $fh2->tell(), "\n";
131: print "tell fh3: ", $fh3->tell(), "\n";
132: $fh1->seek(0,0);
133: $fh2->seek(0,0);
134: $fh3->seek(0,0);
135: print "tell fh1: ", $fh1->tell(), "\n";
136: print "tell fh2: ", $fh2->tell(), "\n";
137: print "tell fh3: ", $fh3->tell(), "\n";
138: 
139: ###------------------------------------------------###
140: 
141: ### do a benchmark
142: use Benchmark qw(cmpthese);
143: cmpthese(1000,{
144:   IO_File  => sub { $fh1->seek(0,0);
145:                     for(1..70){ my $line = $fh1->getline(); } },
146:   MYO_File => sub { $fh2->seek(0,0);
147:                     for(1..70){ my $line = $fh2->getline(); } },
148:   Placebo  => sub { $fh3->seek(0,0);
149:                     for(1..70){ my $line = $fh3->getline(); } },
150: });
151: exit;