[popfile-commit] engine/Classifier Bayes.pm,1.364,1.365

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

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

Modified Files:
	Bayes.pm 
Log Message:
Change Log

1. New options in cloning user

  UI/HTML.pm
  Classifier/Bayes.pm
  skins/default/users-page.thtml
  languages/English.msg
  languages/Nihongo.msg

  Following two options are added:

    1. Copy user's magnets
    2. Copy user's corpus

  If these options are choosed, the magnets or corpus data of the
  cloned user will be copied to the new user.

2. The language cache is now updated correctly

  UI/HTML.pm

3. Admin's language setting is copied to the global language setting
  in the single user mode

  UI/HTML.pm

4. A new module 'POPFile::Random'
   A new option 'GLOBAL_random_module'
   A new function 'random_()'

  POPFile/Random.pm
  POPFile/Configuration.pm
  POPFile/Module.pm
  Classifier/Bayes.pm
  UI/HTML.pm
  UI/HTTP.pm
  tests/TestConfiguration.tst

  The new module 'POPFile::Random' is used for generating random strings.

  The new option 'GLOBAL_random_module' is used for specifying which
  module to be used in the POPFile::Random module.

  The new function 'random_()' is used for accessing the POPFile::Random
  module.

5. jump_to_message now works even if the UI is protected with a password

  UI/HTML.pm

6. The log files cannot be accessed from non admin users

  UI/HTML.pm

7. The log files won't be cached by the web browsers

  UI/HTTP.pm

8. The password input box is automatically selected in the single user mode

  skins/default/password-page.thtml

9. Fixed some typos

  skins/default/pop3-chain-panel.thtml
  languages/English.msg
  languages/Nihongo.msg

Current state of the test suite:

    TestBayesScript                 PASS
    TestBayes                       PASS
    TestConfiguration               PASS *
    TestHistory                     PASS *
    TestHTML                        PASS *
    TestHTTP                        PASS
    TestIMAP                        fail
    TestInsertScript                PASS *
    TestLogger                      PASS
    TestMailParse                   PASS
    TestModule                      PASS
    TestMQ                          PASS
    TestMutex                       PASS
    TestPipeScript                  PASS
    TestPOP3                        PASS
    TestProxy                       PASS
    TestWordMangle                  PASS
    TestXMLRPC                      PASS (but child process does not terminate)

    * :  needs to add tests for multi user support

TODO

1. multi user mode tests are needed

  tests/TestConfiguration.tst
  tests/TestHistory.tst
  tests/TestHTML.tst
  tests/TestInsertScript.tst

Index: Bayes.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/Bayes.pm,v
retrieving revision 1.364
retrieving revision 1.365
diff -C2 -d -r1.364 -r1.365
*** Bayes.pm	10 Apr 2008 11:20:55 -0000	1.364
--- Bayes.pm	13 Apr 2008 03:08:09 -0000	1.365
***************
*** 40,44 ****
  use Digest::SHA qw( sha256_hex );
  use MIME::Base64;
- use Crypt::Random qw( makerandom_octet );

  # This is used to get the hostname of the current machine
--- 40,43 ----
***************
*** 1544,1552 ****
      # get a random session key in hex

!     $self->log_( 1, "Generating random octet" );
!     my $random = makerandom_octet(
!                     Length   => 128,
!                     Strength => $self->global_config_( 'crypt_strength' ),
!                     Device   => $self->global_config_( 'crypt_device' ),
                   );
      my $now = time;
--- 1543,1554 ----
      # get a random session key in hex

!     my $module = $self->global_config_( 'random_module' );
!     $self->log_( 1, "Generating random octet using $module" );
! 
!     my $random = $self->random_()->generate_random_string(
!                         $module,
!                         128,
!                         $self->global_config_( 'crypt_strength' ),
!                         $self->global_config_( 'crypt_device' )
                   );
      my $now = time;
***************
*** 1868,1872 ****
      $self->{api_sessions__}{$user_session} = $user;
      $self->db_update_cache__( $user_session );
!     $self->log_( 1, "get_session_key_from_token returning key $user_session for user $self->{api_sessions__}{$user_session}" );

      # Send the session to the parent so that it is recorded and can
--- 1870,1874 ----
      $self->{api_sessions__}{$user_session} = $user;
      $self->db_update_cache__( $user_session );
!     $self->log_( 1, "get_session_key_from_token returning key $user_session for user $user" );

      # Send the session to the parent so that it is recorded and can
