[Openinteract-commits] CVS: OpenInteract2/lib/OpenInteract2 Package.pm,1.50,1.51

[Chris W. <la...@us...>]

Update of /cvsroot/openinteract/OpenInteract2/lib/OpenInteract2
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23733/lib/OpenInteract2

Modified Files:
	Package.pm 
Log Message:
OIN-117: modify package to conditionally copy from 'conf/' into
$WEBSITE_DIR/conf/$PACKAGE when installing a packae to a website;
'conditionally' means that if there are files of the same name already
there we check 'CHECKSUMS' to see if our new file is the same -- if
the file is the same we do nothing, but if the file is different we
copy it to an 'updates/' subdirectory with the version number
appended; also modify 'get_spops_files()' and 'get_action_files()' to
read from that directory if a 'repository' property is set in the
package


Index: Package.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract2/lib/OpenInteract2/Package.pm,v
retrieving revision 1.50
retrieving revision 1.51
diff -C2 -d -r1.50 -r1.51
*** Package.pm	28 Feb 2005 00:59:18 -0000	1.50
--- Package.pm	6 Mar 2005 15:06:36 -0000	1.51
***************
*** 249,256 ****
          $base_files = [ grep { m|^conf/spops.*\.ini$| } @{ $files } ];
      }
!     my $dir = $self->directory;
!     my @spops_files = map { catfile( $dir, $_ ) } @{ $base_files };
      $self->_check_file_validity( \@spops_files );
!     return $base_files
  }
  
--- 249,263 ----
          $base_files = [ grep { m|^conf/spops.*\.ini$| } @{ $files } ];
      }
!     my @spops_files = ();
!     if ( my $rep = $self->repository ) {
!         my $dir = catdir( $rep->website_dir, 'conf', $self->name );
!         @spops_files = map { s|^conf/||; catfile( $dir, $_ ) } @{ $base_files };
!     }
!     else {
!         my $dir = $self->directory;
!         @spops_files = map { catfile( $dir, $_ ) } @{ $base_files };
!     }
      $self->_check_file_validity( \@spops_files );
!     return \@spops_files
  }
  
***************
*** 266,273 ****
          ];
      }
!     my $dir = $self->directory;
!     my @action_files = map { catfile( $dir, $_ ) } @{ $base_files };
      $self->_check_file_validity( \@action_files );
!     return $base_files
  }
  
--- 273,287 ----
          ];
      }
!     my @action_files = ();
!     if ( my $rep = $self->repository ) {
!         my $dir = catdir( $rep->website_dir, 'conf', $self->name );
!         @action_files = map { s|^conf/||; catfile( $dir, $_ ) } @{ $base_files };
!     }
!     else {
!         my $dir = $self->directory;
!         @action_files = map { catfile( $dir, $_ ) } @{ $base_files };
!     }
      $self->_check_file_validity( \@action_files );
!     return \@action_files;
  }
  
***************
*** 347,354 ****
          $log->info( "Unpacked package into '$full_package_dir' ok" );
  
!     my $installed_package = $class->new({ directory  => $full_package_dir,
!                                           repository => $repository });
      $installed_package->installed_date( scalar( localtime ) );
!     my $copied_files = $installed_package->_install_copy_files;
      $log->is_info &&
          $log->info( "Copied package files to website ok" );
--- 361,371 ----
          $log->info( "Unpacked package into '$full_package_dir' ok" );
  
!     my $installed_package = $class->new({
!         directory  => $full_package_dir,
!         repository => $repository,
!     });
      $installed_package->installed_date( scalar( localtime ) );
!     $installed_package->_install_html_and_widget_files_to_website;
!     $installed_package->_install_conf_files_to_website;
      $log->is_info &&
          $log->info( "Copied package files to website ok" );
***************
*** 681,810 ****
  }
  
