home *** CD-ROM | disk | FTP | other *** search
/ PC Open 101 / PC Open 101 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / POPFile / API.pm next >
Encoding:
Perl POD Document  |  2004-09-21  |  6.1 KB  |  147 lines
  1. package POPFile::API;
  2.  
  3. # ---------------------------------------------------------------------------------------------
  4. #
  5. # API.pm --  The API to POPFile available through XML-RPC
  6. #
  7. # Copyright (c) 2001-2004 John Graham-Cumming
  8. #
  9. #   This file is part of POPFile
  10. #
  11. #   POPFile is free software; you can redistribute it and/or modify
  12. #   it under the terms of the GNU General Public License as published by
  13. #   the Free Software Foundation; either version 2 of the License, or
  14. #   (at your option) any later version.
  15. #
  16. #   POPFile is distributed in the hope that it will be useful,
  17. #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. #   GNU General Public License for more details.
  20. #
  21. #   You should have received a copy of the GNU General Public License
  22. #   along with POPFile; if not, write to the Free Software
  23. #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  24. #
  25. # ---------------------------------------------------------------------------------------------
  26.  
  27. sub new
  28. {
  29.     my $type = shift;
  30.     my $self;
  31.  
  32.     # This will store a reference to the classifier object
  33.  
  34.     $self->{c} = 0;
  35.         
  36.     bless $self, $type;
  37.     return $self;
  38. }
  39.  
  40.  
  41. # I'm generally against doing obscure things in Perl because it makes the code
  42. # hard to read, but since this entire file is a bunch of wrappers for the
  43. # API in Classifier::Bayes I'm going to do something really odd looking for the
  44. # sake of readability here.
  45. #
  46. # Take for example the get_session_key wrapper for get_session_key.
  47. # It contains the line:
  48. #
  49. #    shift->{c}->get_session_key( @_ )
  50. #
  51. # What this does is the following:
  52. #
  53. # 1. The parameters for get_session_key are as usual in @_.  The first
  54. #    parameter (since this is an object) is a reference to this object.
  55. #
  56. # 2. We use 'shift' to get the reference to us (in all other places I
  57. #    would call this $self).
  58. #
  59. # 3. We have a object variable called 'c' that contains a reference to the
  60. #    Classifier::Bayes object we need to make the real call in.
  61. #
  62. # 4. So shift->{c} is a reference to Classifier::Bayes and hence we can do
  63. #    shift->{c}->get_session_key() to call the real API.
  64. #
  65. # 5. shift has also popped the first parameter off of @_ leaving the rest of
  66. #    the parameters for get_session_key in @_.  Hence we can just pass in @_
  67. #    for all the parameters.
  68. #
  69. # 6. return is optional in Perl, so for the sake of horizontal space here I
  70. #    omit it.
  71.  
  72. sub get_session_key            { shift->{c}->get_session_key( @_ ); }
  73. sub release_session_key        { shift->{c}->release_session_key( @_ ); }
  74. sub classify                   { shift->{c}->classify( @_ ); }
  75. sub is_pseudo_bucket           { shift->{c}->is_pseudo_bucket( @_ ); }
  76. sub is_bucket                  { shift->{c}->is_bucket( @_ ); }
  77. sub get_bucket_word_count      { shift->{c}->get_bucket_word_count( @_ ); }
  78. sub get_word_count             { shift->{c}->get_word_count( @_ ); }
  79. sub get_count_for_word         { shift->{c}->get_count_for_word( @_ ); }
  80. sub get_bucket_unique_count    { shift->{c}->get_bucket_unique_count( @_ ); }
  81. sub get_unique_word_count      { shift->{c}->get_unique_word_count( @_ ); }
  82. sub get_bucket_color           { shift->{c}->get_bucket_color( @_ ); }
  83. sub set_bucket_color           { shift->{c}->set_bucket_color( @_ ); }
  84. sub get_bucket_parameter       { shift->{c}->get_bucket_parameter( @_ ); }
  85. sub set_bucket_parameter       { shift->{c}->set_bucket_parameter( @_ ); }
  86. sub create_bucket              { shift->{c}->create_bucket( @_ ); }
  87. sub delete_bucket              { shift->{c}->delete_bucket( @_ ); }
  88. sub rename_bucket              { shift->{c}->rename_bucket( @_ ); }
  89. sub add_messages_to_bucket     { shift->{c}->add_messages_to_bucket( @_ ); }
  90. sub add_message_to_bucket      { shift->{c}->add_message_to_bucket( @_ ); }
  91. sub remove_message_from_bucket { shift->{c}->remove_message_from_bucket( @_ ); }
  92. sub clear_bucket               { shift->{c}->clear_bucket( @_ ); }
  93. sub clear_magnets              { shift->{c}->clear_magnets( @_ ); }
  94. sub create_magnet              { shift->{c}->create_magnet( @_ ); }
  95. sub delete_magnet              { shift->{c}->delete_magnet( @_ ); }
  96. sub magnet_count               { shift->{c}->magnet_count( @_ ); }
  97. sub add_stopword               { shift->{c}->add_stopword( @_ ); }
  98. sub remove_stopword            { shift->{c}->remove_stopword( @_ ); }
  99. sub get_html_colored_message   { shift->{c}->get_html_colored_message( @_); }
  100.  
  101. # These APIs return lists and need to be altered to arrays before returning
  102. # them through XMLRPC otherwise you get the wrong result.
  103.  
  104. sub get_buckets                { [ shift->{c}->get_buckets( @_ ) ]; }
  105. sub get_pseudo_buckets         { [ shift->{c}->get_pseudo_buckets( @_ ) ]; }
  106. sub get_all_buckets            { [ shift->{c}->get_all_buckets( @_ ) ]; }
  107. sub get_buckets_with_magnets   { [ shift->{c}->get_buckets_with_magnets( @_ ) ]; }
  108. sub get_magnet_types_in_bucket { [ shift->{c}->get_magnet_types_in_bucket( @_ ) ]; }
  109. sub get_magnets                { [ shift->{c}->get_magnets( @_ ) ]; }
  110. sub get_magnet_types           { [ shift->{c}->get_magnet_types( @_ ) ]; }
  111. sub get_stopword_list          { [ shift->{c}->get_stopword_list( @_ ) ]; }
  112. sub get_bucket_word_list       { [ shift->{c}->get_bucket_word_list( @_ ) ]; }
  113. sub get_bucket_word_prefixes   { [ shift->{c}->get_bucket_word_prefixes( @_ ) ]; }
  114.  
  115. # This API is used to add a message to POPFile's history, process the message
  116. # and do all the things POPFile would have done if it had received the message
  117. # through its proxies.
  118. #
  119. # Pass in the name of file to read and a file to write.  The read file
  120. # will be processed and the out file created containing the processed
  121. # message.
  122. #
  123. # Returns the same output as classify_and_modify (which contains the
  124. # slot ID for the newly added message, the classification and magnet
  125. # ID).  If it fails it returns undef.
  126.  
  127. sub handle_message
  128. {
  129.     my ( $self, $session, $in, $out ) = @_;
  130.  
  131.     # Convert the two files into streams that can be passed to the
  132.     # classifier
  133.  
  134.     open IN, "<$in" or return undef;
  135.     open OUT, ">$out" or return undef;
  136.  
  137.     my @result = $self->{c}->classify_and_modify(
  138.         $session, \*IN, \*OUT, undef );
  139.  
  140.     close OUT;
  141.     close IN;
  142.  
  143.     return @result;
  144. }
  145.  
  146. 1;
  147.