***************
*** 3450,3453 ****
--- 3452,3457 ----
  # $new_user    The name for the new user
  # $clone       (optional) Name of user to clone
+ # $copy_magnets (optional) If 1 copy user's magnets
+ # $copy_corpus (optional) If 1 copy user's corpus (words in buckets)
  #
  # Returns 0 for success, 1 for user already exists, 2 for other error,
***************
*** 3458,3462 ****
  sub create_user
  {
!     my ( $self, $session, $new_user, $clone ) = @_;

      my $userid = $self->valid_session_key__( $session );
--- 3462,3466 ----
  sub create_user
  {
!     my ( $self, $session, $new_user, $clone, $copy_magnets, $copy_corpus ) = @_;

      my $userid = $self->valid_session_key__( $session );
***************
*** 3497,3502 ****
              return ( 3, undef );
          }
!         my $h = $self->db_()->prepare( "select utid, val from user_params where userid = $clid;" );
!         $h->execute;
          my %add;
          while ( my $row = $h->fetchrow_arrayref ) {
--- 3501,3515 ----
              return ( 3, undef );
          }
! 
!         # Begin transaction
! 
!         $self->log_( 1, "Start cloning user..." );
!         $self->db_()->begin_work;
! 
!         # Clone user's parameters
! 
!         my $h = $self->db_()->prepare( "select utid, val from user_params where userid = ?;" );
!         $h->execute( $clid );
! 
          my %add;
          while ( my $row = $h->fetchrow_arrayref ) {
***************
*** 3504,3515 ****
          }
          $h->finish;
          foreach my $utid (keys %add) {
!             $self->db_()->do( "insert into user_params ( userid, utid, val ) values ( $id, $utid, '$add{$utid}' );" );
          }

!         # Clone buckets

!         $h = $self->db_()->prepare( "select name, pseudo from buckets where userid = $clid;" );
!         $h->execute;
          my %buckets;
          while ( my $row = $h->fetchrow_arrayref ) {
--- 3517,3532 ----
          }
          $h->finish;
+ 
+         $h = $self->db_()->prepare( "insert into user_params ( userid, utid, val )
+                                             values ( ?, ?, ? );" );
          foreach my $utid (keys %add) {
!             $h->execute( $id, $utid, $add{$utid} );
          }
+         $h->finish;

!         # Clone buckets (optional)

!         $h = $self->db_()->prepare( "select name, pseudo from buckets where userid = ?;" );
!         $h->execute( $clid );
          my %buckets;
          while ( my $row = $h->fetchrow_arrayref ) {
***************
*** 3517,3523 ****
          }
          $h->finish;
          foreach my $name (keys %buckets) {
!             $self->db_()->do( "insert into buckets ( userid, name, pseudo ) values ( $id, '$name', $buckets{$name} );" );
          }

          # Fetch new bucket ids and cloned bucket ids
--- 3534,3544 ----
          }
          $h->finish;
+ 
+         $h = $self->db_()->prepare( "insert into buckets ( userid, name, pseudo )
+                                             values ( ?, ?, ? );" );
          foreach my $name (keys %buckets) {
!             $h->execute( $id, $name, $buckets{$name} );
          }
+         $h->finish;

          # Fetch new bucket ids and cloned bucket ids
***************
*** 3525,3530 ****
          $h = $self->db_()->prepare(
              "select bucket1.id, bucket2.id from buckets as bucket1, buckets as bucket2 
!                  where bucket1.userid = $id and bucket1.name = bucket2.name and bucket2.userid = $clid;" );
!         $h->execute;
          my %new_buckets;
          while ( my $row = $h->fetchrow_arrayref ) {
--- 3546,3552 ----
          $h = $self->db_()->prepare(
              "select bucket1.id, bucket2.id from buckets as bucket1, buckets as bucket2 
!                  where bucket1.userid = $id and bucket1.name = bucket2.name and bucket2.userid = ?;" );
!         $h->execute( $clid );
! 
          my %new_buckets;
          while ( my $row = $h->fetchrow_arrayref ) {
***************
*** 3537,3560 ****
          $h = $self->db_()->prepare(
              "select bucketid, btid, val from buckets, bucket_params
!                  where userid = $clid and buckets.id = bucket_params.bucketid;" );
!         $h->execute;
          my %bucket_params;
!         while (my $row = $h->fetchrow_arrayref ) {
              $bucket_params{$new_buckets{$row->[0]}}{$row->[1]} = $row->[2];
          }
          $h->finish;

          foreach my $bucketid ( keys %bucket_params ) {
              foreach my $btid ( keys %{$bucket_params{$bucketid}} ) {
!                 my $val = $self->db_()->quote( $bucket_params{$bucketid}{$btid} );
!                 $self->db_()->do(
!                     "insert into bucket_params ( bucketid, btid, val ) 
!                          values ( $bucketid, $btid, $val );" );
              }
          }

!         # TODO : Clone magnets

!         # TODO : Clone corpus data (optional)

      } else {
--- 3559,3635 ----
          $h = $self->db_()->prepare(
              "select bucketid, btid, val from buckets, bucket_params
!                  where userid = ? and buckets.id = bucket_params.bucketid;" );
!         $h->execute( $clid );
! 
          my %bucket_params;
!         while ( my $row = $h->fetchrow_arrayref ) {
              $bucket_params{$new_buckets{$row->[0]}}{$row->[1]} = $row->[2];
          }
          $h->finish;

+         $h = $self->db_()->prepare( "insert into bucket_params ( bucketid, btid, val)
+                                             values ( ?, ?, ? );" );
          foreach my $bucketid ( keys %bucket_params ) {
              foreach my $btid ( keys %{$bucket_params{$bucketid}} ) {
!                 my $val = $bucket_params{$bucketid}{$btid};
!                 $h->execute( $bucketid, $btid, $val );
              }
          }
+         $h->finish;

!         # Clone magnets (optional)

!         if ( $copy_magnets ) {
!             $h = $self->db_()->prepare(
!                 "select magnets.bucketid, magnets.mtid, magnets.val from magnets, buckets
!                         where magnets.bucketid = buckets.id and buckets.userid = ?;" );
!             $h->execute( $clid );
! 
!             my %magnets;
!             while ( my $row = $h->fetchrow_arrayref ) {
!                 $magnets{$new_buckets{$row->[0]}}{$row->[1]} = $row->[2];
!             }
!             $h->finish;
! 
!             $h = $self->db_()->prepare( "insert into magnets ( bucketid, mtid, val )
!                                                 values ( ?, ?, ? );" );
!             foreach my $bucketid ( keys %magnets ) {
!                 foreach my $mtid ( keys %{$magnets{$bucketid}} ) {
!                     my $val = $magnets{$bucketid}{$mtid};
!                     $h->execute( $bucketid, $mtid, $val );
!                 }
!             }
!             $h->finish;
!         }
! 
!         # Clone corpus data (optional)
! 
!         if ( $copy_corpus ) {
!             $h = $self->db_()->prepare(
!                 "select matrix.bucketid, matrix.wordid, matrix.times from matrix, buckets
!                         where matrix.bucketid = buckets.id and buckets.userid = ?;" );
!             $h->execute( $clid );
! 
!             my %matrix;
!             while ( my $row = $h->fetchrow_arrayref ) {
!                 $matrix{$new_buckets{$row->[0]}}{$row->[1]} = $row->[2];
!             }
!             $h->finish;
! 
!             $h = $self->db_()->prepare( "insert into matrix ( bucketid, wordid, times )
!                                                 values ( ?, ?, ? );" );
!             foreach my $bucketid ( keys %matrix ) {
!                 foreach my $wordid ( keys %{$matrix{$bucketid}} ) {
!                     my $times = $matrix{$bucketid}{$wordid};
!                     $h->execute( $bucketid, $wordid, $times );
!                 }
!             }
!             $h->finish;
!         }
! 
!         # Commit transaction
! 
!         $self->db_()->commit;
!         $self->log_( 1, "Finish cloning user" );

      } else {
***************
*** 3889,3893 ****
      return undef if ( !defined( $userid ) );

!     my ( $val, $def )= $self->get_user_parameter_from_id( $userid,$parameter );

      return $val;
--- 3964,3968 ----
      return undef if ( !defined( $userid ) );

!     my ( $val, $def )= $self->get_user_parameter_from_id( $userid, $parameter );

      return $val;
***************
*** 3941,3944 ****
--- 4016,4022 ----
      my ( $self, $session ) = @_;

+ #    my ( $package, $filename, $line, $subroutine ) = caller;
+ #    $self->log_( 1, "is_admin_session is called from $package @ $line to check the session key $session" );
+ 
      my $result = $self->get_user_parameter( $session, 'GLOBAL_can_admin' );