! sub _install_copy_files {
      my ( $self ) = @_;
!     unless ( $self->repository ) {
!         my $pkg_dir = rel2abs( $self->directory );
!         warn "Cannot copy files from package '", $self->name, "' to ",
!              "website because there is no repository set in package. ",
!              "You will need to copy the files from '$pkg_dir/html' and ",
!              "'$pkg_dir/widget' (if they exist) to the website manually.\n";
!         return;
      }
  
!     my %file_map = map { $_ => 1 } @{ $self->get_files };
! 
!     my @html_files = grep /^html/, keys %file_map;
!     my @html_dest_full = $self->_install_package_files_to_website(
!                                    \@html_files );
! 
!     my @widget_files = grep /^widget/, keys %file_map;
!     my @widget_dest_files = @widget_files;
!     s|^widget|template| for ( @widget_dest_files );
!     my @widget_dest_full = $self->_install_package_files_to_website(
!                                    \@widget_files, \@widget_dest_files );
!     return [ @html_dest_full, @widget_dest_full ];
! }
! 
! 
! sub _install_package_files_to_website {
!     my ( $self, $base_files, $dest_files ) = @_;
!     $log ||= get_logger( LOG_OI );
! 
!     $dest_files ||= [];
!     my $website_dir = $self->repository->website_dir;
!     my $package_dir = rel2abs( $self->directory );
!     my $BACKUP_EXT = 'pkg_install_backup';
!     my ( @copy_files );
      eval {
!         my $count = 0;
!         my %ro_by_dir = ();
! BASE_FILE:
!         foreach my $from_base ( @{ $base_files } ) {
! 
!             # By default we copy relpath/filename -> relpath/filename
!             # from $base_files unless something specified in
!             # corresponding \@dest_files entry
! 
!             my $to_base = $dest_files->[ $count ] || $from_base;
! 
!             my $full_source_path = catfile( $package_dir, $from_base );
!             my $full_dest_path = catfile( $website_dir, $to_base );
!             $self->_create_full_path( $full_dest_path );
! 
!             my $full_dest_dir = dirname( $full_dest_path );
!             my $ro = $ro_by_dir{ $full_dest_dir };
!             unless ( $ro ) {
!                 $ro_by_dir{ $full_dest_dir } =
!                     OpenInteract2::Config::Readonly->new( $full_dest_dir );
!                 $ro = $ro_by_dir{ $full_dest_dir };
!             }
! 
!             # If file already exists check if we can write, and if so
!             # backup the file
! 
!             if ( -f $full_dest_path ) {
!                 unless ( $ro->is_writeable( $to_base ) ) {
!                     $log->is_debug &&
!                         $log->debug( "Will not copy '$full_source_path' ",
!                                  "to '$full_dest_path': marked readonly" );
!                     next BASE_FILE;
!                 }
!                 rename( $full_dest_path, "$full_dest_path.$BACKUP_EXT" )
!                     || die "Cannot backup '$full_dest_path': $!";
!             }
!             cp( $full_source_path, $full_dest_path )
!                     || die "Cannot copy '$full_source_path' -> '$full_dest_path': $!";
!             chmod( 0666, $full_dest_path ); # let umask work...
!             push @copy_files, $full_dest_path;
!             $count++;
!         }
      };
      if ( $@ ) {
          $log->error( "Caught error copying files to website: $@" );
!         foreach my $filename ( @copy_files ) {
              unlink( $filename )
!                     || warn "Cannot cleanup '$filename': $!";
!             if ( -f "$filename.$BACKUP_EXT" ) {
!                 rename( "$filename.$BACKUP_EXT", $filename )
                      || warn "Cannot activate backup for '$filename': $!";
!                 unlink( "$filename.$BACKUP_EXT" )
                      || warn "Cannot remove stale backup for '$filename': $!";
              }
          }
!         @copy_files = ();
      }
!     return \@copy_files;
  }
  
  
! ########################################
! # PACKAGE SKELETON HELPERS
  
! # Must specify one of:
! #   source_dir = /usr/local/src/OpenInteract-2.01
! #   sample_dir = /usr/local/src/OpenInteract-2.01/sample/package
  
! sub _skel_get_sample_dir {
!     my ( $class, $params ) = @_;
!     my $sample_dir = $params->{sample_dir};
!     my $source_dir = $params->{source_dir};
  
!     # If the source_dir is specified and the sample_dir isn't, build
!     # the sample dir from the source dir
  
!     if ( $source_dir && -d $source_dir &&
!          ( ! $sample_dir || ! -d $sample_dir ) ) {
!         $sample_dir = catdir( $source_dir, 'sample', 'package' );
      }
!     if ( $sample_dir ) {
!         $sample_dir = rel2abs( $sample_dir );
      }
!     unless ( $sample_dir && -d $sample_dir ) {
!         oi_error "Specified sample directory '$sample_dir' is ",
!                  "not a valid directory";
      }
!     return $sample_dir;
  }
  
  # Ensure a package name is ok and that it can be used as a namespace
  # when necessary.
