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

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

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

Modified Files:
	Readonly.pm TransferSample.pm 
Log Message:
modify OI2::Config::Readonly to be more usable (object instead of class methods); modify all usages, tests, etc.

Index: Readonly.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract2/lib/OpenInteract2/Config/Readonly.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** Readonly.pm	18 Feb 2004 05:25:27 -0000	1.9
--- Readonly.pm	5 Dec 2004 18:50:10 -0000	1.10
***************
*** 4,8 ****
--- 4,10 ----

  use strict;
+ use base qw( Class::Accessor );
  use File::Basename           qw( basename );
+ use File::Spec::Functions    qw( catfile rel2abs );
  use Log::Log4perl            qw( get_logger );
  use OpenInteract2::Constants qw( :log );
***************
*** 13,16 ****
--- 15,20 ----
  $OpenInteract2::Config::Readonly::VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);

+ __PACKAGE__->mk_accessors( 'directory' );
+ 
  my ( $log );

***************
*** 20,60 ****
  my $READONLY_FILE = '.no_overwrite';

! sub is_writeable_file {
!     my ( $class, $readonly, $filename ) = @_;
!     return undef unless ( $filename );
!     my $writeable = $class->get_writeable_files( $readonly, [ $filename ] );
!     return ( defined $writeable->[0] && $filename eq $writeable->[0] );
  }

- sub get_writeable_files {
-     my ( $class, $readonly, $to_check ) = @_;

!     # If $readonly is a scalar treat as a directory name
!     unless ( ref $readonly ) {
!         $readonly = $class->read_config( $readonly );
!     }

!     # If $to_check isn't valid then we're saying nothing is writeable
!     unless ( ref $to_check eq 'ARRAY' and scalar @{ $to_check } ) {
!         return [];
      }

!     # Only return files not in the readonly hash
!     my %ro = map { $_ => 1 } @{ $readonly };
!     return [ grep { ! $ro{ basename( $_ ) } } @{ $to_check } ];
! }
! 
! # Read in the file that tells us what files in $dir should not be
! # overwritten

! sub read_config {
!     my ( $class, $dir ) = @_;
!     $log ||= get_logger( LOG_CONFIG );
!     my $overwrite_check_file = $class->_create_readonly_file( $dir );
      return [] unless ( -f $overwrite_check_file );
!     my ( @no_write );
      eval { open( NOWRITE, '<', $overwrite_check_file ) || die $! };
      if ( $@ ) {
!         $log->error( "Cannot read readonly file [$overwrite_check_file]: $@" );
          return [];
      }
--- 24,63 ----
  my $READONLY_FILE = '.no_overwrite';

! sub new {
!     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;
  }

! sub is_writeable {
!     my ( $self, $filename ) = @_;
!     return 0 unless ( $filename );
!     return 0 if ( $self->{readonly_files}{ basename( $filename ) } );
!     return 1;
! }

! 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...
      return [] unless ( -f $overwrite_check_file );
! 
!     my ( @readonly );
      eval { open( NOWRITE, '<', $overwrite_check_file ) || die $! };
      if ( $@ ) {
!         $log->error( "Cannot read readonly file '$overwrite_check_file': $@" );
          return [];
      }
***************
*** 65,93 ****
          s/^\s+//;
          s/\s+$//;
!         push @no_write, $_;
      }
      close( NOWRITE );
!     return \@no_write;
  }

! sub write_config {
!     my ( $class, $dir, $to_write ) = @_;
!     my ( $comment, $files );
!     if ( ref $to_write eq 'HASH' ) {
!         $comment = $to_write->{comment};
!         $files   = $to_write->{file};
!     }
!     elsif ( ref $to_write eq 'ARRAY' ) {
!         $comment = undef;
!         $files   = $to_write;
!     }
      unless ( ref $files eq 'ARRAY' and scalar @{ $files } ) {
          return undef;
      }
!     my $overwrite_check_file = $class->_create_readonly_file( $dir );
      eval { open( NOWRITE, '>', $overwrite_check_file ) || die $! };
      if ( $@ ) {
!         oi_error "Failed to create file [$overwrite_check_file]: $@";
      }
      if ( $comment ) {
--- 68,97 ----
          s/^\s+//;
          s/\s+$//;
!         push @readonly, $_;
      }
      close( NOWRITE );
!     $self->{readonly_files} = { map { $_ => 1 } @readonly };
!     return \@readonly;
  }

+ sub get_all_writeable_files {
+     my ( $self ) = @_;
+     my $dir = $self->directory;
+     opendir( DIR, $dir )
+         || die sprintf( "Cannot read from '%s': %s", $dir, $! );
+     my @files = grep { $_ ne $READONLY_FILE } grep { -f "$dir/$_" } readdir( DIR );
+     closedir( DIR );
+     return [ grep { $self->is_writeable( $_ ) } @files ];
+ }

