popfile-commit — CVS commit list messages

[popfile-commit] engine/Classifier Bayes.pm, 1.353, 1.354 MailParse.pm, 1.229, 1.230

[naoki i. <am...@us...>]

Update of /cvsroot/popfile/engine/Classifier
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26968/Classifier

Modified Files:
	Bayes.pm MailParse.pm 
Log Message:
Japanese users now choose the Japanese parser by changing 'bayes_nihongo_parser' option.
Performance improvement for Japanese users.
Decode the encoded attatchment file names.

Index: Bayes.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/Bayes.pm,v
retrieving revision 1.353
retrieving revision 1.354
diff -C2 -d -r1.353 -r1.354
*** Bayes.pm	26 Nov 2007 15:22:48 -0000	1.353
--- Bayes.pm	27 Nov 2007 14:44:56 -0000	1.354
***************
*** 230,233 ****
--- 230,238 ----
      $self->config_( 'localhostname', '' );
  
+     # Japanese wakachigaki parser ('kakasi' or 'mecab' or 'internal').
+     # TODO: Users can choose the parser engine to use?
+ 
+     $self->config_( 'nihongo_parser', 'kakasi' );
+ 
      $self->mq_register_( 'COMIT', $self );
      $self->mq_register_( 'RELSE', $self );
***************
*** 310,326 ****
      # Windows and using the fork.
  
!     if ( ( $self->{parser__}->{lang__} eq 'Nihongo' ) && ( $^O eq 'MSWin32' ) && 
!          ( ( ( $self->user_module_config_( 1, 'pop3', 'enabled' ) ) && 
!              ( $self->user_module_config_( 1, 'pop3', 'force_fork' ) ) ) || 
!            ( ( $self->user_module_config_( 1, 'nntp', 'enabled' ) ) && 
!              ( $self->user_module_config_( 1, 'nntp', 'force_fork' ) ) ) || 
!            ( ( $self->user_module_config_( 1, 'smtp', 'enabled' ) ) && 
!              ( $self->user_module_config_( 1, 'smtp', 'force_fork' ) ) ) ) ) {
!         $self->{parser__}->{need_kakasi_mutex__} = 1;
  
!         # Prepare the Mutex.
!         require POPFile::Mutex;
!         $self->{parser__}->{kakasi_mutex__} = new POPFile::Mutex( 'mailparse_kakasi' );
!         $self->log_( 2, "Create mutex for Kakasi." );
      }
  
--- 315,347 ----
      # Windows and using the fork.
  
!     if ( $self->{parser__}->{lang__} eq 'Nihongo' ) {
!         # Setup Nihongo (Japanese) parser.
  
!         my $nihongo_parser = $self->config_( 'nihongo_parser' );
! 
!         $nihongo_parser = $self->{parser__}->setup_nihongo_parser( $nihongo_parser );
! 
!         $self->log_( 2, "Use Nihongo (Japanese) parser : $nihongo_parser" );
!         $self->config_( 'nihongo_parser', $nihongo_parser );
! 
!         # Since Text::Kakasi is not thread-safe, we use it under the
!         # control of a Mutex to avoid a crash if we are running on
!         # Windows and using the fork.
! 
!         if ( ( $nihongo_parser eq 'kakasi' ) && ( $^O eq 'MSWin32' ) && 
!              ( ( ( $self->user_module_config_( 1, 'pop3', 'enabled' ) ) && 
!                  ( $self->user_module_config_( 1, 'pop3', 'force_fork' ) ) ) || 
!                ( ( $self->user_module_config_( 1, 'nntp', 'enabled' ) ) && 
!                  ( $self->user_module_config_( 1, 'nntp', 'force_fork' ) ) ) || 
!                ( ( $self->user_module_config_( 1, 'smtp', 'enabled' ) ) && 
!                  ( $self->user_module_config_( 1, 'smtp', 'force_fork' ) ) ) ) ) {
! 
!             $self->{parser__}->{need_kakasi_mutex__} = 1;
! 
!             # Prepare the Mutex.
!             require POPFile::Mutex;
!             $self->{parser__}->{kakasi_mutex__} = new POPFile::Mutex( 'mailparse_kakasi' );
!             $self->log_( 2, "Create mutex for Kakasi." );
!         }
      }
  

Index: MailParse.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/MailParse.pm,v
retrieving revision 1.229
retrieving revision 1.230
diff -C2 -d -r1.229 -r1.230
*** MailParse.pm	26 Nov 2007 15:22:48 -0000	1.229
--- MailParse.pm	27 Nov 2007 14:44:56 -0000	1.230
***************
*** 70,73 ****
--- 70,92 ----
  my $non_symbol_euc_jp = "(?:$non_symbol_two_bytes_euc_jp|$three_bytes_euc_jp|$cho_on_symbol)";
  
+ # Constants for the internal wakachigaki parser.
+ # Kind of EUC-JP chars
+ my $euc_jp_symbol = '[\xA1\xA2\xA6-\xA8\xAD\xF9-\xFC][\xA1-\xFE]'; # The symbols make a word of one character.
+ my $euc_jp_alphanum = '(?:\xA3[\xB0-\xB9\xC1-\xDA\xE1-\xFA])+'; # One or more alphabets and numbers
+ my $euc_jp_hiragana = '(?:(?:\xA4[\xA1-\xF3])+(?:\xA1[\xAB\xAC\xB5\xB6\xBC])*)+'; # One or more Hiragana characters
+ my $euc_jp_katakana = '(?:(?:\xA5[\xA1-\xF6])+(?:\xA1[\xA6\xBC\xB3\xB4])*)+'; # One or more Katakana characters
+ my $euc_jp_hkatakana = '(?:\x8E[\xA6-\xDF])+'; # One or more Half-width Katakana characters
+ my $euc_jp_kanji = '[\xB0-\xF4][\xA1-\xFE](?:[\xB0-\xF4][\xA1-\xFE]|\xA1\xB9)?'; # One or two Kanji characters
+ 
+ my $euc_jp_word = '(' . 
+     $euc_jp_alphanum . '|' . 
+     $euc_jp_hiragana . '|' . 
+     $euc_jp_katakana . '|' . 
+     $euc_jp_hkatakana . '|' . 
+     $euc_jp_kanji . '|' . 
+     $euc_jp_symbol . '|' . 
+     $ascii . '+|' .
+     $three_bytes_euc_jp . ')';
+ 
  # HTML entity mapping to character codes, this maps things like &
  # to their corresponding character code
***************
*** 231,234 ****
--- 250,256 ----
      $self->{prev__} = '';
  
+     # Object for the Nihongo (Japanese) parser.
+     $self->{nihongo_parser__} = undef;
+ 
      return $result;
  }
***************
*** 667,671 ****
                  # first char and the first byte of the second char.
  