--- 698,845 ----
  }
  
! sub _install_html_and_widget_files_to_website {
      my ( $self ) = @_;
!     my @pkg_files = @{ $self->get_files };
!     my %copy_files = ();
!     for ( grep /^html/, @pkg_files ) {
!         $log->is_debug && $log->debug( "Will copy HTML '$_' -> '$_'" );
!         $copy_files{ $_ } = $_;
!     }
!     foreach my $src ( grep /^widget/, @pkg_files ) {
!         my $dest = $src;
!         $dest =~ s|^widget|template|;
!         $log->is_debug && $log->debug( "Will copy widget '$_' -> '$_'" );
!         $copy_files{ $src } = $dest;
      }
  
!     my ( @copied );
      eval {
!         $self->_install_do_copy_files_to_website( \%copy_files, \@copied );
      };
      if ( $@ ) {
          $log->error( "Caught error copying files to website: $@" );
!         foreach my $filename ( @copied ) {
              unlink( $filename )
!                 || warn "Cannot cleanup '$filename': $!";
!             if ( -f "$filename.backup" ) {
!                 rename( "$filename.backup", $filename )
                      || warn "Cannot activate backup for '$filename': $!";
!                 unlink( "$filename.backup" )
                      || warn "Cannot remove stale backup for '$filename': $!";
              }
          }
!         @copied = ();
      }
!     return @copied;
  }
  
+ sub _install_do_copy_files_to_website {
+     my ( $self, $copy_files, $track ) = @_;
+     my $website_dir = $self->repository->website_dir;
+     my $package_dir = rel2abs( $self->directory );
+     my $count = 0;
  
! BASE_FILE:
!     while ( my ( $src_base, $dest_base ) = each %{ $copy_files } ) {
!         my $src_path  = catfile( $package_dir, $src_base );
!         my $dest_path = catfile( $website_dir, $dest_base );
!         my $dest_dir  = dirname( $dest_path );
!         $self->_create_full_path( $dest_path );
  
!         if ( -f $dest_path ) {
!             my $dest_file = basename( $dest_path );
!             my $dest_dir  = dirname( $dest_path );
!             my $ro = OpenInteract2::Config::Readonly->new( $dest_dir );
!             unless ( $ro->is_writeable( $dest_file ) ) {
!                 $log->is_info
!                     && $log->info( "Skipping '$dest_path' because it's marked as readonly" );
!                 next BASE_FILE;
!             }
!             rename( $dest_path, "$dest_path.backup" )
!                 || die "Cannot backup '$dest_path': $!\n";
!         }
!         $log->is_debug &&
!             $log->debug( "Copying '$src_path' -> '$dest_path'" );
!         $self->_create_full_path( $dest_path );
!         cp( $src_path, $dest_path )
!             || die "Cannot copy '$src_path' -> '$dest_path': $!\n";
!         chmod( 0666, $dest_path ); # let umask work...
!         push @{ $track }, $dest_path;
!         $count++;
!     }
! }
  
