home *** CD-ROM | disk | FTP | other *** search
/ PC Open 100 / PC Open 100 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / POPFile / Module.pm < prev    next >
Encoding:
Perl POD Document  |  2004-08-02  |  24.7 KB  |  845 lines
  1. #----------------------------------------------------------------------------
  2. #
  3. # This is POPFile's top level Module object.
  4. #
  5. # Copyright (c) 2001-2003 John Graham-Cumming
  6. #
  7. #   This file is part of POPFile
  8. #
  9. #   POPFile is free software; you can redistribute it and/or modify
  10. #   it under the terms of the GNU General Public License as published by
  11. #   the Free Software Foundation; either version 2 of the License, or
  12. #   (at your option) any later version.
  13. #
  14. #   POPFile is distributed in the hope that it will be useful,
  15. #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. #   GNU General Public License for more details.
  18. #
  19. #   You should have received a copy of the GNU General Public License
  20. #   along with POPFile; if not, write to the Free Software
  21. #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  22. #
  23. #----------------------------------------------------------------------------
  24.  
  25. package POPFile::Module;
  26.  
  27. use strict;
  28. use IO::Select;
  29.  
  30. # ---------------------------------------------------------------------------------------------
  31. #
  32. # This module implements the base class for all POPFile Loadable Modules and
  33. # contains collection of methods that are common to all POPFile modules and only
  34. # selected ones need be overriden by subclasses
  35. #
  36. # POPFile is constructed from a collection of classes which all have special
  37. # PUBLIC interface functions:
  38. #
  39. # initialize() - called after the class is created to set default values for internal
  40. #                variables and global configuration information
  41. #
  42. # start()      - called once all configuration has been read and POPFile is ready to start
  43. #                operating
  44. #
  45. # stop()       - called when POPFile is shutting down
  46. #
  47. # service()    - called by the main POPFile process to allow a submodule to do its own
  48. #                work (this is optional for modules that do not need to perform any service)
  49. #
  50. # prefork()    - called when a module has requested a fork, but before the fork happens
  51. #
  52. # forked()     - called when a module has forked the process.  This is called within the child
  53. #                process and should be used to clean up
  54. #
  55. # postfork()   - called in the parent process to tell it that the fork has occurred.  This is
  56. #                like forked but in the parent
  57. #
  58. # reaper()     - called when a process has terminated to give a module a chance to do
  59. #                whatever clean up is needed
  60. #
  61. # name()       - returns a simple name for the module by which other modules can get access
  62. #                through the %components hash.  The name returned here will be the name
  63. #                used as the key for this module in %components
  64. #
  65. # deliver()    - called by the message queue to deliver a message
  66. #
  67. # The following methods are PROTECTED and should be accessed by sub classes:
  68. #
  69. # log_()       - sends a string to the logger
  70. #
  71. # config_()    - gets or sets a configuration parameter for this module
  72. #
  73. # mq_post_()   - post a message to the central message queue
  74. #
  75. # mq_register_() register for messages from the message queue
  76. #
  77. # slurp_()       Reads a line up to CR, CRLF or LF
  78. #
  79. # register_configuration_item_() register a UI configuration item
  80. #
  81. # A note on the naming
  82. #
  83. # A method or variable that ends with an underscore is PROTECTED and should not be accessed
  84. # from outside the class (or subclass; in C++ its protected), to access a PROTECTED variable
  85. # you will find an equivalent getter/setter method with no underscore.
  86. #
  87. # Truly PRIVATE variables are indicated by a double underscore at the end of the name and
  88. # should not be accessed outside the class without going through a getter/setter and may
  89. # not be directly accessed by a subclass.
  90. #
  91. # For example
  92. #
  93. # $c->foo__() is a private method
  94. # $c->{foo__} is a private variable
  95. # $c->foo_() is a protected method
  96. # $c->{foo_} is a protected variable
  97. # $c->foo() is a public method that modifies $c->{foo_} it always returns the current
  98. # value of the variable it is referencing and if passed a value sets that corresponding
  99. # variable
  100. #
  101. # Copyright (c) 2001-2003 John Graham-Cumming
  102. #
  103. # ---------------------------------------------------------------------------------------------
  104.  
  105. # This variable is CLASS wide, not OBJECT wide and is used as temporary storage
  106. # for the slurp_ methods below.  It needs to be class wide because different objects
  107. # may call slurp on the same handle as the handle gets passed from object to
  108. # object.
  109.  
  110. my %slurp_data__;
  111.  
  112. #----------------------------------------------------------------------------
  113. # new
  114. #
  115. #   Class new() function, all real work gets done by initialize and
  116. #   the things set up here are more for documentation purposes than
  117. #   anything so that you know that they exists
  118. #
  119. #----------------------------------------------------------------------------
  120. sub new
  121. {
  122.     my $type = shift;
  123.     my $self;
  124.  
  125.     # A reference to the POPFile::Configuration module, every module is
  126.     # able to get configuration information through this, note that it
  127.     # is valid when initialize is called, however, the configuration is not
  128.     # read from disk until after initialize has been called
  129.  
  130.     $self->{configuration__} = 0; # PRIVATE
  131.  
  132.     # A reference to the POPFile::Logger module
  133.  
  134.     $self->{logger__}        = 0; # PRIVATE
  135.  
  136.     # A reference to the POPFile::MQ module
  137.  
  138.     $self->{mq__}            = 0;
  139.  
  140.     # The name of this module
  141.  
  142.     $self->{name__}          = ''; # PRIVATE
  143.  
  144.     # Used to tell any loops to terminate
  145.  
  146.     $self->{alive_}          = 1;
  147.  
  148.     # This is a reference to the pipeready() function in popfile.pl that it used
  149.     # to determine if a pipe is ready for reading in a cross platform way
  150.  
  151.     $self->{pipeready_}      = 0;
  152.  
  153.     # This is a reference to a function (forker) in popfile.pl that performs a fork
  154.     # and informs modules that a fork has occurred
  155.  
  156.     $self->{forker_}         = 0;
  157.  
  158.     return bless $self, $type;
  159. }
  160.  
  161. # ---------------------------------------------------------------------------------------------
  162. #
  163. # initialize
  164. #
  165. # Called to initialize the module, the main task that this function should perform is
  166. # setting up the default values of the configuration options for this object.  This is done
  167. # through the configuration_ hash value that will point the configuration module.
  168. #
  169. # Note that the configuration is not loaded from disk until after every module's initialize
  170. # has been called, so do not use any of these values until start() is called as they may
  171. # change
  172. #
  173. # The method should return 1 to indicate that it initialized correctly, if it returns
  174. # 0 then POPFile will abort loading immediately
  175. #
  176. # ---------------------------------------------------------------------------------------------
  177. sub initialize
  178. {
  179.     my ( $self ) = @_;
  180.  
  181.     return 1;
  182. }
  183.  
  184. # ---------------------------------------------------------------------------------------------
  185. #
  186. # start
  187. #
  188. # Called when all configuration information has been loaded from disk.
  189. #
  190. # The method should return 1 to indicate that it started correctly, if it returns
  191. # 0 then POPFile will abort loading immediately, returns 2 if everything OK but this
  192. # module does not want to continue to be used.
  193. #
  194. # ---------------------------------------------------------------------------------------------
  195. sub start
  196. {
  197.     my ( $self ) = @_;
  198.  
  199.     return 1;
  200. }
  201.  
  202. # ---------------------------------------------------------------------------------------------
  203. #
  204. # stop
  205. #
  206. # Called when POPFile is closing down, this is the last method that will get called before
  207. # the object is destroyed.  There is not return value from stop().
  208. #
  209. # ---------------------------------------------------------------------------------------------
  210. sub stop
  211. {
  212.     my ( $self ) = @_;
  213. }
  214.  
  215. # ---------------------------------------------------------------------------------------------
  216. #
  217. # reaper
  218. #
  219. # Called when a child process terminates somewhere in POPFile.  The object should check
  220. # to see if it was one of its children and do any necessary processing by calling waitpid()
  221. # on any child handles it has
  222. #
  223. # There is no return value from this method
  224. #
  225. # ---------------------------------------------------------------------------------------------
  226. sub reaper
  227. {
  228.     my ( $self ) = @_;
  229. }
  230.  
  231. # ---------------------------------------------------------------------------------------------
  232. #
  233. # service
  234. #
  235. # service() is a called periodically to give the module a chance to do housekeeping work.
  236. #
  237. # If any problem occurs that requires POPFile to shutdown service() should return 0 and
  238. # the top level process will gracefully terminate POPFile including calling all stop()
  239. # methods.  In normal operation return 1.
  240. #
  241. # ---------------------------------------------------------------------------------------------
  242. sub service
  243. {
  244.     my ( $self ) = @_;
  245.  
  246.     return 1;
  247. }
  248.  
  249. # ---------------------------------------------------------------------------------------------
  250. #
  251. # prefork
  252. #
  253. # This is called when some module is about to fork POPFile
  254. #
  255. # There is no return value from this method
  256. #
  257. # ---------------------------------------------------------------------------------------------
  258. sub prefork
  259. {
  260.     my ( $self ) = @_;
  261. }
  262.  
  263. # ---------------------------------------------------------------------------------------------
  264. #
  265. # forked
  266. #
  267. # This is called when some module forks POPFile and is within the context of the child
  268. # process so that this module can close any duplicated file handles that are not needed.
  269. #
  270. # There is no return value from this method
  271. #
  272. # ---------------------------------------------------------------------------------------------
  273. sub forked
  274. {
  275.     my ( $self ) = @_;
  276. }
  277.  
  278. # ---------------------------------------------------------------------------------------------
  279. #
  280. # postfork
  281. #
  282. # This is called when some module has just forked POPFile.  It is called in the parent
  283. # process.
  284. #
  285. # There is no return value from this method
  286. #
  287. # ---------------------------------------------------------------------------------------------
  288. sub postfork
  289. {
  290.     my ( $self ) = @_;
  291. }
  292.  
  293. # ---------------------------------------------------------------------------------------------
  294. #
  295. # deliver
  296. #
  297. # Called by the message queue to deliver a message
  298. #
  299. # There is no return value from this method
  300. #
  301. # ---------------------------------------------------------------------------------------------
  302. sub deliver
  303. {
  304.     my ( $self, $type, $message, $parameter ) = @_;
  305. }
  306.  
  307. # ---------------------------------------------------------------------------------------------
  308. #
  309. # log_
  310. #
  311. # Called by a subclass to send a message to the logger, the logged message will be prefixed
  312. # by the name of the module in use
  313. #
  314. # $message           The message to log
  315. #
  316. # There is no return value from this method
  317. #
  318. # ---------------------------------------------------------------------------------------------
  319. sub log_
  320. {
  321.     my ( $self, $message ) = @_;
  322.  
  323.     my ( $package, $file, $line ) = caller;
  324.     $self->{logger__}->debug( $self->{name__} . ": $line: " . $message );
  325. }
  326.  
  327. # ---------------------------------------------------------------------------------------------
  328. #
  329. # config_
  330. #
  331. # Called by a subclass to get or set a configuration parameter
  332. #
  333. # $name              The name of the parameter (e.g. 'port')
  334. # $value             (optional) The value to set
  335. #
  336. # If called with just a $name then config_() will return the current value
  337. # of the configuration parameter.
  338. #
  339. # ---------------------------------------------------------------------------------------------
  340. sub config_
  341. {
  342.     my ( $self, $name, $value ) = @_;
  343.  
  344.     return $self->module_config_( $self->{name__}, $name, $value );
  345. }
  346.  
  347. # ---------------------------------------------------------------------------------------------
  348. #
  349. # mq_post_
  350. #
  351. # Called by a subclass to post a message to the message queue
  352. #
  353. # $type              Type of message to send
  354. # $message           Message to send
  355. # $parameter         Message parameters
  356. #
  357. # ---------------------------------------------------------------------------------------------
  358. sub mq_post_
  359. {
  360.     my ( $self, $type, $message, $parameter ) = @_;
  361.  
  362.     return $self->{mq__}->post( $type, $message, $parameter );
  363. }
  364.  
  365. # ---------------------------------------------------------------------------------------------
  366. #
  367. # mq_register_
  368. #
  369. # Called by a subclass to register with the message queue for messages
  370. #
  371. # $type              Type of message to send
  372. # $object            Callback object
  373. #
  374. # ---------------------------------------------------------------------------------------------
  375. sub mq_register_
  376. {
  377.     my ( $self, $type, $object ) = @_;
  378.  
  379.     return $self->{mq__}->register( $type, $object );
  380. }
  381.  
  382. # ---------------------------------------------------------------------------------------------
  383. #
  384. # global_config_
  385. #
  386. # Called by a subclass to get or set a global (i.e. not module specific) configuration parameter
  387. #
  388. # $name              The name of the parameter (e.g. 'port')
  389. # $value             (optional) The value to set
  390. #
  391. # If called with just a $name then global_config_() will return the current value
  392. # of the configuration parameter.
  393. #
  394. # ---------------------------------------------------------------------------------------------
  395. sub global_config_
  396. {
  397.     my ( $self, $name, $value ) = @_;
  398.  
  399.     return $self->module_config_( 'GLOBAL', $name, $value );
  400. }
  401.  
  402. # ---------------------------------------------------------------------------------------------
  403. #
  404. # module_config_
  405. #
  406. # Called by a subclass to get or set a module specific configuration parameter
  407. #
  408. # $module            The name of the module that owns the parameter (e.g. 'pop3')
  409. # $name              The name of the parameter (e.g. 'port')
  410. # $value             (optional) The value to set
  411. #
  412. # If called with just a $module and $name then module_config_() will return the current value
  413. # of the configuration parameter.
  414. #
  415. # ---------------------------------------------------------------------------------------------
  416. sub module_config_
  417. {
  418.     my ( $self, $module, $name, $value ) = @_;
  419.  
  420.     return $self->{configuration__}->parameter( $module . "_" . $name, $value );
  421. }
  422.  
  423. # ---------------------------------------------------------------------------------------------
  424. #
  425. # register_configuration_item_
  426. #
  427. # Called by a subclass to register a UI element
  428. #
  429. # $type, $name, $object     See register_configuration_item in UI::HTML
  430. #
  431. # ---------------------------------------------------------------------------------------------
  432. sub register_configuration_item_
  433. {
  434.     my ( $self, $type, $name, $object ) = @_;
  435.  
  436.     return $self->mq_post_( 'UIREG', "$type:$name", $object );
  437. }
  438.  
  439. # ---------------------------------------------------------------------------------------------
  440. #
  441. # get_user_path_, get_root_path_
  442. #
  443. # Wrappers for POPFile::Configuration get_user_path and get_root_path
  444. #
  445. # $path             The path to modify
  446. #
  447. # ---------------------------------------------------------------------------------------------
  448. sub get_user_path_
  449. {
  450.     my ( $self, $path, $sandbox ) = @_;
  451.  
  452.     return $self->{configuration__}->get_user_path( $path, $sandbox );
  453. }
  454.  
  455. sub get_root_path_
  456. {
  457.     my ( $self, $path, $sandbox ) = @_;
  458.  
  459.     return $self->{configuration__}->get_root_path( $path, $sandbox );
  460. }
  461.  
  462. # ---------------------------------------------------------------------------------------------
  463. #
  464. # flush_slurp_data__
  465. #
  466. # Helper function for slurp_ that returns an empty string if the slurp buffer doesn't
  467. # contain a complete line, or returns a complete line.
  468. #
  469. # $handle            Handle to read from, which should be in binmode
  470. #
  471. # ---------------------------------------------------------------------------------------------
  472. sub flush_slurp_data__
  473. {
  474.     my ( $self, $handle ) = @_;
  475.  
  476.     # The acceptable line endings are CR, CRLF or LF.  So we look for
  477.     # them using these regexps.
  478.  
  479.     # Look for LF
  480.  
  481.     if ( $slurp_data__{"$handle"}{data} =~ s/^([^\015\012]*\012)// ) {
  482.         return $1;
  483.     }
  484.  
  485.     # Look for CRLF
  486.  
  487.     if ( $slurp_data__{"$handle"}{data} =~ s/^([^\015\012]*\015\012)// ) {
  488.         return $1;
  489.     }
  490.  
  491.     # Look for CR, here we have to be careful because of the fact that the current
  492.     # total buffer could be ending with CR and there could actually be an LF to
  493.     # read, so we check for that situation if we find CR
  494.  
  495.     if ( $slurp_data__{"$handle"}{data} =~ s/^([^\015\012]*\015)// ) {
  496.         my $cr = $1;
  497.  
  498.         # If we have removed everything from the buffer then see if there's
  499.         # another character available to read, if there is then get it and check
  500.         # to see if it is LF (in which case this is a line ending CRLF), otherwise
  501.         # just save it
  502.  
  503.         if ( $slurp_data__{"$handle"}{data} eq '' ) {
  504.  
  505.             # This unpleasant boolean is to handle the case where we are slurping
  506.             # a non-socket stream under Win32
  507.  
  508.             if ( ( ( $handle !~ /socket/i ) && ( $^O eq 'MSWin32' ) ) ||        # PROFILE BLOCK START
  509.                  defined( $slurp_data__{"$handle"}{select}->can_read( $self->global_config_( 'timeout' ) ) ) ) { # PROFILE BLOCK STOP
  510.  
  511.                 my $c;
  512.                 my $retcode = sysread( $handle, $c, 1 );
  513.                 if ( $retcode == 1 ) {
  514.                     if ( $c eq "\012" ) {
  515.                         $cr .= $c;
  516.                     } else {
  517.                         $slurp_data__{"$handle"}{data} = $c;
  518.             }
  519.         }
  520.         }
  521.     }
  522.  
  523.         return $cr;
  524.     }
  525.  
  526.     return '';
  527. }
  528.  
  529. # ---------------------------------------------------------------------------------------------
  530. #
  531. # slurp_data_size__
  532. #
  533. # $handle          A connection handle previously used with slurp_
  534. #
  535. # Returns the length of data currently buffered for the passed in handle
  536. #
  537. # ---------------------------------------------------------------------------------------------
  538.  
  539. sub slurp_data_size__
  540. {
  541.     my ( $self, $handle ) = @_;
  542.  
  543.     return defined($slurp_data__{"$handle"}{data})?length($slurp_data__{"$handle"}{data}):0;
  544. }
  545.  
  546. # ---------------------------------------------------------------------------------------------
  547. #
  548. # slurp_buffer_
  549. #
  550. # $handle                     Handle to read from, which should be in binmode
  551. # $length                     The amount of data to read
  552. #
  553. # Reads up to $length bytes from $handle and returns it, if there is nothing
  554. # to return because the buffer is empty and the handle is at eof then this
  555. # will return undef
  556. #
  557. # ---------------------------------------------------------------------------------------------
  558.  
  559. sub slurp_buffer_
  560. {
  561.     my ( $self, $handle, $length ) = @_;
  562.  
  563.     while ( $self->slurp_data_size__( $handle ) < $length ) {
  564.         my $c;
  565.         if ( sysread( $handle, $c, $length ) > 0 ) {
  566.             $slurp_data__{"$handle"}{data} .= $c;
  567.     } else {
  568.             last;
  569.     }
  570.     }
  571.  
  572.     my $result = '';
  573.  
  574.     if ( $self->slurp_data_size__( $handle ) < $length ) {
  575.         $result = $slurp_data__{"$handle"}{data};
  576.         $slurp_data__{"$handle"}{data} = '';
  577.     } else {
  578.         $result = substr( $slurp_data__{"$handle"}{data}, 0, $length );
  579.         $slurp_data__{"$handle"}{data} = substr( $slurp_data__{"$handle"}{data}, $length );
  580.     }
  581.  
  582.     return ($result ne '')?$result:undef;
  583. }
  584.  
  585. # ---------------------------------------------------------------------------------------------
  586. #
  587. # slurp_
  588. #
  589. # A replacement for Perl's <> operator on a handle that reads a line until CR, CRLF or LF
  590. # is encountered.  Returns the line if read (with the CRs and LFs), or undef if at the EOF,
  591. # blocks waiting for something to read.
  592. #
  593. # IMPORTANT NOTE: If you don't read to the end of the stream using slurp_ then there may be
  594. #                 a small memory leak caused by slurp_'s buffering of data in the Module's
  595. #                 hash.   To flush it make a call to slurp_ when you know that the handle is
  596. #                 at the end of the stream, or call done_slurp_ on the handle.
  597. #
  598. # $handle            Handle to read from, which should be in binmode
  599. #
  600. # ---------------------------------------------------------------------------------------------
  601. sub slurp_
  602. {
  603.     my ( $self, $handle ) = @_;
  604.  
  605.     if ( !defined( $slurp_data__{"$handle"}{data} ) ) {
  606.         $slurp_data__{"$handle"}{select} = new IO::Select( $handle );
  607.         $slurp_data__{"$handle"}{data}   = '';
  608.     }
  609.  
  610.     my $result = $self->flush_slurp_data__( $handle );
  611.  
  612.     if ( $result ne '' ) {
  613.         return $result;
  614.     }
  615.  
  616.     my $c;
  617.  
  618.     while ( sysread( $handle, $c, 160 ) > 0 ) {
  619.         $slurp_data__{"$handle"}{data} .= $c;
  620.  
  621.         $result = $self->flush_slurp_data__( $handle );
  622.  
  623.         if ( $result ne '' ) {
  624.             return $result;
  625.         }
  626.     }
  627.  
  628.     # If we get here with something in line then the file ends without any
  629.     # CRLF so return the line, otherwise we are reading at the end of the
  630.     # stream/file so return undef
  631.  
  632.     my $remaining = $slurp_data__{"$handle"}{data};
  633.     $self->done_slurp_( $handle );
  634.  
  635.     if ( $remaining eq '' ) {
  636.         return undef;
  637.     } else {
  638.         return $remaining;
  639.     }
  640. }
  641.  
  642. # ---------------------------------------------------------------------------------------------
  643. #
  644. # done_slurp_
  645. #
  646. # Call this when have finished calling slurp_ on a handle and need to clean up temporary
  647. # buffer space used by slurp_
  648. #
  649. # ---------------------------------------------------------------------------------------------
  650.  
  651. sub done_slurp_
  652. {
  653.     my ( $self, $handle ) = @_;
  654.  
  655.     delete $slurp_data__{"$handle"}{select};
  656.     delete $slurp_data__{"$handle"}{data};
  657.     delete $slurp_data__{"$handle"};
  658. }
  659.  
  660. # ---------------------------------------------------------------------------------------------
  661. #
  662. # flush_extra_ - Read extra data from the mail server and send to client, this is to handle
  663. #               POP servers that just send data when they shouldn't.  I've seen one that sends
  664. #               debug messages!
  665. #
  666. #               Returns the extra data flushed
  667. #
  668. # $mail        The handle of the real mail server
  669. # $client      The mail client talking to us
  670. # $discard     If 1 then the extra output is discarded
  671. #
  672. # ---------------------------------------------------------------------------------------------
  673. sub flush_extra_
  674. {
  675.     my ( $self, $mail, $client, $discard ) = @_;
  676.  
  677.     $discard = 0 if ( !defined( $discard ) );
  678.  
  679.     # If slurp has any data, we want it
  680.     if ( $self->slurp_data_size__($mail) ) {
  681.  
  682.         print $client $slurp_data__{"$mail"}{data} if ( $discard != 1 );
  683.         $slurp_data__{"$mail"}{data} = '';
  684.     }
  685.  
  686.     # Do we always attempt to read?
  687.  
  688.     my $always_read = 0;
  689.     my $selector;
  690.  
  691.     if (($^O eq 'MSWin32') && !($mail =~ /socket/i) ) {
  692.         # select only works reliably on IO::Sockets in Win32, so we always read files
  693.         # on MSWin32 (sysread returns 0 for eof)
  694.  
  695.         $always_read = 1; # PROFILE PLATFORM START MSWin32
  696.                           # PROFILE PLATFORM STOP
  697.     } else {
  698.  
  699.         # in all other cases, a selector is used to decide whether to read
  700.  
  701.         $selector    = new IO::Select( $mail );
  702.         $always_read = 0;
  703.     }
  704.  
  705.     my $ready;
  706.  
  707.     my $buf        = '';
  708.     my $full_buf   = '';
  709.     my $max_length = 8192;
  710.     my $n;
  711.  
  712.     while ( $always_read || defined( $selector->can_read(0.01) ) ) {
  713.         $n = sysread( $mail, $buf, $max_length, length $buf );
  714.  
  715.         if ( $n > 0 ) {
  716.             print $client $buf if ( $discard != 1 );
  717.             $full_buf .= $buf;
  718.         } else {
  719.             if ($n == 0) {
  720.                 last;
  721.         }
  722.         }
  723.     }
  724.  
  725.    return $full_buf;
  726. }
  727.  
  728. # GETTER/SETTER methods.  Note that I do not expect documentation of these unless they
  729. # are non-trivial since the documentation would be a waste of space
  730. #
  731. # The only thing to note is the idiom used, stick to that and there's no need to
  732. # document these
  733. #
  734. #   sub foo
  735. #   {
  736. #       my ( $self, $value ) = @_;
  737. #
  738. #       if ( defined( $value ) ) {
  739. #           $self->{foo_} = $value;
  740. #       }
  741. #
  742. #       return $self->{foo_};
  743. #   }
  744. #
  745. # This method access the foo_ variable for reading or writing, $c->foo() read foo_ and
  746. # $c->foo( 'foo' ) writes foo_
  747.  
  748. sub mq
  749. {
  750.     my ( $self, $value ) = @_;
  751.  
  752.     if ( defined( $value ) ) {
  753.         $self->{mq__} = $value;
  754.     }
  755.  
  756.     return $self->{mq__};
  757. }
  758.  
  759. sub configuration
  760. {
  761.     my ( $self, $value ) = @_;
  762.  
  763.     if ( defined( $value ) ) {
  764.         $self->{configuration__} = $value;
  765.     }
  766.  
  767.     return $self->{configuration__};
  768. }
  769.  
  770. sub forker
  771. {
  772.     my ( $self, $value ) = @_;
  773.  
  774.     if ( defined( $value ) ) {
  775.         $self->{forker_} = $value;
  776.     }
  777.  
  778.     return $self->{forker_};
  779. }
  780.  
  781. sub logger
  782. {
  783.     my ( $self, $value ) = @_;
  784.  
  785.     if ( defined( $value ) ) {
  786.         $self->{logger__} = $value;
  787.     }
  788.  
  789.     return $self->{logger__};
  790. }
  791.  
  792. sub pipeready
  793. {
  794.     my ( $self, $value ) = @_;
  795.  
  796.     if ( defined( $value ) ) {
  797.         $self->{pipeready_} = $value;
  798.     }
  799.  
  800.     return $self->{pipeready_};
  801. }
  802.  
  803. sub alive
  804. {
  805.     my ( $self, $value ) = @_;
  806.  
  807.     if ( defined( $value ) ) {
  808.         $self->{alive_} = $value;
  809.     }
  810.  
  811.     return $self->{alive_};
  812. }
  813.  
  814. sub name
  815. {
  816.     my ( $self, $value ) = @_;
  817.  
  818.     if ( defined( $value ) ) {
  819.         $self->{name__} = $value;
  820.     }
  821.  
  822.     return $self->{name__};
  823. }
  824.  
  825. sub version
  826. {
  827.     my ( $self, $value ) = @_;
  828.  
  829.     if ( defined( $value ) ) {
  830.         $self->{version_} = $value;
  831.     }
  832.  
  833.     return $self->{version_};
  834. }
  835.  
  836. sub last_ten_log_entries
  837. {
  838.     my ( $self ) = @_;
  839.  
  840.     return $self->{logger__}->last_ten();
  841. }
  842.  
  843. 1;
  844.  
  845.