! sub write_readonly_files {
!     my ( $self, $files, $comment ) = @_;
      unless ( ref $files eq 'ARRAY' and scalar @{ $files } ) {
          return undef;
      }
!     my $overwrite_check_file = $self->_create_readonly_file();
      eval { open( NOWRITE, '>', $overwrite_check_file ) || die $! };
      if ( $@ ) {
!         oi_error "Failed to create file '$overwrite_check_file': $@";
      }
      if ( $comment ) {
***************
*** 99,109 ****
      close( NOWRITE );
      return $overwrite_check_file;
- }

  sub _create_readonly_file {
      my ( $class, $dir ) = @_;
!     return File::Spec->catfile( File::Spec->rel2abs( $dir ),
!                                 $READONLY_FILE );
  }

--- 103,151 ----
      close( NOWRITE );
      return $overwrite_check_file;

+ }

  sub _create_readonly_file {
+     my ( $self ) = @_;
+     return catfile( rel2abs( $self->directory ), $READONLY_FILE );
+ }
+ 
+ 
+ # Old class methods (is anyone using these?)
+ 
+ sub is_writeable_file {
+     my ( $class, $readonly, $filename ) = @_;
+     deprecated( 'is_writeable_file', 'is_writeable' );
+     return $class->new( $readonly )->is_writeable( $filename );
+ }
+ 
+ sub get_writeable_files {
+     my ( $class, $readonly, $to_check ) = @_;
+     deprecated( 'get_writeable_files', 'get_all_writeable_files' );
+     return $class->new( $readonly )->get_all_writeable_files();
+ }
+ 
+ 
+ sub read_config {
      my ( $class, $dir ) = @_;
!     deprecated( 'read_config', 'get_readonly_files' );
!     return $class->new( $dir )->get_readonly_files();
! }
! 
! sub write_config {
!     my ( $class, $dir, $to_write ) = @_;
!     deprecated( 'write_config', 'write_readonly_files' );
!     return $class->new( $dir )
!                  ->write_readonly_files( $to_write->{file},
!                                          $to_write->{comment} );
! }
! 
! sub deprecated {
!     my ( $old_method, $new_method ) = @_;
!     my @caller_info = caller(2);
!     my $location = join( ': ', $caller_info[1], $caller_info[2] );
!     warn "Class methods in OpenInteract2::Config::Readonly are deprecated; ",
!          "please replace your call of '$old_method' with the object ",
!          "constructor and method call to '$new_method' at '$location'\n";
  }

***************
*** 123,135 ****

   my @files_to_write = ( 'blah.html', 'bleh.txt' );
!  my $files_writeable = OpenInteract2::Config::Readonly
!                          ->get_writeable_files( $dir, \@files_to_write );
!  
!  # Same thing, but read the nonwriteable files first
!  
!  my $readonly_files = OpenInteract2::Config::Readonly->read_config( $dir );
!  my @files_to_write = ( 'blah.html', 'bleh.txt' );
!  my $files_writeable = OpenInteract2::Config::Readonly
!                          ->get_writeable_files( $readonly_files, \@files_to_write );

   # See if a single file is writeable
--- 165,172 ----

   my @files_to_write = ( 'blah.html', 'bleh.txt' );
!  my $read_only = OpenInteract2::Config::Readonly->new( $dir );
!  foreach my $file ( @files_to_write ) {
!      print "Writeable? ", $read_only->is_writeable( $file );
!  }

   # See if a single file is writeable
***************
*** 137,141 ****
   my $original_path = '/path/to/distribution/foo.html';
   my $can_write = OpenInteract2::Config::Readonly
