Update of /cvsroot/openinteract/OpenInteract2/lib/OpenInteract2
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10472/lib/OpenInteract2
Modified Files:
Package.pm
Log Message:
modify OI2::Config::Readonly to be more usable (object instead of class methods); modify all usages, tests, etc.
Index: Package.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract2/lib/OpenInteract2/Package.pm,v
retrieving revision 1.39
retrieving revision 1.40
diff -C2 -d -r1.39 -r1.40
*** Package.pm 9 Jun 2004 01:10:51 -0000 1.39
--- Package.pm 5 Dec 2004 18:50:10 -0000 1.40
***************
*** 257,262 ****
}
my $dir = $self->directory;
! my @action_files = map { catfile( $dir, $_ ) }
! @{ $base_files };
$self->_check_file_validity( \@action_files );
return $base_files
--- 257,261 ----
}
my $dir = $self->directory;
! my @action_files = map { catfile( $dir, $_ ) } @{ $base_files };
$self->_check_file_validity( \@action_files );
return $base_files
***************
*** 268,273 ****
my @base_doc_files = grep { m|^doc| } @{ $files };
my $dir = $self->directory;
! my @check_files = map { catfile( $dir, $_ ) }
! @base_doc_files;
$self->_check_file_validity( \@check_files );
return \@base_doc_files;
--- 267,271 ----
my @base_doc_files = grep { m|^doc| } @{ $files };
my $dir = $self->directory;
! my @check_files = map { catfile( $dir, $_ ) } @base_doc_files;
$self->_check_file_validity( \@check_files );
return \@base_doc_files;
***************
*** 555,559 ****
return undef unless ( $full_file );
open( IN, '<', $full_file )
! || die "Cannot read '$full_file': $!";
my @content = <IN>;
close( IN );
--- 553,557 ----
return undef unless ( $full_file );
open( IN, '<', $full_file )
! || oi_error "Cannot read '$full_file': $!";
my @content = <IN>;
close( IN );
***************
*** 643,649 ****
my ( $class, $config, $repository ) = @_;
my $full_package_name = join( '-', $config->name, $config->version );
! my $full_package_dir = catfile(
! $repository->full_package_dir,
! $full_package_name );
if ( -d $full_package_dir ) {
oi_error "The directory into which the distribution should be ",
--- 641,646 ----
my ( $class, $config, $repository ) = @_;
my $full_package_name = join( '-', $config->name, $config->version );
! my $full_package_dir = catfile( $repository->full_package_dir,
! $full_package_name );
if ( -d $full_package_dir ) {
oi_error "The directory into which the distribution should be ",
***************
*** 690,693 ****
--- 687,692 ----
eval {
my $count = 0;
+ my %ro_by_dir = ();
+ BASE_FILE:
foreach my $from_base ( @{ $base_files } ) {
***************
*** 698,719 ****
my $to_base = $dest_files->[ $count ] || $from_base;
my $full_dest_path = catfile( $website_dir, $to_base );
$self->_create_full_path( $full_dest_path );
! # Yeah, this is slightly inefficient, but (a) it's much
! # simpler than the alternative, (2) there aren't many
! # times where packages have files to copy and (iii) you
! # don't install packages very often...
!
! my $can_copy = OpenInteract2::Config::Readonly
! ->is_writeable_file( dirname( $full_dest_path ),
! $full_dest_path );
! next unless ( $can_copy );
! my $full_source_path = catfile(
! $package_dir, $from_base );
! # Backup the file if it already exists
if ( -f $full_dest_path ) {
rename( $full_dest_path, "$full_dest_path.$BACKUP_EXT" )
|| die "Cannot backup '$full_dest_path': $!";
--- 697,722 ----
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': $!";
|
