[Openinteract-commits] CVS: OpenInteract2/lib/OpenInteract2/Config Readonly.pm,1.10,1.11 TransferSample.pm,1.9,1.10

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

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

Modified Files:
	Readonly.pm TransferSample.pm 
Log Message:
transferring sample files on website upgrades now works as expected -- files with the same content will not be copied; files in the .no_overwrite will not be copied

Index: Readonly.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract2/lib/OpenInteract2/Config/Readonly.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** Readonly.pm	5 Dec 2004 18:50:10 -0000	1.10
--- Readonly.pm	5 Dec 2004 20:01:35 -0000	1.11
***************
*** 27,36 ****
      my ( $class, $directory ) = @_;
      unless ( -d $directory ) {
!         oi_error "Must initialize a $class object with a valid directory";
      }
      my $self = bless({
          directory => $directory
      }, $class );
!     $self->get_readonly_files();
      return $self;
  }
--- 27,37 ----
      my ( $class, $directory ) = @_;
      unless ( -d $directory ) {
!         oi_error "Must initialize a $class object with a valid ",
!                  "directory (given: $directory)";
      }
      my $self = bless({
          directory => $directory
      }, $class );
!     $self->{readonly_files} = $self->_fill_readonly_files();
      return $self;
  }
***************
*** 46,55 ****
  sub get_readonly_files {
      my ( $self ) = @_;
!     if ( $self->{readonly_files} ) {
!         return [ keys %{ $self->{readonly_files} } ];
!     }
      $log ||= get_logger( LOG_CONFIG );
  
!     my $overwrite_check_file = $self->_create_readonly_file();
  
      # This means everything is writeable...
--- 47,58 ----
  sub get_readonly_files {
      my ( $self ) = @_;
!     return [ keys %{ $self->{readonly_files} } ];
! }
! 
! sub _fill_readonly_files {
!     my ( $self ) = @_;
      $log ||= get_logger( LOG_CONFIG );
  
!     my $overwrite_check_file = $self->_create_readonly_filename();
  
      # This means everything is writeable...
***************
*** 71,76 ****
      }
      close( NOWRITE );
!     $self->{readonly_files} = { map { $_ => 1 } @readonly };
!     return \@readonly;
  }
  
--- 74,78 ----
      }
      close( NOWRITE );
!     return { map { $_ => 1 } @readonly };
  }
  
***************
*** 90,94 ****
          return undef;
      }
!     my $overwrite_check_file = $self->_create_readonly_file();
      eval { open( NOWRITE, '>', $overwrite_check_file ) || die $! };
      if ( $@ ) {
--- 92,96 ----
          return undef;
      }
!     my $overwrite_check_file = $self->_create_readonly_filename();
      eval { open( NOWRITE, '>', $overwrite_check_file ) || die $! };
      if ( $@ ) {
***************
*** 106,110 ****
  }
  
! sub _create_readonly_file {
      my ( $self ) = @_;
      return catfile( rel2abs( $self->directory ), $READONLY_FILE );
--- 108,112 ----
  }
  