! sub _install_conf_files_to_website {
!     my ( $self ) = @_;
!     my $website_dir     = $self->repository->website_dir;
!     my $package_dir     = rel2abs( $self->directory );
!     my $dest_conf_dir   = catdir( $website_dir, 'conf', $self->name );
!     unless ( -d $dest_conf_dir ) {
!         mkpath( $dest_conf_dir );
!     }
!     my $dest_update_dir = catdir( $dest_conf_dir, 'updates' );
  
!     my @conf_files = grep /^conf/, @{ $self->get_files };
!     my @to_checksum = ();
!     my %checksums = $self->_read_conf_checksums( $dest_conf_dir );
! FILE:
!     foreach my $src_base ( @conf_files ) {
!         my $src_path  = catfile( $package_dir, $src_base );
!         my $filename  = basename( $src_path );
!         my $dest_path = catfile( $dest_conf_dir, $filename );
  
!         if ( -f $dest_path ) {
!             my $md5 = OpenInteract2::Util->digest_file( $src_path );
!             next FILE if ( $checksums{ $filename } eq $md5 );
!             my $update_path =
!                 catfile( $dest_update_dir, $filename . '-' . $self->version );
!             $self->_create_full_path( $update_path );
!             cp( $src_path, $update_path )
!                 || oi_error "Cannot copy $src_path -> $update_path: $!";
!         }
!         else {
!             cp( $src_path, $dest_path )
!                 || oi_error "Cannot copy $src_path -> $dest_path: $!";
!             push @to_checksum, $filename;
!         }
      }
!     $self->_write_conf_checksums( $dest_conf_dir, @to_checksum );
! }
! 
! sub _read_conf_checksums {
!     my ( $self, $conf_dir ) = @_;
!     my $checksum_file = catfile( $conf_dir, 'CHECKSUMS' );
!     return () unless ( -f $checksum_file );
!     open( CSUM, '<', $checksum_file )
!         || oi_error "Cannot read from $checksum_file: $!";
!     my %sums = ();
!     while ( <CSUM> ) {
!         chomp;
!         next if ( /^#/ or /^\s*$/ );
!         my ( $md5, $file ) = split /\s+/, $_, 2;
!         $sums{ $file } = $md5;
      }
!     close( CSUM );
!     return %sums;
! }
! 
! sub _write_conf_checksums {
!     my ( $self, $conf_dir, @files ) = @_;
!     return unless ( scalar @files );
!     my $checksum_file = catfile( $conf_dir, 'CHECKSUMS' );
!     my $oper = ( -f $checksum_file ) ? '>>' : '>';
!     open( CSUM, $oper, $checksum_file )
!         || oi_error "Cannot write to $checksum_file: $!";
!     foreach my $file ( @files ) {
!         my $md5 = OpenInteract2::Util->digest_file( catfile( $conf_dir, $file ) );
!         print CSUM "$md5  $file\n";
      }
!     close( CSUM );
  }
  
+ 
+ ########################################
+ # PACKAGE SKELETON HELPERS
+ 
  # Ensure a package name is ok and that it can be used as a namespace
  # when necessary.
***************
*** 1329,1335 ****
   # You get back a reference to the installed package.
    
!  my $package = OpenInteract2::Package->install(
!                          { package_file => '/home/perlguy/trivia-game-1.07.zip',
!                            website_dir  => '/home/httpd/mysite' });
    
   # Create a new skeleton package for development (for the real world,
--- 1364,1371 ----
   # You get back a reference to the installed package.
    
!  my $package = OpenInteract2::Package->install({
!      package_file => '/home/perlguy/trivia-game-1.07.zip',
!      website_dir  => '/home/httpd/mysite'
!  });
    
   # Create a new skeleton package for development (for the real world,
***************
*** 1337,1343 ****
   # package.
   
!  my $package = OpenInteract2::Package->create_skeleton(
!                          { name       => 'mynewpackage',
!                            sample_dir => '/usr/local/src/OpenInteract-2.00/sample/package' });
   
   # Export package in the given directory for distribution
--- 1373,1379 ----
   # package.
   
!  my $package = OpenInteract2::Package->create_skeleton({
!      name => 'mynewpackage',
!  });
   
   # Export package in the given directory for distribution
***************
*** 1356,1360 ****
   
   my $package = OpenInteract2::Package->new({
!                     package_file => '/home/cwinters/pkg/mynewpackage-1.02.zip' });
   my $config = $package->config;
   print "Package ", $package->name, " ", $package->version, "\n",
--- 1392,1397 ----
   
   my $package = OpenInteract2::Package->new({
!      package_file => '/home/cwinters/pkg/mynewpackage-1.02.zip'
!  });
   my $config = $package->config;
   print "Package ", $package->name, " ", $package->version, "\n",
***************
*** 1368,1372 ****
   
   my $package = OpenInteract2::Package->new({
!                     directory => '/home/cwinters/pkg/mynewpackage' });
   my @status = $package->check;
   foreach my $status ( @status ) {
--- 1405,1410 ----
   
   my $package = OpenInteract2::Package->new({
!      directory => '/home/cwinters/pkg/mynewpackage'
!  });
   my @status = $package->check;
   foreach my $status ( @status ) {
***************
*** 1377,1381 ****
   
   my $package = OpenInteract2::Package->new({
!                     directory => '/home/cwinters/pkg/mynewpackage' });
   $package->remove;
   
--- 1415,1420 ----
   
   my $package = OpenInteract2::Package->new({
!      directory => '/home/httpd/mysite/pkg/mynewpackage-1.13',
!  });
   $package->remove;
   
***************
*** 1492,1508 ****
  lower-case with no spaces. If not an exception is thrown.
  
- =item *
- 
- B<sample_dir>: The directory from where we pull our skeleton files
- from. This is normally in the OpenInteract source distribution
- directory, although you may elect to copy these files elsewhere so
- developers can have access.
- 
- =item *
- 
- B<source_dir>: You can use this instead of C<sample_dir> as long as
- the directory 'sample/package' exists underneath. (It should unless
- you have mucked with the source distribution.)
- 
  =back
  
--- 1531,1534 ----
***************
*** 1648,1653 ****
  B<get_spops_files()>
  
! Retrieves SPOPS configuration files from the package. You can either
! specify the files yourself in the package configuration (see
  L<OpenInteract2::Config::Package|OpenInteract2::Config::Package>), or
  this routine will pick up all files that match C<^conf/spops.*\.ini$>.
--- 1674,1682 ----
  B<get_spops_files()>
  
! Retrieves SPOPS configuration files used by this package. If the
! package object has an assigned C<repository> you'll get the files from
! C<$WEBSITE_DIR/conf/$PACKAGE>, otherwise they'll be from
! C<$PACKAGE_DIR/conf>. You can either specify the files yourself in the
! package configuration (see
  L<OpenInteract2::Config::Package|OpenInteract2::Config::Package>), or
  this routine will pick up all files that match C<^conf/spops.*\.ini$>.
***************
*** 1657,1664 ****
  B<get_action_files()>
  
! Retrieves action configuration files from the package. You can either
! specify the files yourself in the package configuration (see
  L<OpenInteract2::Config::Package|OpenInteract2::Config::Package>), or
! this routine will pick up all files that match C<^conf/action.*\.ini$>.
  
  Returns: arrayref of relative action configuration files.
--- 1686,1697 ----
  B<get_action_files()>
  
! Retrieves action configuration files from the package. If the package
! object has an assigned C<repository> you'll get the files from
! C<$WEBSITE_DIR/conf/$PACKAGE>, otherwise they'll be from
! C<$PACKAGE_DIR/conf>. You can either specify the files yourself in the
! package configuration (see
  L<OpenInteract2::Config::Package|OpenInteract2::Config::Package>), or
! this routine will pick up all files that match
! C<^conf/action.*\.ini$>.
  
  Returns: arrayref of relative action configuration files.
***************
*** 1688,1691 ****
--- 1721,1728 ----
  found, C<undef>.
  
+ NOTE: If you're looking for a configuration file use the
+ C<get_spops_files()> or C<get_action_files()> instead as you'll get
+ the most current version from the website with those.
+ 
  B<read_file( $relative_file )>
  
***************
*** 1720,1770 ****
  object associated with this package.
  
- =head1 TO DO
- 
- B<Automatically create objects for HTML pages>
- 
- NEW WAY:
- 
- In the relevant OI2::Manage class, just run the page scanner after a
- package has been installed.
- 
- OLD WAY:
- 
- For each file copied over to the /html directory, create a 'page'
- object in the system for it. Note that we might have to hook this up
- with the system that ensures we do not overwrite certain files. So we
- might need to either remove it from the _copy_package_files() routine,
- or add an argument to that routine that lets us pass in a coderef to
- execute with every item copied over.
- 
- ACK -- here is the problem. We do not know if we can even create an $R
- yet, because (1) the base_page package might not have even been
- installed yet (when creating a website) and (2) the user has not yet
- configured the database (etc.)
- 
- We can get around this whenever we rewrite
- Package/PackageRepository/oi_manage, but until then we will tell
- people to include the relevant data inserts with packages that include
- HTML documents.
- 
- Until then, here is what this might look like :-)
- 
-  # Now do the HTML files, but also create records for each of the HTML
-  # files in the 'page' table
- 
-    my $copied = $class->_copy_package_files( "$info->{website_dir}/html",
-                                              'html',
-                                              $pkg_file_list );
-    my @html_locations = map { s/^html//; $_ } @{ $copied };
-    foreach my $location ( @html_locations ) {
-        my $page = $R->page->fetch( $location, { skip_security => 1 } );
-        next if ( $page );
-        eval {
-            $R->page->new({ location => $location,
-                                       ... })
-                    ->save({ skip_security => 1 });
-        };
-    }
- 
  =head1 SEE ALSO
  
--- 1757,1760 ----