!                 while ( $line =~ s/^$euc_jp*?(([A-Za-z]|$non_symbol_euc_jp)([A-Za-z\']|$non_symbol_euc_jp){1,44})([_\-,\.\"\'\)\?!:;\/& \t\n\r]{0,5}|$)//ox ) {
                      if ( ( $self->{in_headers__} == 0 ) && ( $self->{first20count__} < 20 ) ) {
                          $self->{first20count__} += 1;
--- 689,696 ----
                  # first char and the first byte of the second char.
  
!                 # In Japanese, one character words are common, so care about
!                 # words between 2 and 45 characters
! 
!                 while ( $line =~ s/^$euc_jp*?([A-Za-z][A-Za-z\']{2,44}|$non_symbol_euc_jp{2,45})(?:[_\-,\.\"\'\)\?!:;\/& \t\n\r]{0,5}|$)//o ) {
                      if ( ( $self->{in_headers__} == 0 ) && ( $self->{first20count__} < 20 ) ) {
                          $self->{first20count__} += 1;
***************
*** 673,684 ****
                      }
  
!                     my $matched_word = $1;
! 
!                     # In Japanese, 2 characters words are common, so
!                     # care about words between 2 and 45 characters
! 
!                     if (((length $matched_word >= 3) && ($matched_word =~ /[A-Za-z]/)) || ((length $matched_word >= 2) && ($matched_word =~ /$non_symbol_euc_jp/))) {
!                         update_word($self, $matched_word, $encoded, '', '[_\-,\.\"\'\)\?!:;\/ &\t\n\r]'."|$symbol_euc_jp", $prefix);
!                     }
                  }
              } else {
--- 698,702 ----
                      }
  
!                     update_word($self, $1, $encoded, '', '[_\-,\.\"\'\)\?!:;\/ &\t\n\r]|'.$symbol_euc_jp, $prefix);
                  }
              } else {
***************
*** 1583,1591 ****
      $self->{charset__} = '';
  
-     # Since Text::Kakasi is not thread-safe, we use it under the
-     # control of a Mutex to avoid a crash if we are running on
-     # Windows.
- 
      if ( $self->{lang__} eq 'Nihongo' ) {
          if ( $self->{need_kakasi_mutex__} ) {
              require POPFile::Mutex;
--- 1601,1609 ----
      $self->{charset__} = '';
  
      if ( $self->{lang__} eq 'Nihongo' ) {
+ 
+         # Since Text::Kakasi is not thread-safe, we use it under the
+         # control of a Mutex to avoid a crash if we are running on
+         # Windows.
          if ( $self->{need_kakasi_mutex__} ) {
              require POPFile::Mutex;
***************
*** 1593,1598 ****
          }
  
!         # Open Kakasi dictionary and initialize
!         init_kakasi();
      }
  }
--- 1611,1616 ----
          }
  
!         # Initialize Nihongo (Japanese) parser
!         $self->{nihongo_parser__}{init}( $self );
      }
  }
***************
*** 1636,1641 ****
  
      if ( $self->{lang__} eq 'Nihongo' ) {
!         # Close Kakasi dictionary
!         close_kakasi();
  
          if ( $self->{need_kakasi_mutex__} ) {
--- 1654,1659 ----
  
      if ( $self->{lang__} eq 'Nihongo' ) {
!         # Close Nihongo (Japanese) parser
!         $self->{nihongo_parser__}{close}( $self );
  
          if ( $self->{need_kakasi_mutex__} ) {
***************
*** 1676,1682 ****
              if ( !$self->{in_headers__} && $self->{encoding__} =~ /quoted\-printable/i) {
                  if ( $self->{lang__} eq 'Nihongo') {
!                     if ( $line =~ /=\r\n$/ ) {
                          # Encoded in multiple lines
-                         $line =~ s/=\r\n$//g;
                          $self->{prev__} .= $line;
                          next;
--- 1694,1699 ----
              if ( !$self->{in_headers__} && $self->{encoding__} =~ /quoted\-printable/i) {
                  if ( $self->{lang__} eq 'Nihongo') {
!                     if ( $line =~ s/=\r\n$// ) {
                          # Encoded in multiple lines
                          $self->{prev__} .= $line;
                          next;
***************
*** 1690,1701 ****
              }
  
!             if ( $self->{lang__} eq 'Nihongo' ) {
                  # Decode \x??
!                 if ( !$self->{in_headers__} ) {
!                     $line =~ s/\\x([8-9A-F][A-F0-9])/pack("C", hex($1))/eig;
!                 }
  
                  $line = convert_encoding( $line, $self->{charset__}, 'euc-jp', '7bit-jis', @{$encoding_candidates{$self->{lang__}}} );
!                 $line = parse_line_with_kakasi( $self, $line );
              }
  
--- 1707,1716 ----
              }
  
!             if ( $self->{lang__} eq 'Nihongo' && !$self->{in_headers__} && $self->{encoding__} !~ /base64/i ) {
                  # Decode \x??
!                 $line =~ s/\\x([8-9A-F][A-F0-9])/pack("C", hex($1))/eig;
  
                  $line = convert_encoding( $line, $self->{charset__}, 'euc-jp', '7bit-jis', @{$encoding_candidates{$self->{lang__}}} );
!                 $line = $self->{nihongo_parser__}{parse}( $self, $line );
              }
  
***************
*** 1869,1873 ****
          if ( $self->{lang__} eq 'Nihongo' ) {
              $decoded = convert_encoding( $decoded, $self->{charset__}, 'euc-jp', '7bit-jis', @{$encoding_candidates{$self->{lang__}}} );
!             $decoded = parse_line_with_kakasi( $self, $decoded );
          }
  
--- 1884,1888 ----
          if ( $self->{lang__} eq 'Nihongo' ) {
              $decoded = convert_encoding( $decoded, $self->{charset__}, 'euc-jp', '7bit-jis', @{$encoding_candidates{$self->{lang__}}} );
!             $decoded = $self->{nihongo_parser__}{parse}( $self, $decoded );
          }
  
***************
*** 2093,2099 ****
          if ( $self->{subject__} eq '' ) {
  
!             # In Japanese mode, parse subject with kakasi
  
!             $argument = parse_line_with_kakasi( $self, $argument ) if ( $self->{lang__} eq 'Nihongo' && $argument ne '' );
  
              $self->{subject__} = $argument;
--- 2108,2114 ----
          if ( $self->{subject__} eq '' ) {
  
!             # In Japanese mode, parse subject with Nihongo (Japanese) parser
  
!             $argument = $self->{nihongo_parser__}{parse}( $self, $argument ) if ( $self->{lang__} eq 'Nihongo' && $argument ne '' );
  
              $self->{subject__} = $argument;
***************
*** 2457,2460 ****
--- 2472,2478 ----
          print "Add filename $filename\n" if $self->{debug__};
  
+         # Decode the filename
+         $filename = $self->decode_string( $filename );
+ 
          my ( $name, $ext ) = $self->file_extension( $filename );
  
***************
*** 2484,2488 ****
      my ( $attachment, $filename ) = $self->match_attachment_filename( $params );
  
!     if ( $attachment eq 'attachment' ) {
          $self->add_attachment_filename( $filename ) ;
      }
--- 2502,2506 ----
      my ( $attachment, $filename ) = $self->match_attachment_filename( $params );
  
!     if ( defined( $attachment ) && ( $attachment eq 'attachment' ) ) {
          $self->add_attachment_filename( $filename ) ;
      }
***************
*** 2562,2566 ****
  
      if(ref $enc){
!        $from= $enc->name;
      } else {
  
--- 2580,2584 ----
  
      if(ref $enc){
!         $from = $enc->name;
      } else {
  
***************
*** 2580,2584 ****
          # Workaround for Encode::Unicode error bug.
          eval {
!             Encode::from_to($string, $from, $to);
          };
          $string = $orig_string if ($@);
--- 2598,2606 ----
          # Workaround for Encode::Unicode error bug.
          eval {
!             if (ref $enc) {
!                 $string = Encode::encode($to, $enc->decode($string));
!             } else {
!                 Encode::from_to($string, $from, $to);
!             }
          };
          $string = $orig_string if ($@);
***************
*** 2607,2613 ****
      return $line if ( $line =~ /^[\x00-\x7F]*$/ );
  
-     # This is used to parse Japanese
-     require Text::Kakasi;
- 
      # Split Japanese line into words using Kakasi Wakachigaki mode
      $line = Text::Kakasi::do_kakasi($line);
--- 2629,2632 ----
***************
*** 2618,2621 ****
--- 2637,2692 ----
  # ----------------------------------------------------------------------------
  #
+ # parse_line_with_mecab
+ #
+ # Parse a line with MeCab
+ #
+ # Split Japanese words by spaces using "MeCab" - Yet Another Part-of-Speech 
+ # and Morphological Analyzer.
+ #
+ # $line          The line to be parsed
+ #
+ # ----------------------------------------------------------------------------
+ sub parse_line_with_mecab
+ {
+     my ( $self, $line ) = @_;
+ 
+     # If the line does not contain Japanese characters, do nothing
+     return $line if ( $line =~ /^[\x00-\x7F]*$/ );
+ 
+     # Split Japanese line into words using MeCab
+     $line = $self->{nihongo_parser__}{obj_mecab}->parse($line);
+ 
+     # Remove the unnecessary white spaces
+     $line =~ s/([\x00-\x1f\x21-\x7f]) (?=[\x00-\x1f\x21-\x7f])/$1/g;
+ 
+     return $line;
+ }
+ 
+ # ----------------------------------------------------------------------------
+ #
+ # parse_line_with_internal_parser
+ #
+ # Parse a line with an internal perser
+ #
+ # Split characters by kind of the character
+ #
+ # $line          The line to be parsed
+ #
+ # ----------------------------------------------------------------------------
+ sub parse_line_with_internal_parser
+ {
+     my ( $self, $line ) = @_;
+ 
+     # If the line does not contain Japanese characters, do nothing
+     return $line if ( $line =~ /^[\x00-\x7F]*$/ );
+ 
+     # Split Japanese line into words by the kind of characters
+     $line =~ s/\G$euc_jp_word/$1 /og;
+ 
+     return $line;
+ }
+ 
+ # ----------------------------------------------------------------------------
+ #
  # init_kakasi
  #
***************
*** 2625,2635 ****
  sub init_kakasi
  {
-     require Text::Kakasi;
- 
      # Initialize Kakasi with Wakachigaki mode(-w is passed to 
      # Kakasi as argument). Both input and ouput encoding are 
      # EUC-JP.
  
!     Text::Kakasi::getopt_argv("kakasi", "-w", "-ieuc", "-oeuc");
  }
  
--- 2696,2722 ----
  sub init_kakasi
  {
      # Initialize Kakasi with Wakachigaki mode(-w is passed to 
      # Kakasi as argument). Both input and ouput encoding are 
      # EUC-JP.
  
!     Text::Kakasi::getopt_argv('kakasi', '-w', '-ieuc', '-oeuc');
! }
! 
! # ----------------------------------------------------------------------------
! #
! # init_mecab
! #
! # Create a new parser object of MeCab.
! #
! # ----------------------------------------------------------------------------
! sub init_mecab
! {
!     my ( $self ) = @_;
! 
!     # Initialize MeCab (-F %M\s -U %M\s -E \n is passed to MeCab as argument).
!     # Insert white spaces after words.
! 
!     $self->{nihongo_parser__}{obj_mecab} 
!         = MeCab::Tagger->new('-F %M\s -U %M\s -E \n');
  }
  
***************
*** 2643,2651 ****
  sub close_kakasi
  {
-     require Text::Kakasi;
- 
      Text::Kakasi::close_kanwadict();
  }
  
  
  1;
--- 2730,2823 ----
  sub close_kakasi
  {
      Text::Kakasi::close_kanwadict();
  }
  
+ # ----------------------------------------------------------------------------
+ #
+ # close_mecab
+ #
+ # Free the parser object of MeCab.
+ #
+ # ----------------------------------------------------------------------------
+ sub close_mecab
+ {
+     my ( $self ) = @_;
+ 
+     $self->{nihongo_parser__}{obj_mecab} = undef;
+ }
+ 
+ # ----------------------------------------------------------------------------
+ #
+ # setup_nihongo_parser
+ #
+ # Check whether Nihongo (Japanese) parsers are available and setup subroutines.
+ #
+ # $nihongo_parser  Nihongo (Japanese) parser to use
+ #                  ( kakasi / mecab / internal )
+ #
+ # ----------------------------------------------------------------------------
+ sub setup_nihongo_parser
+ {
+     my ( $self, $nihongo_parser ) = @_;
+ 
+     # If MeCab is installed, use MeCab.
+     if ( $nihongo_parser eq 'mecab' ) {
+         my $has_mecab = 0;
+ 
+         foreach my $prefix (@INC) {
+             my $realfilename = "$prefix/MeCab.pm";
+             if (-f $realfilename) {
+                 $has_mecab = 1;
+                 last;
+             }
+         }
+ 
+         # If MeCab is not installed, try to use Text::Kakasi.
+         $nihongo_parser = 'kakasi' unless ( $has_mecab );
+     }
+ 
+     # If Text::Kakasi is installed, use Text::Kakasi.
+     if ( $nihongo_parser eq 'kakasi' ) {
+         my $has_kakasi = 0;
+ 
+         foreach my $prefix (@INC) {
+             my $realfilename = "$prefix/Text/Kakasi.pm";
+             if (-f $realfilename) {
+                 $has_kakasi = 1;
+                 last;
+             }
+         }
+ 
+         # If Kakasi is not installed, use the internal parser.
+         $nihongo_parser = 'internal' unless ( $has_kakasi );
+     }
+ 
+     # Setup perser's subroutines
+     if ( $nihongo_parser eq 'mecab' ) {
+         # Import MeCab module
+         require MeCab;
+         import MeCab;
+ 
+         $self->{nihongo_parser__}{init} = \&init_mecab;
+         $self->{nihongo_parser__}{parse} = \&parse_line_with_mecab;
+         $self->{nihongo_parser__}{close} = \&close_mecab;
+     } elsif ( $nihongo_parser eq 'kakasi' ) {
+         # Import Text::Kakasi module
+         require Text::Kakasi;
+         import Text::Kakasi;
+ 
+         $self->{nihongo_parser__}{init} = \&init_kakasi;
+         $self->{nihongo_parser__}{parse} = \&parse_line_with_kakasi;
+         $self->{nihongo_parser__}{close} = \&close_kakasi;
+     } else {
+         # Require no external modules
+         $self->{nihongo_parser__}{init} = sub {}; # Needs no initialization
+         $self->{nihongo_parser__}{parse} = \&parse_line_with_internal_parser;
+         $self->{nihongo_parser__}{close} = sub {};
+     }
+ 
+     return $nihongo_parser;
+ }
+ 
  
  1;

[popfile-commit] engine/tests TestNihongo006.wrd,1.2,1.3

[naoki i. <am...@us...>]

Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26968/tests

Modified Files:
	TestNihongo006.wrd 
Log Message:
Japanese users now choose the Japanese parser by changing 'bayes_nihongo_parser' option.
Performance improvement for Japanese users.
Decode the encoded attatchment file names.

Index: TestNihongo006.wrd
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestNihongo006.wrd,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** TestNihongo006.wrd	6 Sep 2007 16:58:12 -0000	1.2
--- TestNihongo006.wrd	27 Nov 2007 14:44:56 -0000	1.3
***************
*** 1,4 ****
--- 1,6 ----
  216.104.176.121 2
+ advance 1
  charset:iso-2022-jp 1
+ current 1
  encoding:base64 1
  from:.ca 1
***************
*** 14,41 ****
  header:Subject 1
  header:To 1
! money 1
  to:.com 1
  to:example.com 1
  to:te...@ex... 1
  £±£± 1
  £±£´ 1
  £²£° 1
! £µ£° 1
  £Ï£Ë 1
  ¤ª¤¹¤¹¤á¤Î 1
  ¤«¤é 4
  ¤¬¤Ê¤¤ 1
  ¤Ç¤â 1
  ¤Ê¤· 1
  ¤Ê¤é 3
  ¤Ë¤Ï¤´ 1
  ¤Þ¤Ç 2
  ¤ì¤Ê¤¤¤¬ 1
  ¥¢¥ë¥Ð¥¤¥È 1
! ¥­¥ã¥ó¥Ú¡¼¥ó 1
  ¥µ¥Ý¡¼¥È 1
  ¥µ¥é¥ê¡¼¥Þ¥ó 1
  ¥¹¥Ú¥·¥ã¥ë¥×¥é¥ó 1
  ¥Ç¥ê¥Ð¥ê¡¼¥×¥é¥ó 1
  ¥Ñ¡¼¥È 1
  ¥×¥é¥ó 4
--- 16,61 ----
  header:Subject 1
  header:To 1
! money 2
! system 1
  to:.com 1
  to:example.com 1
  to:te...@ex... 1
+ £°£° 2
  £±£± 1
  £±£´ 1
+ £±£¸ 1
  £²£° 1
! £³£° 1
! £µ£° 3
  £Ï£Ë 1
+ ¤¤¤¿¤·¤Þ¤¹ 1
  ¤ª¤¹¤¹¤á¤Î 1
  ¤«¤é 4
+ ¤¯¤À¤µ¤¤ 1
  ¤¬¤Ê¤¤ 1
+ ¤¹¤Ù¤Æ 2
+ ¤½¤Î 3
  ¤Ç¤â 1
  ¤Ê¤· 1
  ¤Ê¤é 3
  ¤Ë¤Ï¤´ 1
+ ¤Î¤ß 1
+ ¤Þ¤»¤ó¤« 1
  ¤Þ¤Ç 2
+ ¤Þ¤Ç¤Ë¤ª 1
+ ¤ß¤Î 1
+ ¤â¤ª 2
+ ¤ë¤È 2
  ¤ì¤Ê¤¤¤¬ 1
+ ¥¢¥Ã¥× 2
+ ¥¢¥É¥Ð¥ó¥¹ 1
  ¥¢¥ë¥Ð¥¤¥È 1
! ¥­¥ã¥ó¥Ú¡¼¥ó 4
  ¥µ¥Ý¡¼¥È 1
  ¥µ¥é¥ê¡¼¥Þ¥ó 1
+ ¥·¥¹¥Æ¥à 1
  ¥¹¥Ú¥·¥ã¥ë¥×¥é¥ó 1
  ¥Ç¥ê¥Ð¥ê¡¼¥×¥é¥ó 1
+ ¥Õ¥é¥ó¥Á¥ã¥¤¥º 1
  ¥Ñ¡¼¥È 1
  ¥×¥é¥ó 4
***************
*** 43,51 ****
--- 63,79 ----
  °Ê¾å 1
  °ÊÆâ 1
+ ±Ä¶È»þ´Ö 1
+ ´Ô¸µ 2
  ´°Á´ 1
  ´Êñ 1
  ¶¦ÄÌ 1
+ ¶È¼Ô 1
+ ·î¼ý 1
  ¸½¶â 1
+ ¸Â¤ê 1
+ ¸ÂÄê 1
+ »°ÅÄ 1
  »î¤· 1
+ »þ¤Ë 2
  »þ´Ö 1
  ¼«Âð 1
***************
*** 53,73 ****
  ¼çÉØ 1
  ½Ð¤é 1
! ½÷À­ 1
  ½÷À­ÀìÍÑ 1
! ¾Ü¤·¤¯ 1
  ¿³ºº 1
  ¿¶¤ê¹þ¤ß 1
  ÁªÂò 1
  Á´¹ñ 1
! ¨Æü 3
  ÂÎÀ© 1
  ôÊÝ 1
! ÆÃÊÌ 2
  ÇÛã 1
  ÈëÌ©¸·¼é 1
  ɬÍ× 1
  ÉÔÍ× 2
  ÊÝ¾Ú¿Í 1
! Ëü±ß 2
  ÍèŹ 1
  Ω¤Æ 1
--- 81,116 ----
  ¼çÉØ 1
  ½Ð¤é 1
! ¼è¼¡ 1
! ¼ê¿ôÎÁ 2
! ½÷À­ 2
  ½÷À­ÀìÍÑ 1
! ¾Ü¤·¤¯ 3
! ¾ì¹ç 2
  ¿³ºº 1
  ¿¶¤ê¹þ¤ß 1
+ ¿½¹þ 1
+ ÀéËü 1
  ÁªÂò 1
  Á´¹ñ 1
! ¨Æü 5
  ÂÎÀ© 1
+ ÂåÍýŹ 1
  ôÊÝ 1
! Ä̾ï 2
! ÅìµþÅÔÌܹõ¶è 1
! Ʊ»þÊ罸 1
! ÆÃÊÌ 4
  ÇÛã 1
+ Èæ¤Ù 2
  ÈëÌ©¸·¼é 1
  ɬÍ× 1
  ÉÔÍ× 2
+ Ééô 1
+ Ê¿Æü 1
  ÊÝ¾Ú¿Í 1
! Ëè½µ¿åÍËÆü 1
! Ëü±ß 4
! ̵ÎÁ 1
! Ìܻؤ· 1
  ÍèŹ 1
  Ω¤Æ 1

[popfile-commit] engine/POPFile popfile_version,1.4.4.3,1.4.4.4

[John Graham-C. <jgr...@us...>]

Update of /cvsroot/popfile/engine/POPFile
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6890/POPFile

Modified Files:
      Tag: b0_22_2
	popfile_version 
Log Message:
Updated the version number and changed the Makefile so that it includes the IMAP folder in Services

Index: popfile_version
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/popfile_version,v
retrieving revision 1.4.4.3
retrieving revision 1.4.4.4
diff -C2 -d -r1.4.4.3 -r1.4.4.4
*** popfile_version	19 Jan 2007 12:42:44 -0000	1.4.4.3
--- popfile_version	27 Nov 2007 07:54:36 -0000	1.4.4.4
***************
*** 1,3 ****
  0
- 22
- 5
--- 1,3 ----
+ 1
+ 0
  0

[popfile-commit] engine Makefile, 1.41.4.2, 1.41.4.3 popfile.pck, 1.4.4.1, 1.4.4.2 vars.mak, 1.11.4.4, 1.11.4.5

[John Graham-C. <jgr...@us...>]

Update of /cvsroot/popfile/engine
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6890

Modified Files:
      Tag: b0_22_2
	Makefile popfile.pck vars.mak 
Log Message:
Updated the version number and changed the Makefile so that it includes the IMAP folder in Services

Index: vars.mak
===================================================================
RCS file: /cvsroot/popfile/engine/vars.mak,v
retrieving revision 1.11.4.4
retrieving revision 1.11.4.5
diff -C2 -d -r1.11.4.4 -r1.11.4.5
*** vars.mak	11 Jun 2007 07:14:51 -0000	1.11.4.4
--- vars.mak	27 Nov 2007 07:54:36 -0000	1.11.4.5
***************
*** 6,12 ****
  # Copyright (c) 2003-2006 John Graham-Cumming
  
! export POPFILE_MAJOR_VERSION=0
! export POPFILE_MINOR_VERSION=22
! export POPFILE_REVISION=5
  export POPFILE_VERSION:=$(POPFILE_MAJOR_VERSION).$(POPFILE_MINOR_VERSION).$(POPFILE_REVISION)
  POPFILE_VERSION_FILE=POPFile/popfile_version
--- 6,12 ----
  # Copyright (c) 2003-2006 John Graham-Cumming
  
! export POPFILE_MAJOR_VERSION=1
! export POPFILE_MINOR_VERSION=0
! export POPFILE_REVISION=0
  export POPFILE_VERSION:=$(POPFILE_MAJOR_VERSION).$(POPFILE_MINOR_VERSION).$(POPFILE_REVISION)
  POPFILE_VERSION_FILE=POPFile/popfile_version

Index: Makefile
===================================================================
RCS file: /cvsroot/popfile/engine/Makefile,v
retrieving revision 1.41.4.2
retrieving revision 1.41.4.3
diff -C2 -d -r1.41.4.2 -r1.41.4.3
*** Makefile	7 Feb 2006 11:09:54 -0000	1.41.4.2
--- Makefile	27 Nov 2007 07:54:36 -0000	1.41.4.3
***************
*** 105,109 ****
  $(POPFILE_ZIP): core manual skins POPFile/popfile_version
  
! core: popfile.pl otto.gif otto.png pix.gif black.gif bayes.pl pipe.pl insert.pl Classifier/*.pm POPFile/*.pm Proxy/*.pm Services/*.pm UI/*.pm v$(POPFILE_VERSION).change license stopwords favicon.ico $(POPFILE_VERSION_FILE) Classifier/popfile.sql popfile.pck
  	rm -f $(POPFILE_ZIP)
  	$(BUILD_ZIP)
--- 105,109 ----
  $(POPFILE_ZIP): core manual skins POPFile/popfile_version
  
! core: popfile.pl otto.gif otto.png pix.gif black.gif bayes.pl pipe.pl insert.pl Classifier/*.pm POPFile/*.pm Proxy/*.pm Services/*.pm  Services/IMAP/*.pm UI/*.pm v$(POPFILE_VERSION).change license stopwords favicon.ico $(POPFILE_VERSION_FILE) Classifier/popfile.sql popfile.pck
  	rm -f $(POPFILE_ZIP)
  	$(BUILD_ZIP)

Index: popfile.pck
===================================================================
RCS file: /cvsroot/popfile/engine/popfile.pck,v
retrieving revision 1.4.4.1
retrieving revision 1.4.4.2
diff -C2 -d -r1.4.4.1 -r1.4.4.2
*** popfile.pck	11 Jun 2007 07:14:51 -0000	1.4.4.1
--- popfile.pck	27 Nov 2007 07:54:36 -0000	1.4.4.2
***************
*** 1,3 ****
--- 1,4 ----
  OPTIONAL-Upgrades from v0.20.x	0.0.0	BerkeleyDB
+ REQUIRED	0.0.0	Carp
  REQUIRED	0.0.0	DBI
  REQUIRED	0.0.0	Date::Format
***************
*** 6,9 ****
--- 7,11 ----
  OPTIONAL-Japanese Language Support	0.0.0	Encode
  OPTIONAL-Japanese Language Support	0.0.0	Encode::Guess
+ REQUIRED	0.0.0	Fcntl
  REQUIRED	0.0.0	File::Copy
  REQUIRED	0.0.0	Getopt::Long
***************
*** 18,22 ****
--- 20,26 ----
  REQUIRED	0.0.0	MIME::Base64
  REQUIRED	0.0.0	MIME::QuotedPrint
+ OPTIONAL-	0.0.0	MeCab
  REQUIRED	0.0.0	POSIX
+ REQUIRED	0.0.0	Services::IMAP::Client
  REQUIRED	0.0.0	Sys::Hostname
  OPTIONAL-Japanese Language Support	0.0.0	Text::Kakasi

[popfile-commit] engine/POPFile History.pm,1.42,1.43

[naoki i. <am...@us...>]

Update of /cvsroot/popfile/engine/POPFile
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1362/POPFile

Modified Files:
	History.pm 
Log Message:
Fixed typos in referring dataase

Index: History.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/History.pm,v
retrieving revision 1.42
retrieving revision 1.43
diff -C2 -d -r1.42 -r1.43
*** History.pm	26 Nov 2007 15:22:48 -0000	1.42
--- History.pm	27 Nov 2007 00:05:07 -0000	1.43
***************
*** 247,251 ****
  
          # Avoid another POPFile process using the same committed id
!         $self->db__()->begin_work;
  
          # TODO Replace the hardcoded user ID 1 with the looked up
--- 247,251 ----
  
          # Avoid another POPFile process using the same committed id
!         $self->db_()->begin_work;
  
          # TODO Replace the hardcoded user ID 1 with the looked up
***************
*** 256,260 ****
  
          if ( defined( $test ) ) {
!             $self->db__()->commit;
              next;
          }
--- 256,260 ----
  
          if ( defined( $test ) ) {
!             $self->db_()->commit;
              next;
          }
***************
*** 272,276 ****
      my $result = $self->db_()->selectrow_arrayref(
                   "select id from history where committed = $r limit 1;");
!     $self->db__()->commit;
  
      my $slot = $result->[0];
--- 272,276 ----
      my $result = $self->db_()->selectrow_arrayref(
                   "select id from history where committed = $r limit 1;");
!     $self->db_()->commit;
  
      my $slot = $result->[0];
***************
*** 463,467 ****
      }
  
!     $self->db__()->begin_work;
      foreach my $entry (@{$self->{commit_list__}}) {
          my ( $session, $slot, $bucket, $magnet ) = @{$entry};
--- 463,467 ----
      }
  
!     $self->db_()->begin_work;
      foreach my $entry (@{$self->{commit_list__}}) {
          my ( $session, $slot, $bucket, $magnet ) = @{$entry};
***************
*** 611,615 ****
          }
      }
!     $self->db__()->commit;
  
      $self->{commit_list__} = ();
--- 611,615 ----
          }
      }
!     $self->db_()->commit;
  
      $self->{commit_list__} = ();
***************
*** 694,698 ****
  
      $self->database_()->tweak_sqlite( 1, 1, $self->db_() );
!     $self->db__()->begin_work;
  }
  
--- 694,698 ----
  
      $self->database_()->tweak_sqlite( 1, 1, $self->db_() );
!     $self->db_()->begin_work;
  }
  
***************
*** 709,713 ****
      my ( $self ) = @_;
  
!     $self->db__()->commit;
      $self->database_()->tweak_sqlite( 1, 0, $self->db_() );
  }
--- 709,713 ----
      my ( $self ) = @_;
  
!     $self->db_()->commit;
      $self->database_()->tweak_sqlite( 1, 0, $self->db_() );
  }

[popfile-commit] engine/Classifier Bayes.pm, 1.352, 1.353 MailParse.pm, 1.228, 1.229

[naoki i. <am...@us...>]

Update of /cvsroot/popfile/engine/Classifier
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3450/Classifier

Modified Files:
	Bayes.pm MailParse.pm 
Log Message:
Merge the most of my changes on branch b0_22_2.

Index: Bayes.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/Bayes.pm,v
retrieving revision 1.352
retrieving revision 1.353
diff -C2 -d -r1.352 -r1.353
*** Bayes.pm	31 Aug 2007 14:15:28 -0000	1.352
--- Bayes.pm	26 Nov 2007 15:22:48 -0000	1.353
***************
*** 301,305 ****
      # Pass in the current interface language for language specific parsing
  
!     $self->{parser__}->{lang__}  = $self->user_module_config_( 1, 'html', 'language' );
      $self->{unclassified__} = log( $self->user_config_( 1, 'unclassified_weight' ) );
  
--- 301,305 ----
      # Pass in the current interface language for language specific parsing
  
!     $self->{parser__}->{lang__}  = $self->user_module_config_( 1, 'html', 'language' ) || '';
      $self->{unclassified__} = log( $self->user_config_( 1, 'unclassified_weight' ) );
  

Index: MailParse.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/MailParse.pm,v
retrieving revision 1.228
retrieving revision 1.229
diff -C2 -d -r1.228 -r1.229
*** MailParse.pm	6 Sep 2007 16:59:12 -0000	1.228
--- MailParse.pm	26 Nov 2007 15:22:48 -0000	1.229
***************
*** 45,49 ****
  
  my %encoding_candidates = (
!     'Nihongo' => [ 'shiftjis', 'euc-jp', '7bit-jis' ]
  );
  
--- 45,49 ----
  
  my %encoding_candidates = (
!     'Nihongo' => [ 'cp932', 'euc-jp', '7bit-jis' ]
  );
  

[popfile-commit] engine/UI HTML.pm,1.375,1.376

[naoki i. <am...@us...>]

Update of /cvsroot/popfile/engine/UI
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3450/UI

Modified Files:
	HTML.pm 
Log Message:
Merge the most of my changes on branch b0_22_2.

Index: HTML.pm
===================================================================
RCS file: /cvsroot/popfile/engine/UI/HTML.pm,v
retrieving revision 1.375
retrieving revision 1.376
diff -C2 -d -r1.375 -r1.376
*** HTML.pm	6 Sep 2007 17:34:10 -0000	1.375
--- HTML.pm	26 Nov 2007 15:22:48 -0000	1.376
***************
*** 1618,1622 ****
                  if ( $self->user_config_( $self->{sessions__}{$session}{user}, 'language' ) =~ /^Nihongo$/ ) {
                 no locale;
!                $word =~ /^($euc_jp)/;
                 $c = $1;
              } else {
--- 1618,1622 ----
                  if ( $self->user_config_( $self->{sessions__}{$session}{user}, 'language' ) =~ /^Nihongo$/ ) {
                 no locale;
!                $word =~ /^($euc_jp)/o;
                 $c = $1;
              } else {

[popfile-commit] engine/languages Nihongo.msg,1.15,1.16

[naoki i. <am...@us...>]

Update of /cvsroot/popfile/engine/languages
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3450/languages

Modified Files:
	Nihongo.msg 
Log Message:
Merge the most of my changes on branch b0_22_2.

Index: Nihongo.msg
===================================================================
RCS file: /cvsroot/popfile/engine/languages/Nihongo.msg,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** Nihongo.msg	9 Feb 2007 14:27:51 -0000	1.15
--- Nihongo.msg	26 Nov 2007 15:22:49 -0000	1.16
***************
*** 70,74 ****
  Update                                  ¹¹¿·
  Refresh                                 ºÇ¿·¤Î¾õÂ֤˹¹¿·
! FAQ                                     FAQ ½é¿´¼Ô¡¦½é³Ø¼Ô¸þ¤±¤ÎQ&A½¸
  ID                                      ID
  Date                                    Æü»þ
--- 70,74 ----
  Update                                  ¹¹¿·
  Refresh                                 ºÇ¿·¤Î¾õÂ֤˹¹¿·
! FAQ                                     FAQ ½é¿´¼Ô¡¦½é³Ø¼Ô¸þ¤±¤ÎQ&A½¸
  ID                                      ID
  Date                                    Æü»þ

[popfile-commit] engine/POPFile History.pm,1.41,1.42

[naoki i. <am...@us...>]

Update of /cvsroot/popfile/engine/POPFile
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3450/POPFile

Modified Files:
	History.pm 
Log Message:
Merge the most of my changes on branch b0_22_2.

Index: History.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/History.pm,v
retrieving revision 1.41
retrieving revision 1.42
diff -C2 -d -r1.41 -r1.42
*** History.pm	6 Mar 2006 12:51:36 -0000	1.41
--- History.pm	26 Nov 2007 15:22:48 -0000	1.42
***************
*** 246,249 ****
--- 246,252 ----
          $self->log_( 2, "reserve_slot selected random number $r" );
  
+         # Avoid another POPFile process using the same committed id
+         $self->db__()->begin_work;
+ 
          # TODO Replace the hardcoded user ID 1 with the looked up
          # user ID from the session key
***************
*** 253,256 ****
--- 256,260 ----
  
          if ( defined( $test ) ) {
+             $self->db__()->commit;
              next;
          }
***************
*** 268,271 ****
--- 272,276 ----
      my $result = $self->db_()->selectrow_arrayref(
                   "select id from history where committed = $r limit 1;");
+     $self->db__()->commit;
  
      my $slot = $result->[0];
***************
*** 458,461 ****
--- 463,467 ----
      }
  
+     $self->db__()->begin_work;
      foreach my $entry (@{$self->{commit_list__}}) {
          my ( $session, $slot, $bucket, $magnet ) = @{$entry};
***************
*** 605,608 ****
--- 611,615 ----
          }
      }
+     $self->db__()->commit;
  
      $self->{commit_list__} = ();
***************
*** 687,690 ****
--- 694,698 ----
  
      $self->database_()->tweak_sqlite( 1, 1, $self->db_() );
+     $self->db__()->begin_work;
  }
  
***************
*** 701,704 ****
--- 709,713 ----
      my ( $self ) = @_;
  
+     $self->db__()->commit;
      $self->database_()->tweak_sqlite( 1, 0, $self->db_() );
  }

[popfile-commit] engine/Services/IMAP Client.pm,1.1,1.2

[Manni H. <man...@us...>]

Update of /cvsroot/popfile/engine/Services/IMAP
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23656/Services/IMAP

Added Files:
	Client.pm 
Log Message:
Add the client module to HEAD so we can get started with back-porting the changes to IMAP.pm

--- NEW FILE: Client.pm ---
# ----------------------------------------------------------------------------
#
# Services::IMAP::Client--- Helper module for the POPFile IMAP module
#
# Copyright (c) 2001-2007 John Graham-Cumming
#
#   $Revision: 1.2 $
#
#   This file is part of POPFile
#
#   POPFile is free software; you can redistribute it and/or modify it
#   under the terms of version 2 of the GNU General Public License as
#   published by the Free Software Foundation.
#
#   POPFile is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with POPFile; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#   Originally created by   Manni Heumann (man...@us...)
#   Modified by             Sam Schinke (ssc...@us...)
#   Patches by              David Lang (dav...@us...)
#
# ----------------------------------------------------------------------------

package Services::IMAP::Client;
use base qw/ POPFile::Module /;

use strict;
use warnings;

use IO::Socket;
use Carp;

my $eol = "\015\012";
my $cfg_separator = "-->";

# ----------------------------------------------------------------------------
#
# new - Create a new IMAP client object
#
# IN: two subroutine refs and an integer
#      config        -> reference to the config_ sub
#      log           -> reference to logger module
#      global_config -> reference to the global_config_ sub
#
# OUT: a blessed object or undef if the config hash was incomplete
# ----------------------------------------------------------------------------

sub new {
    my $class         = shift;
    my $config        = shift;
    my $log           = shift;
    my $global_config = shift;

    my $self = bless {}, $class;

    $self->{logger__} = $log or return;
    $self->{config__} = $config or return;
    $self->{global_config__} = $global_config or return;

    $self->{host}  = $self->config_( 'hostname' );
    $self->{port}  = $self->config_( 'port' );
    $self->{login} = $self->config_( 'login' );
    $self->{pass}  = $self->config_( 'password' );
    $self->{ssl}   = $self->config_( 'use_ssl' );

    $self->{timeout} = $self->global_config_( 'timeout' );
    $self->{cutoff}  = $self->global_config_( 'message_cutoff' );


    $self->{socket} = undef;
    $self->{folder} = undef;
    $self->{tag}    = 0;
    $self->{name__} = 'IMAP-Client';

    return $self;
}


# ----------------------------------------------------------------------------
#
# config_ - Replacement for POPFile::Module::config_
# ----------------------------------------------------------------------------

sub config_ {
    my $self = shift;
    return &{$self->{config__}}( @_ );
}


# ----------------------------------------------------------------------------
#
# global_config_ - Replacement for POPFile::Module::global_config_
# ----------------------------------------------------------------------------

sub global_config_ {
    my $self = shift;
    return &{$self->{global_config__}}( @_ );
}


# ----------------------------------------------------------------------------
#
# connect - Connect to the IMAP server.
#
# IN:  -
# OUT: true on success
#      undef on error
# ----------------------------------------------------------------------------

sub connect {
    my $self = shift;

    my $hostname = $self->{host};
    my $port     = $self->{port};
    my $use_ssl  = $self->{ssl};
    my $timeout  = $self->{timeout};

    $self->log_( 1, "Connecting to $hostname:$port" );

    if ( $hostname ne '' && $port ne '' ) {
        my $response = '';
        my $imap;

        if ( $use_ssl ) {
            require IO::Socket::SSL;
            $imap = IO::Socket::SSL->new (
                                Proto    => "tcp",
                                PeerAddr => $hostname,
                                PeerPort => $port,
                                Timeout  => $timeout,
                    );
        }
        else {
            $imap = IO::Socket::INET->new(
                                Proto    => "tcp",
                                PeerAddr => $hostname,
                                PeerPort => $port,
                                Timeout  => $timeout,
                    );
        }


        # Check that the connect succeeded for the remote server
        if ( $imap ) {
            if ( $imap->connected )  {
                # Set binmode on the socket so that no translation of CRLF
                # occurs
                binmode( $imap ) if $use_ssl == 0;

                # Wait for a response from the remote server and if
                # there isn't one then give up trying to connect
                my $selector = IO::Select->new( $imap );
                unless ( () = $selector->can_read( $timeout ) ) {
                    $self->log_( 0, "Connection timed out for $hostname:$port" );
                    return;
                }

                $self->log_( 0, "Connected to $hostname:$port timeout $timeout" );

                # Read the response from the real server
                my $buf = $self->slurp_( $imap );
                $self->log_( 1, ">> $buf" );
                $self->{socket} = $imap;
                return 1;
            }
        }
    }
    else {
        $self->log_( 0, "Invalid port or hostname. Will not connect to server." );
        return;
    }
}


# ----------------------------------------------------------------------------
#
# login - Login on the IMAP server.
#
# IN:  -
# OUT: true on success
#      undef on error
# ----------------------------------------------------------------------------

sub login {
    my $self = shift;

    my $login = $self->{login};
    my $pass  = $self->{pass};

    $self->log_( 1, "Logging in" );

    $self->say( 'LOGIN "' . $login . '" "' . $pass . '"' );

    if ( $self->get_response() == 1 ) {
        return 1;
    }
    else {
        return;
    }
}

# ----------------------------------------------------------------------------
#
# noop - Do a NOOP on the server. Whatever that might be good for.
#
# IN:  -
# OUT: see get_response()
# ----------------------------------------------------------------------------

sub noop {
    my $self = shift;

    $self->say( 'NOOP' );
    my $result = $self->get_response();
    $self->log_( 0, "NOOP failed (return value $result)" ) unless $result == 1;

    return $result;
}

# ----------------------------------------------------------------------------
#
# status - Do a STATUS on the server, asking for UIDNEXT and UIDVALIDITY
#          information.
#
# IN:  $folder - name of the mailbox to be STATUSed
# OUT: hasref with the keys UIDNEXT and UIDVALIDITY
# ----------------------------------------------------------------------------

sub status {
    my $self   = shift;
    my $folder = shift;
    my $ret    = { UIDNEXT => undef, UIDVALIDITY => undef };

    $self->say( "STATUS \"$folder\" (UIDNEXT UIDVALIDITY)" );
    if ( $self->get_response() == 1 ) {
        my @lines = split /$eol/, $self->{last_response};

        foreach ( @lines ) {
            if ( /^\* STATUS/ ) {
                if ( /UIDNEXT (\d+)/ ) {
                    $ret->{UIDNEXT} = $1;
                }
                if ( /UIDVALIDITY (\d+)/ ) {
                    $ret->{UIDVALIDITY} = $1;
                }
            }
            last;
        }
    }
    else {
        # TODO: what now?
    }

    foreach ( keys %$ret ) {
        if ( ! defined $ret->{$_}) {
            $self->log_( 0, "Could not get $_ STATUS for folder $folder." );
        }
    }
    return $ret;
}

# ----------------------------------------------------------------------------
#
# DESTROY - Destructor called by Perl
#
#  Will close the socket if it's connected.
#  TODO: This method could be friendly and try to logout first. OTOH, we
#        might no longer be logged in.
#
# ----------------------------------------------------------------------------

sub DESTROY {
    my $self = shift;
    $self->log_( 1, "IMAP-Client is exiting" );
    $self->{socket}->shutdown( 2 ) if defined $self->{socket};
}


# ----------------------------------------------------------------------------
#
# expunge - Issue an EXPUNGE command. We need to be in a SELECTED state for
#           this to work.
#
# IN:  -
# OUT: see get_response()
# ----------------------------------------------------------------------------

sub expunge {
    my $self = shift;
    $self->say( 'EXPUNGE' );
    $self->get_response();
}


# ----------------------------------------------------------------------------
#
# say - Say something to the server. This method will also provide a valid
#       tag and a nice line ending.
#
# IN:  $command - String containing the command
# OUT: true und success, undef on error
# ----------------------------------------------------------------------------

sub say {
    my $self    = shift;
    my $command = shift;

    $self->{last_command} = $command;
    my $tag = $self->{tag};

    my $cmdstr = sprintf "A%05d %s%s", $tag, $command, $eol;

    # Talk to the server
    unless( print {$self->{socket}} $cmdstr ) {
        $self->bail_out( "Lost connection while I tried to say '$cmdstr'." );
    }

    # Log command
    # Obfuscate login and password for logins:
    $cmdstr =~ s/^(A\d+) LOGIN ".+?" ".+"(.+)/$1 LOGIN "xxxxx" "xxxxx"$2/;
    $self->log_( 1, "<< $cmdstr" );

    return 1;
}


# ----------------------------------------------------------------------------
#
# get_response
#
#   Get a response from our server. You should normally not need to call this function
#   directly. Use get_response__ instead.
#
# Arguments:
#
#   $imap:         A valid socket object
#   $last_command: The command we are issued before.
#   $tag_ref:      A reference to a scalar that will receive tag value that can be
#                  used to tag the next command
#   $response_ref: A reference to a scalar that will receive the servers response.
#
# Return value:
#   undef   lost connection
#   1       Server answered OK
#   0       Server answered NO
#   -1      Server answered BAD
#   -2      Server gave unexpected tagged answer
#   -3      Server didn't say anything, but the connection is still valid (I guess this cannot happen)
#
# ----------------------------------------------------------------------------

sub get_response {
    my $self = shift;
    my $imap = $self->{socket};

    local $SIG{ALRM}
        = sub {
                  alarm 0;
                  $self->bail_out( "The connection to the IMAP server timed out while we waited for a response." );
              };
    alarm $self->global_config_( 'timeout' );

    # What is the actual tag we have to look for?
    my $actual_tag = sprintf "A%05d", $self->{tag};

    my $response = '';
    my $count_octets = 0;
    my $octet_count = 0;

    # Slurp until we find a reason to quit
    while ( my $buf = $self->slurp_( $imap ) ) {

        # Check for lost connections:
        if ( $response eq '' && ! defined $buf ) {
            $self->bail_out( "The connection to the IMAP server was lost while trying to get a response to command '$self->{last_command}'." );
        }

        # If this is the first line of the response and
        # if we find an octet count in curlies before the
        # newline, then we will rely on the octet count

        if ( $response eq '' && $buf =~ m/{(\d+)}$eol/ ) {

            # Add the length of the first line to the
            # octet count provided by the server

            $count_octets = $1 + length( $buf );
        }

        $response .= $buf;

        if ( $count_octets ) {
            $octet_count += length $buf;

            # There doesn't seem to be a requirement for the message to end with
            # a newline. So we cannot go for equality

            if ( $octet_count >= $count_octets ) {
                $count_octets = 0;
            }
            $self->log_( 2, ">> $buf" );
        }

        # If we aren't counting octets (anymore), we look out for tag
        # followed by BAD, NO, or OK and we also keep an eye open
        # for untagged responses that the server might send us unsolicited
        if ( $count_octets == 0 ) {
            if ( $buf =~ /^$actual_tag (OK|BAD|NO)/ ) {

                if ( $1 ne 'OK' ) {
                    $self->log_( 0, ">> $buf" );
                }
                else {
                    $self->log_( 1, ">> $buf" );
                }

                last;
            }

            # Here we look for untagged responses and decide whether they are
            # solicited or not based on the last command we gave the server.

            if ( $buf =~ /^\* (.+)/ ) {
                my $untagged_response = $1;

                $self->log_( 1, ">> $buf" );

                # This should never happen, but under very rare circumstances,
                # we might get a change of the UIDVALIDITY value while we
                # are connected
                if ( $untagged_response =~ /UIDVALIDITY/
                        && ( $self->{last_command} !~ /^SELECT/ && $self->{last_command} !~ /^STATUS/ ) ) {
                    $self->log_( 0, "Got unsolicited UIDVALIDITY response from server while reading response for $self->{last_command}." );
                }

                # This could happen, but will be caught by the eval in service().
                # Nevertheless, we look out for unsolicited bye-byes here.
                if ( $untagged_response =~ /^BYE/
                        && $self->{last_command} !~ /^LOGOUT/ ) {
                    $self->log_( 0, "Got unsolicited BYE response from server while reading response for $self->{last_command}." );
                }
            }
        }
    }

    # save result away so we can always have a look later on
    $self->{last_response} = $response;

    alarm 0;

    # Increment tag for the next command/reply sequence:
    $self->{tag}++;

    if ( $response ) {

        # determine our return value

        # We got 'OK' and the correct tag.
        if ( $response =~ /^$actual_tag OK/m ) {
            return 1;
        }
        # 'NO' plus correct tag
        elsif ( $response =~ /^$actual_tag NO/m ) {
            return 0;
        }
        # 'BAD' and correct tag.
        elsif ( $response =~ /^$actual_tag BAD/m ) {
            return -1;
        }
        # Someting else, probably a different tag, but who knows?
        else {
            $self->log_( 0, "!!! Server said something unexpected !!!" );
            return -2;
        }
    }
    else {
        $self->bail_out( "The connection to the IMAP server was lost while trying to get a response to command '$self->{last_command}'" );
    }
}


# ----------------------------------------------------------------------------
#
# select
#
#   Do a SELECT on the passed-in folder. Returns the result of get_response()
#
# Arguments:
#   $folder: The name of a mailbox on the server
#
# Return value:
#
#   INT 1 is ok, everything else is an error
# ----------------------------------------------------------------------------

sub select {
    my $self = shift;
    my $folder = shift;

    $self->say( "SELECT \"$folder\"" );
    my $result = $self->get_response();

    if  ( $result == 1 ) {
        $self->{folder} = $folder;
    }

    return $result
}


# ----------------------------------------------------------------------------
#
# get_mailbox_list
#
#   Request a list of mailboxes from the server behind the passed in socket object.
#   The list is sorted and returned
#
# Arguments: none
#
# Return value: list of mailboxes, possibly emtpy (or error)
# ----------------------------------------------------------------------------

sub get_mailbox_list {
    my $self = shift;

    $self->log_( 1, "Getting mailbox list" );

    $self->say( 'LIST "" "*"' );
    my $result = $self->get_response();

    if ( $result != 1 ) {
        $self->log_( 0, "LIST command failed (return value [$result])." );
        return;
    }

    my @lines = split /$eol/, $self->{last_response};
    my @mailboxes;

    foreach ( @lines ) {
        next unless /^\*/;
        s/^\* LIST \(.*\) .+? (.+)$/$1/;
        s/"(.*?)"/$1/;
        push @mailboxes, $1;
    }

    return sort @mailboxes;
}


# ----------------------------------------------------------------------------
#
# logout
#
#   log out of the the server we are currently connected to.
#
# Arguments: none
#
# Return values:
#   0 on failure
#   1 on success
# ----------------------------------------------------------------------------

sub logout {
    my $self = shift;

    $self->log_( 1, "Logging out" );

    $self->say( 'LOGOUT' );

    if ( $self->get_response() == 1 ) {
        $self->{socket}->shutdown( 2 );
        $self->{folder} = undef;
        $self->{socket} = undef;
        return 1;
    }
    else {
        return 0;
    }
}


# ----------------------------------------------------------------------------
#
# move_message
#
#   Will try to move a message on the IMAP server.
#
# arguments:
#
#   $msg:
#       The UID of the message
#   $destination:
#       The destination folder.
#
# ----------------------------------------------------------------------------

sub move_message {
    my $self = shift;
    my $msg  = shift;
    my $destination = shift;

    $self->log_( 1, "Moving message $msg to $destination" );

    # Copy message to destination
    $self->say( "UID COPY $msg \"$destination\"" );
    my $ok = $self->get_response();

    # If that went well, flag it as deleted
    if ( $ok == 1 ) {
        $self->say( "UID STORE $msg +FLAGS (\\Deleted)" );
        $ok = $self->get_response();
    }
    else {
        $self->log_( 0, "Could not copy message ($ok)!" );
    }

    return ( $ok ? 1 : 0 );
}


# ----------------------------------------------------------------------------
#
# get_new_message_list
#
#   Will search for messages on the IMAP server that are not flagged as deleted
#   that have a UID greater than or equal to the value stored as UIDNEXTfor
#   the currently SELECTed folder.
#
# arguments: none
#
# return value:
#
#   A sorted list (possibly empty) of the UIDs of matching messages.
#
# ----------------------------------------------------------------------------

sub get_new_message_list {
    my $self   = shift;

    my $folder = $self->{folder};
    my $uid    = $self->uid_next( $folder );

    $self->log_( 1, "Getting uids ge $uid in folder $folder" );

    $self->say( "UID SEARCH UID $uid:* UNDELETED" );
    my $result = $self->get_response();

    if ( $result != 1 ) {
        $self->log_( 0, "SEARCH command failed (return value: $result)!" );
    }

    # The server will respond with an untagged search reply.
    # This can either be empty ("* SEARCH") or if a
    # message was found it contains the numbers of the matching
    # messages, e.g. "* SEARCH 2 5 9".
    # In the latter case, the regexp below will match and
    # capture the list of messages in $1

    my @matching = ();

    if ( $self->{last_response} =~ /\* SEARCH (.+)$eol/ ) {
        @matching = split / /, $1;
    }

    my @return_list = ();

    # Make sure that the UIDs reported by the server are really greater
    # than or equal to our passed in comparison value

    foreach my $num ( @matching ) {
        if ( $num >= $uid ) {
            push @return_list, $num;
        }
    }

    return ( sort { $a <=> $b } @return_list );
}


# ----------------------------------------------------------------------------
#
# get_new_message_list_unselected
#
# If we are not in the selected state, you can use this routine to get a list
# of new messages on the server in a specific mailbox.
# The routine will do a STATUS (UIDNEXT) and compare our old
# UIDNEXT value to the new one.
# If it turns out that the new value is larger than the old, the mailbox
# is selected and the list of new UIDs gets retrieved. In that case,
# we will remain in a selected state.
#
# arguments: $folder - the folder that should be examined
# returns:   see get_new_message_list
# ----------------------------------------------------------------------------

sub get_new_message_list_unselected {
    my $self   = shift;
    my $folder = shift;

    my $last_known = $self->uid_next( $folder );

    my $info = $self->status( $folder );

    if ( ! defined $info ) {
        $self->bail_out( "Could not get a valid response to the STATUS command." );
    }
    else {
        my $new_next = $info->{UIDNEXT};
        my $new_vali = $info->{UIDVALIDITY};

        if ( $new_vali != $self->uid_validity( $folder ) ) {
            $self->log_( 0, "The folder $folder has a new UIDVALIDTIY value! Skipping new messages (if any)." );
            $self->uid_validity( $folder, $new_vali );
            return;
        }

        if ( $last_known < $new_next ) {
            $self->select( $folder );
            return $self->get_new_message_list();
        }
    }

    return;
}


# ----------------------------------------------------------------------------
#
# fetch_message_part
#
#   This function will fetch a specified part of a specified message from
#   the IMAP server and return the message as a list of lines.
#   It assumes that a folder is already SELECTed
#
# arguments:
#
#   $msg:       UID of the message
#   $part:      The part of the message you want to fetch. Could be 'HEADER' for the
#               message headers, 'TEXT' for the body (including any attachments), or '' to
#               fetch the complete message. Other values are also possible, but currently
#               not used. 'BODYSTRUCTURE' could be interesting.
#
# return values:
#
#       a boolean value indicating success/fallure and
#       a list containing the lines of the retrieved message (part).
#
# ----------------------------------------------------------------------------

sub fetch_message_part {
    my $self = shift;
    my $msg  = shift;
    my $part = shift;

    my $folder = $self->{folder};

    if ( $part ne '' ) {
        $self->log_( 1, "Fetching $part of message $msg" );
    }
    else {
        $self->log_( 1, "Fetching message $msg" );
    }

    if ( $part eq 'TEXT' || $part eq '' ) {
        my $limit = $self->{cutoff} || 0;
        $self->say( "UID FETCH $msg (FLAGS BODY.PEEK[$part]<0.$limit>)" );
    }
    else {
        $self->say( "UID FETCH $msg (FLAGS BODY.PEEK[$part])" );
    }

    my $result = $self->get_response();

    if ( $part ne '' ) {
        $self->log_( 1, "Got $part of message # $msg, result: $result." );
    }
    else {
        $self->log_( 1, "Got message # $msg, result: $result." );
    }

    if ( $result == 1 ) {
        my @lines = ();

        # The first line now MUST start with "* x FETCH" where x is a message
        # sequence number anything else indicates that something went wrong
        # or that something changed. E.g. the message we wanted
        # to fetch is no longer there.

        my $last_response = $self->{last_response};

        if ( $last_response =~ m/\^* \d+ FETCH/ ) {

            # The first line should contain the number of octets the server send us

            if ( $last_response =~ m/(?!$eol){(\d+)}$eol/ ) {
                my $num_octets = $1;

                # Grab the number of octets reported:

                my $pos = index $last_response, "{$num_octets}$eol";
                $pos += length "{$num_octets}$eol";

                my $message = substr $last_response, $pos, $num_octets;

                # Take the large chunk and chop it into single lines

                # We cannot use split here, because this would get rid of
                # trailing and leading newlines and thus omit complete lines.

                while ( $message =~ m/(.*?(?:$eol|\012|\015))/g ) {
                    push @lines, $1;
                }
            }
            # No number of octets: fall back, but issue a warning
            else {
                while ( $last_response =~ m/(.*?(?:$eol|\012|\015))/g ) {
                    push @lines, $1;
                }

                # discard the first and the two last lines; these are server status responses.
                shift @lines;
                pop @lines;
                pop @lines;

                $self->log_( 0, "Could not find octet count in server's response!" );
            }
        }
        else {
            $self->log_( 0, "Unexpected server response to the FETCH command!" );
        }

        return 1, @lines;
    }
    else {
        return 0;
    }
}



#---------------------------------------------------------------------------------------------
#
#   uid_validity
#
#   Get the stored UIDVALIDITY value for the passed-in folder
#   or pass in new UIDVALIDITY value to store the value
#
# arguments: $folder [, $new_uidvalidity_value]
# returns: the stored UIDVALIDITY value or undef if no value was stored previously
#---------------------------------------------------------------------------------------------

sub uid_validity {
    my $self   = shift;
    my $folder = shift or confess "gimme a folder!";
    my $uidval = shift;

    my $all = $self->config_( 'uidvalidities' );

    my %hash;

    if ( defined $all ) {
        %hash = split /$cfg_separator/, $all;
    }

    # set
    if ( defined $uidval ) {
        $hash{$folder} = $uidval;
        $all = '';
        while ( my ( $key, $value ) = each %hash ) {
            $all .= "$key$cfg_separator$value$cfg_separator";
        }
        $self->config_( 'uidvalidities', $all );
        $self->log_( 1, "Updated UIDVALIDITY value for folder $folder to $uidval." );
    }
    # get
    else {
        if ( exists $hash{$folder} ) {
            return $hash{$folder};
        }
        else {
            return undef;
        }
    }
}


#---------------------------------------------------------------------------------------------
#
#   uid_next
#
#   Get the stored UIDNEXT value for the passed-in folder
#   or pass in a new UIDNEXT value to store the value
#
#  arguments: $folder [, $new_uidnext_value]
#  returns:   the stored UIDVALIDITY value or undef if no value was stored previously
#---------------------------------------------------------------------------------------------

sub uid_next {
    my $self    = shift;
    my $folder  = shift or confess "I need a folder";
    my $uidnext = shift;

    my $all = $self->config_( 'uidnexts' );
    my %hash = ();

    if ( defined $all ) {
        %hash = split /$cfg_separator/, $all;
    }

    # set
    if ( defined $uidnext ) {
        $hash{$folder} = $uidnext;
        $all = '';
        while ( my ( $key, $value ) = each %hash ) {
            $all .= "$key$cfg_separator$value$cfg_separator";
        }
        $self->config_( 'uidnexts', $all );
        $self->log_( 1, "Updated UIDNEXT value for folder $folder to $uidnext." );
    }
    # get
    else {
        if ( exists $hash{$folder} ) {
            return $hash{$folder};
        }
        return;
    }
}


# ----------------------------------------------------------------------------
#
# check_uidvalidity - Compare the stored UIDVALIDITY value to the passed-in
#                     value
#
# IN:  $folder, $uidvalidity_value
# OUT: true if the values are equal, undef otherwise
# ----------------------------------------------------------------------------
sub check_uidvalidity {
    my $self    = shift;
    my $folder  = shift or confess "gimme a folder";
    my $new_val = shift or confess "gimme a new_val";

    # Save old UIDVALIDITY value (if we have one)
    my $old_val = $self->uid_validity( $folder );

    # Check whether the old value is still valid
    if ( $new_val != $old_val ) {
        return;
    }
    else {
        return 1;
    }
}


sub connected {
    my $self = shift;
    return $self->{socket} ? 1 : undef;
}


sub bail_out {
    my $self = shift;
    my $msg  = shift;

    $self->{socket}->shutdown( 2 ) if defined $self->{socket};
    $self->{socket} = undef;
    my ( $package, $filename, $line, $subroutine ) = caller();
    $self->log_( 0, $msg );
    die "POPFILE-IMAP-EXCEPTION: $msg ($filename ($line))";
}


1;

[popfile-commit] engine/Services/IMAP Client.pm,1.1.2.2,1.1.2.3

[Manni H. <man...@us...>]

Update of /cvsroot/popfile/engine/Services/IMAP
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11775/Services/IMAP

Modified Files:
      Tag: b0_22_2
	Client.pm 
Log Message:
Fix typo that in a part of the code that is not yet covered by our tests.

Index: Client.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Services/IMAP/Attic/Client.pm,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -C2 -d -r1.1.2.2 -r1.1.2.3
*** Client.pm	20 Nov 2007 14:25:14 -0000	1.1.2.2
--- Client.pm	26 Nov 2007 11:12:39 -0000	1.1.2.3
***************
*** 379,383 ****
          # Check for lost connections:
          if ( $response eq '' && ! defined $buf ) {
!             $self->baild_out( "The connection to the IMAP server was lost while trying to get a response to command '$self->{last_command}'." );
          }
  
--- 379,383 ----
          # Check for lost connections:
          if ( $response eq '' && ! defined $buf ) {
!             $self->bail_out( "The connection to the IMAP server was lost while trying to get a response to command '$self->{last_command}'." );
          }
  

[popfile-commit] engine/tests TestIMAP.tst,1.3.4.9,1.3.4.10

[Manni H. <man...@us...>]

Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9951/tests

Modified Files:
      Tag: b0_22_2
	TestIMAP.tst 
Log Message:
Add yet more tests and make the module disconnect when the connection options are changed so that the changes will take immediate effect.


Index: TestIMAP.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestIMAP.tst,v
retrieving revision 1.3.4.9
retrieving revision 1.3.4.10
diff -C2 -d -r1.3.4.9 -r1.3.4.10
*** TestIMAP.tst	24 Nov 2007 16:15:22 -0000	1.3.4.9
--- TestIMAP.tst	26 Nov 2007 11:07:37 -0000	1.3.4.10
***************
*** 112,116 ****
      # the difference between the (manipulated) stored value and
      # the value from the server.
!     my $client = $im->{folders__}{'spam'}{imap};
      $client->uid_validity( 'spam', 50 );
      $im->{last_update__} = 0;
--- 112,116 ----
      # the difference between the (manipulated) stored value and
      # the value from the server.
!     my $client = $im->{folders__}{spam}{imap};
      $client->uid_validity( 'spam', 50 );
      $im->{last_update__} = 0;
***************
*** 146,149 ****
--- 146,151 ----
      # If the hash is unknown, it should reclassify either
      test_assert( ! $im->can_reclassify__( 'hash', 'other' ) );
+     # But with a good hash and a valid bucket:
+     test_assert( $im->can_reclassify__( $hash, 'other' ) );
  
      # move msgs 1, 2, and 3 to folder personal
***************
*** 234,237 ****
--- 236,240 ----
      $im->disconnect_folders__();
  
+ 
      # Check what happens when we time out
      $im->log_( 0, "---- Testing time-out behaviour for the module." );
***************
*** 431,435 ****
      # Now let the IMAP module populate the template
      $im->config_( hostname => 'some host' );
!     $im->config_( port => 'some port' );
      $im->config_( password => 'some password' );
      $im->config_( login => 'some login' );
--- 434,438 ----
      # Now let the IMAP module populate the template
      $im->config_( hostname => 'some host' );
!     $im->config_( port => 1234 );
      $im->config_( password => 'some password' );
      $im->config_( login => 'some login' );
***************
*** 438,442 ****
  
      test_assert_equal( $tmpl->param( 'IMAP_hostname'), 'some host' );
!     test_assert_equal( $tmpl->param( 'IMAP_port' ), 'some port' );
      test_assert_equal( $tmpl->param( 'IMAP_password' ), 'some password' );
      test_assert_equal( $tmpl->param( 'IMAP_login' ), 'some login' );
--- 441,445 ----
  
      test_assert_equal( $tmpl->param( 'IMAP_hostname'), 'some host' );
!     test_assert_equal( $tmpl->param( 'IMAP_port' ), 1234 );
      test_assert_equal( $tmpl->param( 'IMAP_password' ), 'some password' );
      test_assert_equal( $tmpl->param( 'IMAP_login' ), 'some login' );
***************
*** 615,619 ****
      test_assert_equal( $im->config_( 'port' ), 123 );
      test_assert_equal( $im->config_( 'hostname' ), 'hostname' );
!     # TODO: test with values that will NOT validate
  
      # imap-watch-folders.thtml
--- 618,644 ----
      test_assert_equal( $im->config_( 'port' ), 123 );
      test_assert_equal( $im->config_( 'hostname' ), 'hostname' );
! 
!     $form->{imap_use_ssl} = undef;
!     $im->validate_item( 'imap_0_connection_details', $tmpl, $language, $form );
!     test_assert_equal( $im->config_( 'use_ssl' ), 0 );
! 
!     # After updating the connection details, the module must disconnect
!     # and empty its folders hash:
!     test_assert_equal( scalar keys %{$im->{folders__}}, 0 );
! 
!     # Now test some values that should NOT validate:
! 
!     # all the parameters need to be set to something (except for use_ssl)
!     foreach ( qw/ imap_hostname imap_port imap_login imap_password / ) {
!         my %invalid_form = %$form;
!         delete $invalid_form{$_};
!         $tmpl = HTML::Template->new( filename => '../skins/default/imap-connection-details.thtml' );
!         $im->validate_item( 'imap_0_connection_details', $tmpl, $language, \%invalid_form );
!         my $template_param = $_;
!         $template_param =~ s/imap_//;
!         $template_param = 'IMAP_connection_if_' . $template_param . '_error';
!         test_assert_equal( $tmpl->param( $template_param ), 1, $_ );
!     }
! 
  
      # imap-watch-folders.thtml
***************
*** 643,649 ****
      $form = {};
      $form->{imap_3_bucket_folders} = 1;
      $tmpl = HTML::Template->new( filename => '../skins/default/imap-bucket-folders.thtml' );
      $im->validate_item('imap_3_bucket_folders', $tmpl, $language, $form );
! 
  
      # imap-update-mailbox-list.thtml
--- 668,679 ----
      $form = {};
      $form->{imap_3_bucket_folders} = 1;
+     $form->{imap_folder_for_other} = 'personal';
+     $form->{imap_folder_for_personal} = 'other';
+ 
      $tmpl = HTML::Template->new( filename => '../skins/default/imap-bucket-folders.thtml' );
      $im->validate_item('imap_3_bucket_folders', $tmpl, $language, $form );
!     test_assert_equal( $im->{folder_change_flag__}, 1 );
!     test_assert_equal( $im->folder_for_bucket__( 'other' ), 'personal' );
!     test_assert_equal( $im->folder_for_bucket__( 'personal' ), 'other' );
  
      # imap-update-mailbox-list.thtml
***************
*** 651,655 ****
--- 681,707 ----
      $form->{do_imap_4_update_mailbox_list} = 1;
      $tmpl = HTML::Template->new( filename => '../skins/default/imap-update-mailbox-list.thtml' );
+     $im->config_( 'hostname', '127.0.0.1' );
+     $im->config_( 'password', 'password' );
+     $im->config_( 'username', 'someone' );
+     $im->config_( 'port', '1143' );
+     $im->config_( 'update_interval', 10 );
+     $im->config_( 'use_ssl', 0 );
+     $im->validate_item( 'imap_4_update_mailbox_list', $tmpl, $language, $form );
+     test_assert_equal( scalar @{$im->{mailboxes__}}, 5 );
+     test_assert( ! $tmpl->param( 'IMAP_update_list_failed' ) );
+ 
+     $im->config_( 'hostname', '' );
+     $im->validate_item( 'imap_4_update_mailbox_list', $tmpl, $language, $form );
+     test_assert( $tmpl->param( 'IMAP_update_list_failed' ) );
+ 
+     $im->config_( 'hostname', '127.0.0.1' );
+     $im->config_( 'port', '12345' );
      $im->validate_item( 'imap_4_update_mailbox_list', $tmpl, $language, $form );
+     test_assert( $tmpl->param( 'IMAP_update_list_failed' ) );
+ 
+     $im->config_( 'port', 1143 );
+     $im->config_( 'username', 'fail' );
+     $im->validate_item( 'imap_4_update_mailbox_list', $tmpl, $language, $form );
+     test_assert( $tmpl->param( 'IMAP_update_list_failed' ) );
  
  
***************
*** 690,694 ****
      $im->config_( 'expunge', 1 );
      $im->config_( 'hostname', '127.0.0.1' );
- 
      $im->config_( 'password', 'password' );
      $im->config_( 'port', '1143' );
--- 742,745 ----
***************
*** 714,718 ****
  
  sub start_popfile {
- 
      rmtree( 'messages' );
      rmtree( 'corpus' );
--- 765,768 ----

[popfile-commit] engine/Services IMAP.pm,1.9.4.13,1.9.4.14

[Manni H. <man...@us...>]

Update of /cvsroot/popfile/engine/Services
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9951/Services

Modified Files:
      Tag: b0_22_2
	IMAP.pm 
Log Message:
Add yet more tests and make the module disconnect when the connection options are changed so that the changes will take immediate effect.


Index: IMAP.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Services/IMAP.pm,v
retrieving revision 1.9.4.13
retrieving revision 1.9.4.14
diff -C2 -d -r1.9.4.13 -r1.9.4.14
*** IMAP.pm	25 Nov 2007 12:07:52 -0000	1.9.4.13
--- IMAP.pm	26 Nov 2007 11:07:37 -0000	1.9.4.14
***************
*** 1499,1505 ****
  
      if ( defined $form->{update_imap_0_connection_details} ) {
!         if ( $form->{imap_hostname} ne '' ) {
              $templ->param( IMAP_connection_if_hostname_error => 0 );
!             $self->config_( 'hostname', $form->{imap_hostname} );
          }
          else {
--- 1499,1510 ----
  
      if ( defined $form->{update_imap_0_connection_details} ) {
!         my $something_changed = undef;
! 
!         if ( $form->{imap_hostname} ) {
              $templ->param( IMAP_connection_if_hostname_error => 0 );
!             if ( $self->config_( 'hostname' ) ne $form->{imap_hostname} ) {
!                 $self->config_( 'hostname', $form->{imap_hostname} );
!                 $something_changed = 1;
!             }
          }
          else {
***************
*** 1507,1512 ****
          }
  
!         if ( $form->{imap_port} >= 1 && $form->{imap_port} < 65536 ) {
!             $self->config_( 'port', $form->{imap_port} );
              $templ->param( IMAP_connection_if_port_error => 0 );
          }
--- 1512,1520 ----
          }
  
!         if ( $form->{imap_port} && $form->{imap_port} =~ m/^\d+$/ && $form->{imap_port} >= 1 && $form->{imap_port} < 65536 ) {
!             if ( $self->config_( 'port' ) != $form->{imap_port} ) {
!                 $self->config_( 'port', $form->{imap_port} );
!                 $something_changed = 1;
!             }
              $templ->param( IMAP_connection_if_port_error => 0 );
          }
***************
*** 1515,1520 ****
          }
  
!         if ( $form->{imap_login} ne '' ) {
!             $self->config_( 'login', $form->{imap_login} );
              $templ->param( IMAP_connection_if_login_error => 0 );
          }
--- 1523,1531 ----
          }
  
!         if ( $form->{imap_login} ) {
!             if ( $self->config_( 'login' ) ne $form->{imap_login} ) {
!                 $self->config_( 'login', $form->{imap_login} );
!                 $something_changed = 1;
!             }
              $templ->param( IMAP_connection_if_login_error => 0 );
          }
***************
*** 1523,1528 ****
          }
  
!         if ( $form->{imap_password} ne '' ) {
!             $self->config_( 'password', $form->{imap_password} );
              $templ->param( IMAP_connection_if_password_error => 0 );
          }
--- 1534,1542 ----
          }
  
!         if ( $form->{imap_password} ) {
!             if ( $self->config_( 'password' ) ne $form->{imap_password} ) {
!                 $self->config_( 'password', $form->{imap_password} );
!                 $something_changed = 1;
!             }
              $templ->param( IMAP_connection_if_password_error => 0 );
          }
***************
*** 1531,1541 ****
--- 1545,1570 ----
          }
  
+         my $use_ssl_now = $self->config_( 'use_ssl' );
+ 
          if ( $form->{imap_use_ssl} ) {
              $self->config_( 'use_ssl', 1 );
+             if ( ! $use_ssl_now ) {
+                 $something_changed = 1;
+             }
          }
          else {
              $self->config_( 'use_ssl', 0 );
+             if ( $use_ssl_now ) {
+                 $something_changed = 1;
+             }
+         }
+ 
+         if ( $something_changed ) {
+             $self->log_( 1, 'Configuration has changed. Terminating any old connections.' );
+             $self->disconnect_folders__();
          }
      }
+ 
+ 
      return;
  }

[popfile-commit] engine/Services IMAP.pm,1.9.4.12,1.9.4.13

[Manni H. <man...@us...>]

Update of /cvsroot/popfile/engine/Services
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9122/Services

Modified Files:
      Tag: b0_22_2
	IMAP.pm 
Log Message:
Since Bayes is stopped before we are stopping, we shouldn't need to bother calling release_session_key anyway.

Index: IMAP.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Services/IMAP.pm,v
retrieving revision 1.9.4.12
retrieving revision 1.9.4.13
diff -C2 -d -r1.9.4.12 -r1.9.4.13
*** IMAP.pm	25 Nov 2007 12:01:09 -0000	1.9.4.12
--- IMAP.pm	25 Nov 2007 12:07:52 -0000	1.9.4.13
***************
*** 213,224 ****
  
      $self->disconnect_folders__();
- 
-     if ( $self->{api_session__} ne '' ) {
-         $self->classifier()->release_session_key( $self->{api_session__} );
-     }
  }
  
  
- 
  # ----------------------------------------------------------------------------
  #
--- 213,219 ----

[popfile-commit] engine/Services IMAP.pm,1.9.4.11,1.9.4.12

[Manni H. <man...@us...>]

Update of /cvsroot/popfile/engine/Services
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6516/Services

Modified Files:
      Tag: b0_22_2
	IMAP.pm 
Log Message:
Avoid calling Bayes::get_session_key in stop() and see if that fixes the "Bus error" sometimes seen on Mac OS X.


Index: IMAP.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Services/IMAP.pm,v
retrieving revision 1.9.4.11
retrieving revision 1.9.4.12
diff -C2 -d -r1.9.4.11 -r1.9.4.12
*** IMAP.pm	23 Nov 2007 15:49:55 -0000	1.9.4.11
--- IMAP.pm	25 Nov 2007 12:01:09 -0000	1.9.4.12
***************
*** 214,219 ****
      $self->disconnect_folders__();
  
!     if ( $self->api_session() ne '' ) {
!         $self->classifier()->release_session_key( $self->api_session() );
      }
  }
--- 214,219 ----
      $self->disconnect_folders__();
  
!     if ( $self->{api_session__} ne '' ) {
!         $self->classifier()->release_session_key( $self->{api_session__} );
      }
  }

[popfile-commit] engine/Classifier Bayes.pm,1.327.4.9,1.327.4.10

[naoki i. <am...@us...>]

Update of /cvsroot/popfile/engine/Classifier
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16672/Classifier

Modified Files:
      Tag: b0_22_2
	Bayes.pm 
Log Message:
Fix to pass TestBayesScript test.

Index: Bayes.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/Bayes.pm,v
retrieving revision 1.327.4.9
retrieving revision 1.327.4.10
diff -C2 -d -r1.327.4.9 -r1.327.4.10
*** Bayes.pm	6 Sep 2007 16:31:41 -0000	1.327.4.9
--- Bayes.pm	24 Nov 2007 16:37:48 -0000	1.327.4.10
***************
*** 341,345 ****
      # Pass in the current interface language for language specific parsing
  
!     $self->{parser__}->{lang__}  = $self->module_config_( 'html', 'language' );
      $self->{unclassified__} = log( $self->config_( 'unclassified_weight' ) );
  
--- 341,345 ----
      # Pass in the current interface language for language specific parsing
  
!     $self->{parser__}->{lang__}  = $self->module_config_( 'html', 'language' ) || '';
      $self->{unclassified__} = log( $self->config_( 'unclassified_weight' ) );
  

[popfile-commit] engine/tests TestIMAP.tst,1.3.4.8,1.3.4.9

[Manni H. <man...@us...>]

Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8873/tests

Modified Files:
      Tag: b0_22_2
	TestIMAP.tst 
Log Message:
Add more IMAP tests

Index: TestIMAP.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestIMAP.tst,v
retrieving revision 1.3.4.8
retrieving revision 1.3.4.9
diff -C2 -d -r1.3.4.8 -r1.3.4.9
*** TestIMAP.tst	23 Nov 2007 11:08:43 -0000	1.3.4.8
--- TestIMAP.tst	24 Nov 2007 16:15:22 -0000	1.3.4.9
***************
*** 25,34 ****
  # TODO:
  # IMAP.pm:
- # * changed uidvalidity while connecting
  # * fail while statusing
  # * duplicate hash value => duplicate message in inbox
  # * fail while fetching a part
  # * fail while fetching_header_fields
- # * validate_item
  #
  # Client.pm
--- 25,32 ----
***************
*** 142,146 ****
      test_assert( -e 'imap.spool/other/1' );
  
!     # move msgs 1, 2, and 3 to folder presonal
      $client = $im->{folders__}{'spam'}{imap};
      test_assert( $client );
--- 140,151 ----
      test_assert( -e 'imap.spool/other/1' );
  
!     # The module should not allow reclassification to the same
!     # bucket.
!     my $hash = ( $h->get_slot_fields( 1 ) )[6];
!     test_assert( ! $im->can_reclassify__( $hash, 'spam' ) );
!     # If the hash is unknown, it should reclassify either
!     test_assert( ! $im->can_reclassify__( 'hash', 'other' ) );
! 
!     # move msgs 1, 2, and 3 to folder personal
      $client = $im->{folders__}{'spam'}{imap};
      test_assert( $client );
***************
*** 181,185 ****
      # can be reclassified. It should say 'no!'
      foreach ( 1 .. 5 ) {
!         my $hash = ($h->get_slot_fields( $_ ))[6];
          test_assert_equal( $im->can_reclassify__( $hash, 'spam' ), undef );
          test_assert( ! $im->can_classify__( $hash ) );
--- 186,190 ----
      # can be reclassified. It should say 'no!'
      foreach ( 1 .. 5 ) {
!         $hash = ($h->get_slot_fields( $_ ))[6];
          test_assert_equal( $im->can_reclassify__( $hash, 'spam' ), undef );
          test_assert( ! $im->can_classify__( $hash ) );
***************
*** 208,211 ****
--- 213,237 ----
      $im->disconnect_folders__();
  
+     # Change the UIDVALIDITY values and then log in again
+     $im->log_( 0, '---- changing uidvalies' );
+     $im->config_('login', 'someone');
+     my $uidvalis = $im->config_('uidvalidities');
+     my $newvalis = $uidvalis;
+     $newvalis =~ s/-->(\d+)-->/'-->' . ( $1 +2 ) . '-->'/ge;
+     $im->config_( 'uidvalidities', $newvalis );
+     $im->{last_update__} = 0;
+     $im->service();
+     $im->disconnect_folders__();
+     test_assert_equal( $im->config_( 'uidvalidities' ), $uidvalis );
+     $im->config_( 'uidvalidities', $uidvalis );
+ 
+     # The module is supposed to retrieve the list of mailboxes if it
+     # hasn't got any yet.
+     $im->{mailboxes__} = [];
+     $im->{last_update__} = 0;
+     $im->service();
+     test_assert_equal( scalar @{$im->{mailboxes__}}, 5 );
+     $im->disconnect_folders__();
+ 
      # Check what happens when we time out
      $im->log_( 0, "---- Testing time-out behaviour for the module." );
***************
*** 589,592 ****
--- 615,619 ----
      test_assert_equal( $im->config_( 'port' ), 123 );
      test_assert_equal( $im->config_( 'hostname' ), 'hostname' );
+     # TODO: test with values that will NOT validate
  
      # imap-watch-folders.thtml

[popfile-commit] windows ioP.ini, 1.1.2.2, 1.1.2.3 ioUM.ini, 1.1.2.1, 1.1.2.2

[naoki i. <am...@us...>]

Update of /cvsroot/popfile/windows
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20469

Modified Files:
      Tag: b0_22_2
	ioP.ini ioUM.ini 
Log Message:
Update Japanese translation

Index: ioUM.ini
===================================================================
RCS file: /cvsroot/popfile/windows/Attic/ioUM.ini,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -C2 -d -r1.1.2.1 -r1.1.2.2
*** ioUM.ini	14 Oct 2007 17:25:23 -0000	1.1.2.1
--- ioUM.ini	24 Nov 2007 04:35:47 -0000	1.1.2.2
***************
*** 1,65 ****
! #-------------------------------------------------------------------
! #
! # ioUM.ini --- This file is used by "installer.nsi", one of the NSIS scripts
! #              used to create the Windows installer (and the uninstaller) for
! #              POPFile. This file defines the layout of the custom page used
! #              to select the uninstaller mode.
! #
! # Copyright (c) 2007 John Graham-Cumming
! #
! #   This file is part of POPFile
! #
! #   POPFile is free software; you can redistribute it and/or modify it
! #   under the terms of version 2 of the GNU General Public License as
! #   published by the Free Software Foundation.
! #
! #   POPFile is distributed in the hope that it will be useful,
! #   but WITHOUT ANY WARRANTY; without even the implied warranty of
! #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! #   GNU General Public License for more details.
! #
! #   You should have received a copy of the GNU General Public License
! #   along with POPFile; if not, write to the Free Software
! #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! #
! #-------------------------------------------------------------------
! 
! [Settings]
! NumFields=4
! 
! [Field 1]
! Type=radiobutton
! Text=Modify the existing POPFile installation
! Left=20
! Right=-1
! Top=30
! Bottom=40
! 
! [Field 2]
! Type=radiobutton
! Text=Uninstall the POPFile program
! Left=20
! Right=-1
! Top=75
! Bottom=85
! 
! [Field 3]
! Type=label
! Text=
! Left=35
! Right=-1
! Top=45
! Bottom=65
! 
! 
! [Field 4]
! Type=label
! Text=
! Left=35
! Right=-1
! Top=90
! Bottom=110
! 
! #--------------------
! # End of ioUM.ini
! #--------------------
--- 1,65 ----
! #-------------------------------------------------------------------
! #
! # ioUM.ini --- This file is used by "installer.nsi", one of the NSIS scripts
! #              used to create the Windows installer (and the uninstaller) for
! #              POPFile. This file defines the layout of the custom page used
! #              to select the uninstaller mode.
! #
! # Copyright (c) 2007 John Graham-Cumming
! #
! #   This file is part of POPFile
! #
! #   POPFile is free software; you can redistribute it and/or modify it
! #   under the terms of version 2 of the GNU General Public License as
! #   published by the Free Software Foundation.
! #
! #   POPFile is distributed in the hope that it will be useful,
! #   but WITHOUT ANY WARRANTY; without even the implied warranty of
! #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! #   GNU General Public License for more details.
! #
! #   You should have received a copy of the GNU General Public License
! #   along with POPFile; if not, write to the Free Software
! #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! #
! #-------------------------------------------------------------------
! 
! [Settings]
! NumFields=4
! 
! [Field 1]
! Type=radiobutton
! Text=Modify the existing POPFile installation
! Left=20
! Right=-1
! Top=30
! Bottom=40
! 
! [Field 2]
! Type=radiobutton
! Text=Uninstall the POPFile program
! Left=20
! Right=-1
! Top=75
! Bottom=85
! 
! [Field 3]
! Type=label
! Text=
! Left=35
! Right=-1
! Top=45
! Bottom=65
! 
! 
! [Field 4]
! Type=label
! Text=
! Left=35
! Right=-1
! Top=90
! Bottom=110
! 
! #--------------------
! # End of ioUM.ini
! #--------------------

Index: ioP.ini
===================================================================
RCS file: /cvsroot/popfile/windows/Attic/ioP.ini,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -C2 -d -r1.1.2.2 -r1.1.2.3
*** ioP.ini	23 Nov 2007 19:38:52 -0000	1.1.2.2
--- ioP.ini	24 Nov 2007 04:35:47 -0000	1.1.2.3
***************
*** 1,87 ****
! #-------------------------------------------------------------------
! #
! # ioP.ini --- This file is used by "installer.nsi", one of the NSIS scripts
! #             used to create the Windows installer for POPFile. This file
! #             defines the layout of the custom page used to select the
! #             parser to be used when processing Japanese (Nihongo) text.
! #
! # Copyright (c) 2007 John Graham-Cumming
! #
! #   This file is part of POPFile
! #
! #   POPFile is free software; you can redistribute it and/or modify it
! #   under the terms of version 2 of the GNU General Public License as
! #   published by the Free Software Foundation.
! #
! #   POPFile is distributed in the hope that it will be useful,
! #   but WITHOUT ANY WARRANTY; without even the implied warranty of
! #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! #   GNU General Public License for more details.
! #
! #   You should have received a copy of the GNU General Public License
! #   along with POPFile; if not, write to the Free Software
! #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! #
! #-------------------------------------------------------------------
! 
! [Settings]
! NumFields=6
! 
! [Field 1]
! Type=radiobutton
! Text=
! Left=0
! Right=-1
! Top=0
! Bottom=10
! State=1
! Flags=NOTIFY
! 
! [Field 2]
! Type=radiobutton
! Text=
! Left=0
! Right=-1
! Top=11
! Bottom=21
! State=0
! Flags=NOTIFY
! 
! [Field 3]
! Type=radiobutton
! Text=
! Left=0
! Right=-1
! Top=22
! Bottom=32
! State=0
! Flags=NOTIFY
! 
! [Field 4]
! Type=text
! State=
! Left=0
! Right=-1
! Top=34
! Bottom=79
! Flags=READONLY|MULTILINE
! 
! [Field 5]
! Type=label
! Text=
! Left=0
! Right=-1
! Top=81
! Bottom=129
! 
! [Field 6]
! Type=link
! Text=
! Left=0
! Right=-1
! Top=130
! Bottom=140
! 
! #--------------------
! # End of ioP.ini
! #--------------------
--- 1,87 ----
! #-------------------------------------------------------------------
! #
! # ioP.ini --- This file is used by "installer.nsi", one of the NSIS scripts
! #             used to create the Windows installer for POPFile. This file
! #             defines the layout of the custom page used to select the
! #             parser to be used when processing Japanese (Nihongo) text.
! #
! # Copyright (c) 2007 John Graham-Cumming
! #
! #   This file is part of POPFile
! #
! #   POPFile is free software; you can redistribute it and/or modify it
! #   under the terms of version 2 of the GNU General Public License as
! #   published by the Free Software Foundation.
! #
! #   POPFile is distributed in the hope that it will be useful,
! #   but WITHOUT ANY WARRANTY; without even the implied warranty of
! #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! #   GNU General Public License for more details.
! #
! #   You should have received a copy of the GNU General Public License
! #   along with POPFile; if not, write to the Free Software
! #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! #
! #-------------------------------------------------------------------
! 
! [Settings]
! NumFields=6
! 
! [Field 1]
! Type=radiobutton
! Text=
! Left=0
! Right=-1
! Top=0
! Bottom=10
! State=1
! Flags=NOTIFY
! 
! [Field 2]
! Type=radiobutton
! Text=
! Left=0
! Right=-1
! Top=11
! Bottom=21
! State=0
! Flags=NOTIFY
! 
! [Field 3]
! Type=radiobutton
! Text=
! Left=0
! Right=-1
! Top=22
! Bottom=32
! State=0
! Flags=NOTIFY
! 
! [Field 4]
! Type=text
! State=
! Left=0
! Right=-1
! Top=34
! Bottom=79
! Flags=READONLY|MULTILINE
! 
! [Field 5]
! Type=label
! Text=
! Left=0
! Right=-1
! Top=81
! Bottom=129
! 
! [Field 6]
! Type=link
! Text=
! Left=0
! Right=-1
! Top=130
! Bottom=140
! 
! #--------------------
! # End of ioP.ini
! #--------------------

[popfile-commit] windows/languages Japanese-parser.nsh, 1.1.2.5, 1.1.2.6

[naoki i. <am...@us...>]

Update of /cvsroot/popfile/windows/languages
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20469/languages

Modified Files:
      Tag: b0_22_2
	Japanese-parser.nsh 
Log Message:
Update Japanese translation

Index: Japanese-parser.nsh
===================================================================
RCS file: /cvsroot/popfile/windows/languages/Attic/Japanese-parser.nsh,v
retrieving revision 1.1.2.5
retrieving revision 1.1.2.6
diff -C2 -d -r1.1.2.5 -r1.1.2.6
*** Japanese-parser.nsh	24 Nov 2007 00:11:34 -0000	1.1.2.5
--- Japanese-parser.nsh	24 Nov 2007 04:35:47 -0000	1.1.2.6
***************
*** 83,91 ****
  ; Message shown above the progress bar while comparing the expected and actual MD5 sums for the files listed in 'mecab.md5'
  
! !define C_NPLS_VERIFYING_MECAB     "Verifying the files in the '$G_PLS_FIELD_1' folder..."
  
  ; Message shown above the progress bar with the result of the 'mecab.md5' MD5 checks
  
! !define C_NPLS_MECAB_MD5_RESULT    "MeCab validity check result: $G_PLS_FIELD_1"
  
  ; Message shown if internet connection does not appear to be working
--- 83,91 ----
  ; Message shown above the progress bar while comparing the expected and actual MD5 sums for the files listed in 'mecab.md5'
  
! !define C_NPLS_VERIFYING_MECAB     "'$G_PLS_FIELD_1' ƒtƒHƒ‹ƒ_‚̃tƒ@ƒCƒ‹‚ðŒŸØ‚µ‚Ä‚¢‚Ü‚·..."
  
  ; Message shown above the progress bar with the result of the 'mecab.md5' MD5 checks
  
! !define C_NPLS_MECAB_MD5_RESULT    "MeCab ‚ÌŒŸØŒ‹‰Ê: $G_PLS_FIELD_1"
  
  ; Message shown if internet connection does not appear to be working

[popfile-commit] windows getparser.nsh, 1.1.2.3, 1.1.2.4 getssl.nsh, 1.6.2.18, 1.6.2.19 installer-Uninstall.nsh, 1.4.2.16, 1.4.2.17 installer.nsi, 1.242.4.18, 1.242.4.19

[Brian S. <xue...@us...>]

Update of /cvsroot/popfile/windows
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25077

Modified Files:
      Tag: b0_22_2
	getparser.nsh getssl.nsh installer-Uninstall.nsh installer.nsi 
Log Message:
The MeCab zip file is over 12 MB so only download it if the installation
folder does not already contain the files from the zip file. If there is
an existing 'mecab' folder check the files in it by comparing MD5 sums
against the set of expected values downloaded from the POPFile web site.
If all of the MD5 sums match do not bother downloading any MeCab files.

Index: getparser.nsh
===================================================================
RCS file: /cvsroot/popfile/windows/Attic/getparser.nsh,v
retrieving revision 1.1.2.3
retrieving revision 1.1.2.4
diff -C2 -d -r1.1.2.3 -r1.1.2.4
*** getparser.nsh	13 Nov 2007 22:58:45 -0000	1.1.2.3
--- getparser.nsh	24 Nov 2007 00:11:34 -0000	1.1.2.4
***************
*** 98,106 ****
--- 98,118 ----
  #--------------------------------------------------------------------------
  
+   !ifndef C_MD5SUMS_FILE
+     !define C_MD5SUMS_FILE    "MD5SUMS"
+   !endif
+ 
+   !ifndef C_MECAB_MD5
+     !define C_MECAB_MD5       "mecab.md5"
+   !endif
+ 
    ; Temporarily use the "anonymous" URL of the project's new server:
  
+   !define C_NPD_MD5SUMS       "http://h1212143.stratoserver.net/installer/nihongo/mecab/${C_MD5SUMS_FILE}"
+   !define C_NPD_MECAB_MD5     "http://h1212143.stratoserver.net/installer/nihongo/mecab/${C_MECAB_MD5}"
    !define C_NPD_MECAB_PERL    "http://h1212143.stratoserver.net/installer/nihongo/mecab/MeCab.tar.gz"
    !define C_NPD_MECAB_DICT    "http://h1212143.stratoserver.net/installer/nihongo/mecab/mecab-ipadic.zip"
  
+ ;;  !define C_NPD_MD5SUMS       "http://getpopfile.org/installer/nihongo/mecab/${C_MD5SUMS_FILE}"
+ ;;  !define C_NPD_MECAB_MD5     "http://getpopfile.org/installer/nihongo/mecab/${C_MECAB_MD5}"
  ;;  !define C_NPD_MECAB_PERL    "http://getpopfile.org/installer/nihongo/mecab/MeCab.tar.gz"
  ;;  !define C_NPD_MECAB_DICT    "http://getpopfile.org/installer/nihongo/mecab/mecab-ipadic.zip"
***************
*** 349,352 ****
--- 361,369 ----
  # do the same thing.
  #
+ # The MeCab package is a large download (over 12 MB) which could take a long time,
+ # especially for users with a dial-up connection. If the selected installation
+ # folder already contains a valid copy of the MeCab package then there is no need
+ # to download the package again.
+ #
  # Although the COMPONENTS page will show a 'Nihongo Parser' component when the
  # installer language is set to 'Nihongo' (or when an English-only build of the
***************
*** 370,380 ****
      AddSize 43000
  
!     !define L_RESERVED  $0          ; used in system.dll call
  
!     !define L_RESULT          $R0   ; result from 'GetMeCabFile' function or the 'untgz' plugin
!                                     ; WARNING: The 'untgz' plugin is hard-coded to use $R0
  
!     !define L_DLG_ITEM        $R1   ; used to disable/enable the "Show Details" button
!     !define L_LISTSIZE        $R2   ; number of patches to be applied
  
      Push ${L_RESERVED}
--- 387,397 ----
      AddSize 43000
  
!     !define L_RESERVED    $0          ; used in system.dll call
  
!     !define L_RESULT      $R0   ; result from 'GetMeCabFile' function or the 'untgz' plugin
!                                 ; WARNING: The 'untgz' plugin is hard-coded to use $R0
  
!     !define L_DLG_ITEM    $R1   ; used to disable/enable the "Show Details" button
!     !define L_LISTSIZE    $R2   ; number of patches to be applied
  
      Push ${L_RESERVED}
***************
*** 401,404 ****
--- 418,455 ----
      EnableWindow ${L_DLG_ITEM} 0
  
+     ; Use MD5 sums to check the integrity of the Mecab files we download
+ 
+     Push "${C_NPD_MD5SUMS}"
+     Call ${UN}GetMeCabFile
+     Pop ${L_RESULT}
+     StrCmp ${L_RESULT} "OK" 0 installer_error_exit
+ 
+     Push "${C_NPD_MECAB_MD5}"
+     Call ${UN}GetMeCabFile
+     Pop ${L_RESULT}
+     StrCmp ${L_RESULT} "OK" 0 installer_error_exit
+ 
+     md5dll::GetMD5File "$PLUGINSDIR\${C_MECAB_MD5}"
+     Pop ${L_RESULT}
+     DetailPrint ""
+     DetailPrint "Calculated MD5 sum for ${C_MECAB_MD5}: ${L_RESULT}"
+     Push "${C_MECAB_MD5}"
+     Call ${UN}ExtractMD5sum
+     Pop $G_PLS_FIELD_1
+     DetailPrint "Downloaded MD5 sum for ${C_MECAB_MD5}: $G_PLS_FIELD_1"
+     StrCmp $G_PLS_FIELD_1 ${L_RESULT} check_if_installed
+     DetailPrint "MD5 sums differ!"
+     MessageBox MB_OK|MB_ICONEXCLAMATION "'${C_MECAB_MD5}' file has bad checksum!"
+     Goto installer_error_exit
+ 
+   check_if_installed:
+     IfFileExists "$G_ROOTDIR\mecab\etc\mecabrc" 0 download_mecab
+     Push "$G_ROOTDIR\mecab"
+     Call ${UN}VerifyMeCabInstall
+     Pop ${L_RESULT}
+     StrCmp ${L_RESULT} "OK" set_environment
+ 
+   download_mecab:
+ 
      ; Download the MeCab archives
  
***************
*** 469,472 ****
--- 520,525 ----
      DetailPrint "Unzip result = ${L_RESULT}"
  
+   set_environment:
+ 
      ; Add the Environment Variable for MeCab
  
***************
*** 585,588 ****
--- 638,645 ----
  # Macro-based Functions which may be used by the installer and uninstaller
  #
+ #    Macro:                FUNCTION_VERIFY_MECAB_INSTALL
+ #    Installer Function:   VerifyMeCabInstall
+ #    Uninstaller Function: un.VerifyMeCabInstall
+ #
  #    Macro:                FUNCTION_GETMECABFILE
  #    Installer Function:   GetMeCabFile
***************
*** 605,608 ****
--- 662,815 ----
  
  #--------------------------------------------------------------------------
+ # Macro: FUNCTION_VERIFY_MECAB_INSTALL
+ #
+ # The installation process and the uninstall process may both need a function
+ # which verifies the contents of the 'mecab' installation folder. This macro
+ # makes maintenance easier by ensuring that both processes use identical
+ # functions, with the only difference being their names.
+ #
+ # The files in the 'mecab' folder as checked by comparing their MD5 sums against
+ # the expected values found in the 'mecab.md5' file downloaded from the POPFile
+ # web site. 'mecab.md5' contains an entry for each file in the Mecab zip file,
+ # as shown in this extract:
+ #
+ #      # MD5 checksums generated by MD5summer (http://www.md5summer.org)
+ #      # Generated 18/11/07 12:38:45
+ #
+ #      dafe94718a85a63809ec1ed2f6652694 *doc/en/bindings.html
+ #      511cbced26190010bfd8038593d00bf0 *doc/Makefile
+ #      143a77233074c7b86f7f5328fe81603a *etc/mecabrc
+ #      4162fab178e43c764adee2da1987964d *AUTHORS
+ #
+ # Lines starting with '#' or ';' in 'mecab.md5' are ignored, as are empty lines.
+ #
+ # Lines in 'mecab.md5' which contain MD5 sums are assumed to be in this format:
+ # (a) positions 1 to 32 contain a 32 character hexadecimal number (line starts in column 1)
+ # (b) column 33 is a space character (' ')
+ # (c) column 34 is the text/binary flag (' ' = text, '*' = binary)
+ # (d) column 35 is the first character of the filename (filename terminates with end-of-line)
+ #     The MeCab zip file contains several folders so the filename is really a relative path.
+ #
+ # Inputs:
+ #         (top of stack)     - full path to the top-level MeCab folder
+ #
+ # Outputs:
+ #         (top of stack)     - result ("OK" or "fail")
+ #
+ # Usage (after macro has been 'inserted'):
+ #
+ #         Push "C:\Program Filea\POPFile\mecab"
+ #         Call VerifyMeCabInstall
+ #         Pop $0
+ #
+ #         ($R0 at this point is "OK" if the existing installation has same
+ #         MD5 sums as the current downloadable version of the MeCab zip file)
+ #
+ #--------------------------------------------------------------------------
+ 
+ !macro FUNCTION_VERIFY_MECAB_INSTALL UN
+   Function ${UN}VerifyMeCabInstall
+ 
+     !define L_DATA          $R9   ; relative path and expected MD5 sum for a file
+     !define L_EXPECTED_MD5  $R8   ; the expected MD5 sum for the file
+     !define L_FILEPATH      $R7   ; path to the file to be checked
+     !define L_HANDLE        $R6   ; handle used to access the MD5 sums file (mecab.md5)
+     !define L_MECABROOT     $R5   ; the top-level MeCab folder (e.g. C:\Program Files\POPFile\mecab)
+     !define L_RESULT        $R4   ; result to be returned by this function ("OK" or "fail")
+     !define L_TEMP          $R3
+ 
+     Exch ${L_MECABROOT}
+ 
+     Push ${L_DATA}
+     Push ${L_EXPECTED_MD5}
+     Push ${L_FILEPATH}
+     Push ${L_HANDLE}
+     Push ${L_RESULT}
+     Push ${L_TEMP}
+ 
+     SetPluginUnload alwaysoff
+ 
+     StrCpy $G_PLS_FIELD_1 "${L_MECABROOT}"
+     DetailPrint ""
+     SetDetailsPrint both
+     DetailPrint "${C_NPLS_VERIFYING_MECAB}"
+     SetDetailsPrint listonly
+     DetailPrint ""
+ 
+     StrCpy ${L_RESULT} "OK"
+ 
+     FileOpen ${L_HANDLE} "$PLUGINSDIR\${C_MECAB_MD5}" r
+ 
+   read_next_line:
+     FileRead ${L_HANDLE} ${L_DATA}
+     StrCmp ${L_DATA} "" end_of_file
+     StrCpy ${L_TEMP} ${L_DATA} 1
+     StrCmp ${L_TEMP} '#' read_next_line
+     StrCmp ${L_TEMP} ';' read_next_line
+     Push ${L_DATA}
+     Call ${UN}PFI_TrimNewlines
+     Pop ${L_DATA}
+     StrCmp ${L_DATA} "" read_next_line
+     StrCpy ${L_FILEPATH} ${L_DATA} "" 34       ; NSIS strings start at position 0 not 1
+     StrCpy $G_PLS_FIELD_1 "${L_FILEPATH} :"
+     StrCpy ${L_FILEPATH} "${L_MECABROOT}\${L_FILEPATH}"
+     IfFileExists "${L_FILEPATH}" get_expected_MD5
+     StrCpy $G_PLS_FIELD_1 "$G_PLS_FIELD_1 missing"
+     StrCpy ${L_RESULT} "fail"
+     Goto print_result
+ 
+   get_expected_MD5:
+     StrCpy ${L_EXPECTED_MD5} ${L_DATA} 32
+     Push ${L_EXPECTED_MD5}
+     Call ${UN}StrCheckHexadecimal
+     Pop ${L_EXPECTED_MD5}
+     md5dll::GetMD5File "${L_FILEPATH}"
+     Pop ${L_TEMP}
+     StrCmp ${L_EXPECTED_MD5} ${L_TEMP} sums_match
+     StrCpy $G_PLS_FIELD_1 "$G_PLS_FIELD_1 changed"
+     StrCpy ${L_RESULT} "fail"
+     Goto print_result
+ 
+   sums_match:
+     StrCpy $G_PLS_FIELD_1 "$G_PLS_FIELD_1 OK"
+ 
+   print_result:
+     DetailPrint $G_PLS_FIELD_1
+     Goto read_next_line
+ 
+   end_of_file:
+     FileClose ${L_HANDLE}
+     StrCpy $G_PLS_FIELD_1 "${L_RESULT}"
+     Detailprint ""
+     SetDetailsPrint both
+     DetailPrint "${C_NPLS_MECAB_MD5_RESULT}"
+     SetDetailsPrint listonly
+ 
+     SetPluginUnload manual
+ 
+     StrCpy ${L_MECABROOT} ${L_RESULT}
+ 
+     Pop ${L_TEMP}
+     Pop ${L_RESULT}
+     Pop ${L_HANDLE}
+     Pop ${L_FILEPATH}
+     Pop ${L_EXPECTED_MD5}
+     Pop ${L_DATA}
+ 
+     Exch ${L_MECABROOT}
+ 
+     !undef L_DATA
+     !undef L_EXPECTED_MD5
+     !undef L_FILEPATH
+     !undef L_HANDLE
+     !undef L_MECABROOT
+     !undef L_RESULT
+     !undef L_TEMP
+ 
+   FunctionEnd
+ !macroend
+ 
+ 
+ #--------------------------------------------------------------------------
  # Macro: FUNCTION_GETMECABFILE
  #

Index: installer.nsi
===================================================================
RCS file: /cvsroot/popfile/windows/installer.nsi,v
retrieving revision 1.242.4.18
retrieving revision 1.242.4.19
diff -C2 -d -r1.242.4.18 -r1.242.4.19
*** installer.nsi	17 Nov 2007 23:39:08 -0000	1.242.4.18
--- installer.nsi	24 Nov 2007 00:11:34 -0000	1.242.4.19
***************
*** 1403,1406 ****
--- 1403,1417 ----
  
  #--------------------------------------------------------------------------
+ # Installer Function: VerifyMeCabInstall
+ #
+ # Inputs:
+ #         (top of stack)     - full path to the top-level MeCab folder
+ # Outputs:
+ #         (top of stack)     - result ("OK" or "fail")
+ #--------------------------------------------------------------------------
+ 
+   !insertmacro FUNCTION_VERIFY_MECAB_INSTALL ""
+ 
+ #--------------------------------------------------------------------------
  # Installer Function: GetMeCabFile
  #

Index: getssl.nsh
===================================================================
RCS file: /cvsroot/popfile/windows/getssl.nsh,v
retrieving revision 1.6.2.18
retrieving revision 1.6.2.19
diff -C2 -d -r1.6.2.18 -r1.6.2.19
*** getssl.nsh	18 Oct 2007 01:36:42 -0000	1.6.2.18
--- getssl.nsh	24 Nov 2007 00:11:34 -0000	1.6.2.19
***************
*** 168,172 ****
        !define C_PATCH_CTRL_FILE   "0.22.x.pcf"
    !endif
!   !define C_MD5SUMS_FILE      "MD5SUMS"
  
  #--------------------------------------------------------------------------
--- 168,174 ----
        !define C_PATCH_CTRL_FILE   "0.22.x.pcf"
    !endif
!   !ifndef C_MD5SUMS_FILE
!     !define C_MD5SUMS_FILE    "MD5SUMS"
!   !endif
  
  #--------------------------------------------------------------------------

Index: installer-Uninstall.nsh
===================================================================
RCS file: /cvsroot/popfile/windows/installer-Uninstall.nsh,v
retrieving revision 1.4.2.16
retrieving revision 1.4.2.17
diff -C2 -d -r1.4.2.16 -r1.4.2.17
*** installer-Uninstall.nsh	17 Nov 2007 23:39:07 -0000	1.4.2.16
--- installer-Uninstall.nsh	24 Nov 2007 00:11:34 -0000	1.4.2.17
***************
*** 674,677 ****
--- 674,688 ----
  
  #--------------------------------------------------------------------------
+ # Uninstaller Function: un.VerifyMeCabInstall
+ #
+ # Inputs:
+ #         (top of stack)     - full path to the top-level MeCab folder
+ # Outputs:
+ #         (top of stack)     - result ("OK" or "fail")
+ #--------------------------------------------------------------------------
+ 
+   !insertmacro FUNCTION_VERIFY_MECAB_INSTALL "un."
+ 
+ #--------------------------------------------------------------------------
  # Uninstaller Function: un.GetMeCabFile
  #

[popfile-commit] windows/languages English-parser.nsh, 1.1.2.3, 1.1.2.4 Japanese-parser.nsh, 1.1.2.4, 1.1.2.5

[Brian S. <xue...@us...>]

Update of /cvsroot/popfile/windows/languages
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25077/languages

Modified Files:
      Tag: b0_22_2
	English-parser.nsh Japanese-parser.nsh 
Log Message:
The MeCab zip file is over 12 MB so only download it if the installation
folder does not already contain the files from the zip file. If there is
an existing 'mecab' folder check the files in it by comparing MD5 sums
against the set of expected values downloaded from the POPFile web site.
If all of the MD5 sums match do not bother downloading any MeCab files.

Index: Japanese-parser.nsh
===================================================================
RCS file: /cvsroot/popfile/windows/languages/Attic/Japanese-parser.nsh,v
retrieving revision 1.1.2.4
retrieving revision 1.1.2.5
diff -C2 -d -r1.1.2.4 -r1.1.2.5
*** Japanese-parser.nsh	19 Oct 2007 16:00:22 -0000	1.1.2.4
--- Japanese-parser.nsh	24 Nov 2007 00:11:34 -0000	1.1.2.5
***************
*** 81,84 ****
--- 81,92 ----
  ;-------------------------------------------------------------------------------------------
  
+ ; Message shown above the progress bar while comparing the expected and actual MD5 sums for the files listed in 'mecab.md5'
+ 
+ !define C_NPLS_VERIFYING_MECAB     "Verifying the files in the '$G_PLS_FIELD_1' folder..."
+ 
+ ; Message shown above the progress bar with the result of the 'mecab.md5' MD5 checks
+ 
+ !define C_NPLS_MECAB_MD5_RESULT    "MeCab validity check result: $G_PLS_FIELD_1"
+ 
  ; Message shown if internet connection does not appear to be working
  

Index: English-parser.nsh
===================================================================
RCS file: /cvsroot/popfile/windows/languages/Attic/English-parser.nsh,v
retrieving revision 1.1.2.3
retrieving revision 1.1.2.4
diff -C2 -d -r1.1.2.3 -r1.1.2.4
*** English-parser.nsh	18 Oct 2007 01:42:50 -0000	1.1.2.3
--- English-parser.nsh	24 Nov 2007 00:11:34 -0000	1.1.2.4
***************
*** 81,84 ****
--- 81,92 ----
  ;-------------------------------------------------------------------------------------------
  
+ ; Message shown above the progress bar while comparing the expected and actual MD5 sums for the files listed in 'mecab.md5'
+ 
+ !define C_NPLS_VERIFYING_MECAB     "Verifying the files in the '$G_PLS_FIELD_1' folder..."
+ 
+ ; Message shown above the progress bar with the result of the 'mecab.md5' MD5 checks
+ 
+ !define C_NPLS_MECAB_MD5_RESULT    "MeCab validity check result: $G_PLS_FIELD_1"
+ 
  ; Message shown if internet connection does not appear to be working
  

[popfile-commit] windows ioP.ini,1.1.2.1,1.1.2.2

[Brian S. <xue...@us...>]

Update of /cvsroot/popfile/windows
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26010

Modified Files:
      Tag: b0_22_2
	ioP.ini 
Log Message:
Windows 9x systems require CRLF otherwise the custom page will not appear!

Index: ioP.ini
===================================================================
RCS file: /cvsroot/popfile/windows/Attic/ioP.ini,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -C2 -d -r1.1.2.1 -r1.1.2.2
*** ioP.ini	5 Oct 2007 18:36:52 -0000	1.1.2.1
--- ioP.ini	23 Nov 2007 19:38:52 -0000	1.1.2.2
***************
*** 4,8 ****
  #             used to create the Windows installer for POPFile. This file
  #             defines the layout of the custom page used to select the
! #             parser to be used when processing Japanese text.
  #
  # Copyright (c) 2007 John Graham-Cumming
--- 4,8 ----
  #             used to create the Windows installer for POPFile. This file
  #             defines the layout of the custom page used to select the
! #             parser to be used when processing Japanese (Nihongo) text.
  #
  # Copyright (c) 2007 John Graham-Cumming

[popfile-commit] engine/Services IMAP.pm,1.9.4.10,1.9.4.11

[Manni H. <man...@us...>]

Update of /cvsroot/popfile/engine/Services
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9405/Services

Modified Files:
      Tag: b0_22_2
	IMAP.pm 
Log Message:
Remove some commented-out cruft.

Index: IMAP.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Services/IMAP.pm,v
retrieving revision 1.9.4.10
retrieving revision 1.9.4.11
diff -C2 -d -r1.9.4.10 -r1.9.4.11
*** IMAP.pm	23 Nov 2007 06:59:44 -0000	1.9.4.10
--- IMAP.pm	23 Nov 2007 15:49:55 -0000	1.9.4.11
***************
*** 1595,1602 ****
      }
      return;
- #                if ( $@ ) {
- #                    $templ->param( IMAP_update_list_failed => 'Lost the connection to the server while trying to update the list of mailboxes. Please try again and/or check your connection settings.' );
- #                    $self->log_( 0, "Connection to server was lost." );
- #                }
  }
  
--- 1595,1598 ----

[popfile-commit] engine/tests TestIMAP.tst,1.3.4.7,1.3.4.8

[Manni H. <man...@us...>]

Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5738/tests

Modified Files:
      Tag: b0_22_2
	TestIMAP.tst 
Log Message:
Add yet more tests for validate_item.
New coverage values: 86% und 82% for Client.pm and IMAP.pm, respectively.


Index: TestIMAP.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestIMAP.tst,v
retrieving revision 1.3.4.7
retrieving revision 1.3.4.8
diff -C2 -d -r1.3.4.7 -r1.3.4.8
*** TestIMAP.tst	23 Nov 2007 07:00:18 -0000	1.3.4.7
--- TestIMAP.tst	23 Nov 2007 11:08:43 -0000	1.3.4.8
***************
*** 379,388 ****
  
      # Here's a list of all the templates we have to test:
-     #   imap-bucket-folders.thtml
-     #   imap-options.thtml
-     #   imap-watch-folders.thtml
      #   imap-connection-details.thtml
!     #   imap-update-mailbox-list.thtml
      #   imap-watch-more-folders.thtml
  
      # We also need to provide those methods with a language hash:
--- 379,388 ----
  
      # Here's a list of all the templates we have to test:
      #   imap-connection-details.thtml
!     #   imap-watch-folders.thtml
      #   imap-watch-more-folders.thtml
+     #   imap-bucket-folders.thtml
+     #   imap-update-mailbox-list.thtml
+     #   imap-options.thtml
  
      # We also need to provide those methods with a language hash:
***************
*** 573,576 ****
--- 573,578 ----
  
      # We now will have to test validate_item.
+ 
+     # imap-connection-details.thtml
      my $form = {};
      $tmpl = HTML::Template->new( filename => '../skins/default/imap-connection-details.thtml' );
***************
*** 588,591 ****
--- 590,594 ----
      test_assert_equal( $im->config_( 'hostname' ), 'hostname' );
  
+     # imap-watch-folders.thtml
      $form = {};
      $tmpl = HTML::Template->new( filename => '../skins/default/imap-watch-folders.thtml' );
***************
*** 600,604 ****
      test_assert_equal( $folders[0], 'first watched folder' );
      test_assert_equal( $folders[1], 'second watched folder' );
!  }
  
  
--- 603,648 ----
      test_assert_equal( $folders[0], 'first watched folder' );
      test_assert_equal( $folders[1], 'second watched folder' );
! 
!     # imap-watch-more-folders.thtml
!     $form = {};
!     $form->{imap_2_watch_more_folders} = 1;
!     $tmpl = HTML::Template->new( filename => '../skins/default/imap-watch-more-folders.thtml' );
!     $im->validate_item( 'imap_2_watch_more_folders', $tmpl, $language, $form );
!     @folders = $im->watched_folders__();
!     test_assert_equal( scalar @folders, 3 );
!     test_assert_equal( pop @folders, 'INBOX' );
! 
!     # imap-bucket-folders.thtml
!     $form = {};
!     $form->{imap_3_bucket_folders} = 1;
!     $tmpl = HTML::Template->new( filename => '../skins/default/imap-bucket-folders.thtml' );
!     $im->validate_item('imap_3_bucket_folders', $tmpl, $language, $form );
! 
! 
!     # imap-update-mailbox-list.thtml
!     $form = {};
!     $form->{do_imap_4_update_mailbox_list} = 1;
!     $tmpl = HTML::Template->new( filename => '../skins/default/imap-update-mailbox-list.thtml' );
!     $im->validate_item( 'imap_4_update_mailbox_list', $tmpl, $language, $form );
! 
! 
!     # imap-options.thtml
!     $form = {};
!     $tmpl = HTML::Template->new( filename => '../skins/default/imap-options.thtml' );
!     $form->{update_imap_5_options} = 1;
!     $form->{imap_options_expunge} = 1;
!     $form->{imap_options_update_interval} = 1234;
!     $im->validate_item( 'imap_5_options', $tmpl, $language, $form );
!     test_assert_equal( $im->config_( 'expunge' ), 1 );
!     test_assert_equal( $im->config_( 'update_interval' ), 1234 );
! 
!     $form->{imap_options_expunge} = undef;
!     $im->validate_item( 'imap_5_options', $tmpl, $language, $form );
!     test_assert_equal( $im->config_( 'expunge' ), 0 );
! 
!     $form->{imap_options_update_interval} = 0;
!     $im->validate_item( 'imap_5_options', $tmpl, $language, $form );
!     test_assert_equal( $tmpl->param('IMAP_if_interval_error'), 1 );
! }
  
  

[popfile-commit] engine/tests TestIMAP.tst,1.3.4.6,1.3.4.7

[Manni H. <man...@us...>]

Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13293/tests

Modified Files:
      Tag: b0_22_2
	TestIMAP.tst 
Log Message:
Initial tests for validate_item()

Index: TestIMAP.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestIMAP.tst,v
retrieving revision 1.3.4.6
retrieving revision 1.3.4.7
diff -C2 -d -r1.3.4.6 -r1.3.4.7
*** TestIMAP.tst	19 Nov 2007 10:11:48 -0000	1.3.4.6
--- TestIMAP.tst	23 Nov 2007 07:00:18 -0000	1.3.4.7
***************
*** 183,187 ****
          my $hash = ($h->get_slot_fields( $_ ))[6];
          test_assert_equal( $im->can_reclassify__( $hash, 'spam' ), undef );
!         test_assert_equal( $im->can_classify__( $hash ), undef );   #QUATSCH
      }
  
--- 183,187 ----
          my $hash = ($h->get_slot_fields( $_ ))[6];
          test_assert_equal( $im->can_reclassify__( $hash, 'spam' ), undef );
!         test_assert( ! $im->can_classify__( $hash ) );
      }
  
***************
*** 189,192 ****
--- 189,209 ----
      test_assert_equal( $b->classify( $session, 'TestMailParse007.msg' ), 'personal' );
  
+     # Now let's see whether the words in one of the reclassified messages
+     # actually ended up in the corpus
+ 
+     my %words;
+ 
+     open WORDS, "<TestMailParse013.wrd";
+     while ( <WORDS> ) {
+         if ( /(.+) (\d+)/ ) {
+             $words{$1} = $2;
+         }
+     }
+     close WORDS;
+ 
+     foreach my $word (keys %words) {
+         test_assert( $b->get_count_for_word( $session, 'other', $word ) > 0, "other: $word $words{$word}" );
+     }
+ 
      $im->disconnect_folders__();
  
***************
*** 554,557 ****
--- 571,603 ----
      test_assert_equal( $tmpl->param( 'IMAP_expunge_is_checked' ), '' );
      test_assert_equal( $tmpl->param( 'IMAP_interval', '99' ) );
+ 
+     # We now will have to test validate_item.
+     my $form = {};
+     $tmpl = HTML::Template->new( filename => '../skins/default/imap-connection-details.thtml' );
+     $form->{update_imap_0_connection_details} = 1;
+     $form->{imap_hostname} = 'hostname';
+     $form->{imap_port} = 123;
+     $form->{imap_login} = 'username';
+     $form->{imap_password} = 'secret';
+     $form->{imap_use_ssl} = 1;
+     $im->validate_item( 'imap_0_connection_details', $tmpl, $language, $form );
+     test_assert_equal( $im->config_( 'use_ssl' ), 1 );
+     test_assert_equal( $im->config_( 'password' ), 'secret' );
+     test_assert_equal( $im->config_( 'login' ), 'username' );
+     test_assert_equal( $im->config_( 'port' ), 123 );
+     test_assert_equal( $im->config_( 'hostname' ), 'hostname' );
+ 
+     $form = {};
+     $tmpl = HTML::Template->new( filename => '../skins/default/imap-watch-folders.thtml' );
+     $form->{imap_folder_1} = 'first watched folder';
+     $form->{imap_folder_2} = 'second watched folder';
+     $form->{update_imap_1_watch_folders} = 1;
+     $im->watched_folders__( '1', '2' );
+     $im->validate_item( 'imap_1_watch_folders', $tmpl, $language, $form );
+     test_assert_equal( $im->{folder_change_flag__}, 1 );
+     my @folders = $im->watched_folders__();
+     test_assert_equal( scalar @folders, 2 );
+     test_assert_equal( $folders[0], 'first watched folder' );
+     test_assert_equal( $folders[1], 'second watched folder' );
   }