! sub _create_readonly_filename {
      my ( $self ) = @_;
      return catfile( rel2abs( $self->directory ), $READONLY_FILE );

Index: TransferSample.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract2/lib/OpenInteract2/Config/TransferSample.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** TransferSample.pm	5 Dec 2004 18:50:10 -0000	1.9
--- TransferSample.pm	5 Dec 2004 20:01:35 -0000	1.10
***************
*** 3,9 ****
--- 3,11 ----
  use strict;
  use base qw( Class::Accessor::Fast );
+ use File::Basename           qw( basename dirname );
  use File::Copy               qw( cp );
  use File::Spec::Functions    qw( catfile rel2abs );
  use Log::Log4perl            qw( get_logger );
+ use OpenInteract2::Config::Readonly;
  use OpenInteract2::Constants qw( :log );
  use OpenInteract2::Context   qw( CTX );
***************
*** 13,17 ****
  $OpenInteract2::Config::TransferSample::VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
  
! my @FIELDS = qw( source_dir file_spec files_copied );
  __PACKAGE__->mk_accessors( @FIELDS );
  
--- 15,19 ----
  $OpenInteract2::Config::TransferSample::VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
  
! my @FIELDS = qw( source_dir file_spec files_copied files_skipped files_same );
  __PACKAGE__->mk_accessors( @FIELDS );
  
***************
*** 21,28 ****
      my ( $class, $source_dir ) = @_;
      $log ||= get_logger( LOG_CONFIG );
!     my $self = bless( {}, $class );
      $source_dir = rel2abs( $source_dir );
      unless ( -d $source_dir ) {
!         oi_error "Given source directory [$source_dir] is invalid";
      }
      $self->source_dir( $source_dir );
--- 23,34 ----
      my ( $class, $source_dir ) = @_;
      $log ||= get_logger( LOG_CONFIG );
!     my $self = bless( {
!         files_copied  => [],
!         files_skipped => [],
!         files_same    => [],
!     }, $class );
      $source_dir = rel2abs( $source_dir );
      unless ( -d $source_dir ) {
!         oi_error "Source directory '$source_dir' is invalid";
      }
      $self->source_dir( $source_dir );
***************
*** 35,38 ****
--- 41,45 ----
  sub run {
      my ( $self, $dest_dir, $template_vars ) = @_;
+     $log->is_info && $log->info( "Running transfer from '$dest_dir'..." );
      $self->read_file_spec( $template_vars );
      return $self->transfer( $dest_dir, $template_vars );
***************
*** 44,48 ****
      unless ( -f $copy_list_file ) {
          oi_error "File from which I read the file specifiecations ",
!                  "[$copy_list_file] does not exist";
      }
  
--- 51,55 ----
      unless ( -f $copy_list_file ) {
          oi_error "File from which I read the file specifiecations ",
!                  "'$copy_list_file' does not exist";
      }
  
***************
*** 50,56 ****
      my ( $content );
      $self->{_template}->process( $copy_list_file, $template_vars, \$content )
!                     || oi_error "Cannot process template with files to ",
!                                 "copy [$copy_list_file]: ",
!                                 $self->{_template}->error;
      my @lines = split /\r?\n/, $content;
      my @files = ();
--- 57,62 ----
      my ( $content );
      $self->{_template}->process( $copy_list_file, $template_vars, \$content )
!         || oi_error "Cannot process template with files to ",
!                     "copy '$copy_list_file': ", $self->{_template}->error;
      my @lines = split /\r?\n/, $content;
      my @files = ();
***************
*** 71,81 ****
      my ( $self, $dest_dir, $template_vars ) = @_;
      unless ( ref( $self->file_spec ) eq 'ARRAY' ) {
!         oi_error "You must run 'read_file_spec()' before running 'transfer()'";
      }
! 
!     my $ro_check = OpenInteract2::Config::Readonly->new( $dest_dir );
  
      $template_vars ||= {};
!     my @copied = ();
      foreach my $info ( @{ $self->file_spec } ) {
          my $source_spec = $info->[0];
--- 77,89 ----
      my ( $self, $dest_dir, $template_vars ) = @_;
      unless ( ref( $self->file_spec ) eq 'ARRAY' ) {
!         oi_error "You must run 'read_file_spec()' before running 'transfer()' (you ",
!                  "might try calling 'run()' instead of 'transfer()')";
      }
!     $log->is_info &&
!         $log->info( "Transferring files from '$dest_dir'..." );
  
      $template_vars ||= {};
! 
! FILESPEC:
      foreach my $info ( @{ $self->file_spec } ) {
          my $source_spec = $info->[0];
***************
*** 88,101 ****
          }
  
          my $full_source_file = catfile( $self->source_dir, @{ $source_spec } );
          my $full_dest_file   = catfile( $dest_dir, @{ $dest_spec } );
  
!         unless ( $ro_check->is_writeable( $full_dest_file ) ) {
!             $log->is_info &&
!                 $log->info( "Skipping '$full_source_file', it's marked as ",
!                             "readonly in the destination directory" );
!             next;
!         }
  
  
          # NOTE: You shouldn't assume because ( ! keys %{ $template_vars } )
--- 96,142 ----
          }
  
+         my $relative_dest    = join( '/', @{ $dest_spec } );
          my $full_source_file = catfile( $self->source_dir, @{ $source_spec } );
          my $full_dest_file   = catfile( $dest_dir, @{ $dest_spec } );
+         $log->is_info &&
+             $log->info( "Copying from '$full_source_file' to '$full_dest_file'" );
  
!         # determine if we should overwrite
  
+         if ( -f $full_dest_file ) {
+ 
+             my $base_dest_file   = basename( $full_dest_file );
+             my $full_dest_dir    = dirname( $full_dest_file );
+ 
+             my $ro_check = OpenInteract2::Config::Readonly->new( $full_dest_dir );
+             $log->is_debug &&
+                 $log->debug( "Files I shouldn't copy: ",
+                              join( ', ', @{ $ro_check->get_readonly_files } ) );
+             unless ( $ro_check->is_writeable( $base_dest_file ) ) {
+                 $log->is_info &&
+                     $log->info( "Skipping '$base_dest_file', it's marked as ",
+                                 "readonly in the destination directory" );
+                 $self->add_skipped( $relative_dest );
+                 next FILESPEC;
+             }
+ 
+             # first check the filesize before the relatively expensive digest
+ 
+             my $source_file_size = (stat $full_source_file)[7];
+             my $dest_file_size   = (stat $full_dest_file)[7];
+             if ( $source_file_size == $dest_file_size ) {
+                 my $source_digest =
+                     OpenInteract2::Util->digest_file( $full_source_file );
+                 my $dest_digest   =
+                     OpenInteract2::Util->digest_file( $full_source_file );
+                 if ( $source_digest eq $dest_digest ) {
+                     $log->is_info &&
+                         $log->info( "Digests for files are the same, not copying" );
+                     $self->add_same( $relative_dest );
+                     next FILESPEC;
+                 }
+             }
+ 
+         }
  
          # NOTE: You shouldn't assume because ( ! keys %{ $template_vars } )
***************
*** 105,110 ****
          if ( $copy_only ) {
              cp( $full_source_file, $full_dest_file )
!                     || oi_error "Cannot copy [$full_source_file] -> ",
!                                 "[$full_dest_file]: $!";
              $log->is_info &&
                  $log->info( "Copied w/o processing '$full_source_file' ",
--- 146,151 ----
          if ( $copy_only ) {
              cp( $full_source_file, $full_dest_file )
!                 || oi_error "Cannot copy '$full_source_file' -> ",
!                             "'$full_dest_file': $!";
              $log->is_info &&
                  $log->info( "Copied w/o processing '$full_source_file' ",
***************
*** 114,129 ****
          else {
              $self->{_template}->process( $full_source_file, $template_vars, $full_dest_file )
!                     || oi_error "Cannot copy and token-replace file ",
!                                 "[$full_source_file] -> [$full_dest_file]: ",
!                                 $self->{_template}->error;
              $log->is_info &&
                  $log->info( "Copied with processing '$full_source_file' ",
                              "-> '$full_dest_file'" );
          }
!         push @copied, $full_dest_file;
      }
!     return $self->files_copied( \@copied );
  }
  
  1;
  
--- 155,189 ----
          else {
              $self->{_template}->process( $full_source_file, $template_vars, $full_dest_file )
!                 || oi_error "Cannot copy and token-replace file ",
!                             "'$full_source_file' -> '$full_dest_file': ",
!                             $self->{_template}->error;
              $log->is_info &&
                  $log->info( "Copied with processing '$full_source_file' ",
                              "-> '$full_dest_file'" );
          }
!         $self->add_copied( $relative_dest );
      }
!     return wantarray
!            ? ( $self->files_copied, $self->files_skipped, $self->files_same )
!            : $self->files_copied;
  }
  
+ sub add_copied {
+     my ( $self, @files ) = @_;
+     push @{ $self->{files_copied} }, @files;
+ }
+ 
+ sub add_skipped {
+     my ( $self, @files ) = @_;
+     push @{ $self->{files_skipped} }, @files;
+ }
+ 
+ sub add_same {
+     my ( $self, @files ) = @_;
+     push @{ $self->{files_same} }, @files;
+ }
+ 
+ 
+ 
  1;
  
***************
*** 167,170 ****
--- 227,236 ----
                           ->new( $source_dir )
                           ->run( $dest_dir, \%template_vars );
+  
+  # We can also get the files we did not copy
+  
+  my ( $copies, $skips ) = OpenInteract2::Config::TransferSample
+                                 ->new( $source_dir )
+                                 ->run( $dest_dir, \%template_vars );
  
  =head1 DESCRIPTION
***************
*** 188,192 ****
  Copies files from a source directory tree to a destination directory
  tree. They do not need to be copied to the same levels of the tree, or
! even have the same resulting filename.
  
  =back
--- 254,260 ----
  Copies files from a source directory tree to a destination directory
  tree. They do not need to be copied to the same levels of the tree, or
! even have the same resulting filename. Any files in the destination
! directory's '.no_overwrite' file will not be copied. (See
! L<OpenInteract2::Config::Readonly> for more.)
  
  =back
***************
*** 284,287 ****
--- 352,359 ----
  copied.
  
+ Returns: in a scalar context returns an arrayref of files copied; in
+ list context returns an arrayref of files copied and arrayref of files
+ skipped.
+ 
  B<read_file_spec( [ \%template_vars ] )>
  
***************
*** 305,308 ****
--- 377,387 ----
  templates.
  
+ No action will be taken for any files are found in the destination
+ directory's '.no_overwrite' file. (See
+ L<OpenInteract2::Config::Readonly>.)
+ 
+ We also don't do anything if two files are the same -- that is, if
+ their MD5 digests are the same.
+ 
  =head1 PROPERTIES
  
***************
*** 318,330 ****
  B<files_copied>
  
! Results of C<transfer()> operation, also filled after C<run()>.
! 
! =head1 TO DO
  
! B<Copy only new files>
  
! For files that are marked as copy-only, compare the file size and
! date. If both are equal, don't do the copy. (Makes it easy for people
! to see what's new.)
  
  =head1 COPYRIGHT
--- 397,405 ----
  B<files_copied>
  
! Results from C<transfer()> operation, also filled after C<run()>.
  
! B<files_skipped>
  
! Results from C<transfer()> operation, also filled after C<run()>.
  
  =head1 COPYRIGHT