!                          ->is_file_writeable( $dir, $original_path );
   if ( $can_write ) {
       cp( $original_path,
--- 174,179 ----
   my $original_path = '/path/to/distribution/foo.html';
   my $can_write = OpenInteract2::Config::Readonly
!     ->new( $dir )
!     ->is_writeable( $original_path );
   if ( $can_write ) {
       cp( $original_path,
***************
*** 143,157 ****
   }

!  # Write a set of readonly files with a comment...

!  OpenInteract2::Config::Readonly->write_config(
!                          $dir,
!                          { file    => [ 'file1', 'file2' ],
!                            comment => 'OI will not overwrite these files' } );

!  # ... or without
!  OpenInteract2::Config::Readonly->write_config(
!                          $dir,
!                          [ 'file1', 'file2' ] );

  =head1 DESCRIPTION
--- 181,197 ----
   }

! 
!  # Write a set of readonly files...

!  OpenInteract2::Config::Readonly
!      ->new( $dir )
!      ->write_config( [ 'file1', 'file2' ] );

!  # Write a set of readonly files with a comment...
!  
!  OpenInteract2::Config::Readonly
!      ->new( $dir )
!      ->write_config( [ 'file1', 'file2' ],
!                      'OI will not overwrite these files' );

  =head1 DESCRIPTION
***************
*** 166,169 ****
--- 206,234 ----
  L<File::Basename|File::Basename> C<basename> call.

+ B<new( $directory )>
+ 
+ Constructor. Throws exception if C<$directory> is invalid.
+ 
+ B<get_readonly_files()>
+ 
+ Returns: arrayref of readonly files in the configured directory.
+ 
+ B<is_writeable( $file )>
+ 
+ Returns: true if C<$file> is writeable in the configured directory,
+ false if not.
+ 
+ B<get_all_writeable_files()>
+ 
+ Returns: arrayref of all writeable files in the configured directory.
+ 
+ B<write_readonly_files( \@files, [ $comment ] )>
+ 
+ Write a new readonly configuration file (typically C<.no_overwrite>)
+ to the configured directory. All filenames in C<\@files> will be
+ written to the file, as with the C<$comment> if given.
+ 
+ Returns: full path to file written.
+ 
  B<is_writeable_file( \@readonly_filenames | $directory, $filename )>

***************
*** 260,262 ****
  =head1 AUTHORS

! Chris Winters E<lt>ch...@cw...E<gt>
\ No newline at end of file
--- 325,327 ----
  =head1 AUTHORS

! Chris Winters E<lt>ch...@cw...E<gt>

Index: TransferSample.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract2/lib/OpenInteract2/Config/TransferSample.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** TransferSample.pm	18 Feb 2004 05:25:27 -0000	1.8
--- TransferSample.pm	5 Dec 2004 18:50:10 -0000	1.9
***************
*** 4,8 ****
  use base qw( Class::Accessor::Fast );
  use File::Copy               qw( cp );
! use File::Spec;
  use OpenInteract2::Constants qw( :log );
  use OpenInteract2::Context   qw( CTX );
--- 4,9 ----
  use base qw( Class::Accessor::Fast );
  use File::Copy               qw( cp );
! use File::Spec::Functions    qw( catfile rel2abs );
! use Log::Log4perl            qw( get_logger );
  use OpenInteract2::Constants qw( :log );
  use OpenInteract2::Context   qw( CTX );
***************
*** 15,22 ****
  __PACKAGE__->mk_accessors( @FIELDS );

  sub new {
      my ( $class, $source_dir ) = @_;
      my $self = bless( {}, $class );
!     $source_dir = File::Spec->rel2abs( $source_dir );
      unless ( -d $source_dir ) {
          oi_error "Given source directory [$source_dir] is invalid";
--- 16,26 ----
  __PACKAGE__->mk_accessors( @FIELDS );

+ my ( $log );
+ 
  sub new {
      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";
***************
*** 24,27 ****
--- 28,33 ----
      $self->source_dir( $source_dir );
      $self->{_template} = Template->new( ABSOLUTE => 1 );
+     $log->is_info &&
+         $log->info( "Created new transfer object given source '$source_dir'" );
      return $self;
  }
***************
*** 35,39 ****
  sub read_file_spec {
      my ( $self, $template_vars ) = @_;
!     my $copy_list_file = File::Spec->catfile( $self->source_dir, 'FILES' );
      unless ( -f $copy_list_file ) {
          oi_error "File from which I read the file specifiecations ",
--- 41,45 ----
  sub read_file_spec {
      my ( $self, $template_vars ) = @_;
!     my $copy_list_file = catfile( $self->source_dir, 'FILES' );
      unless ( -f $copy_list_file ) {
          oi_error "File from which I read the file specifiecations ",
***************
*** 68,71 ****
--- 74,79 ----
      }

+     my $ro_check = OpenInteract2::Config::Readonly->new( $dest_dir );
+ 
      $template_vars ||= {};
      my @copied = ();
***************
*** 73,76 ****
--- 81,85 ----
          my $source_spec = $info->[0];
          my $dest_spec   = $info->[1];
+ 
          my ( $copy_only );
          if ( $source_spec->[-1] =~ /^\*/ ) {
***************
*** 78,85 ****
              $source_spec->[-1] =~ s/^\*//;
          }
!         my $full_source_file = File::Spec->catfile( $self->source_dir,
!                                                     @{ $source_spec } );
!         my $full_dest_file   = File::Spec->catfile( $dest_dir,
!                                                     @{ $dest_spec } );

          # NOTE: You shouldn't assume because ( ! keys %{ $template_vars } )
--- 87,101 ----
              $source_spec->[-1] =~ s/^\*//;
          }
! 
!         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 } )
***************
*** 91,94 ****
--- 107,113 ----
                      || oi_error "Cannot copy [$full_source_file] -> ",
                                  "[$full_dest_file]: $!";
+             $log->is_info &&
+                 $log->info( "Copied w/o processing '$full_source_file' ",
+                             "-> '$full_dest_file'" );
          }

***************
*** 98,101 ****
--- 117,123 ----
                                  "[$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;

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

openinteract-commits