[Openinteract-commits] CVS: OpenInteract2/lib/OpenInteract2 Brick.pm,1.1,1.2

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

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

Modified Files:
	Brick.pm 
Log Message:
OIN-121: add functionality to evaluate and copy brick resources to a directory


Index: Brick.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract2/lib/OpenInteract2/Brick.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Brick.pm	28 Jan 2005 16:47:44 -0000	1.1
--- Brick.pm	2 Feb 2005 13:16:26 -0000	1.2
***************
*** 5,17 ****
  use strict;
  use base qw( Class::Factory );
  use OpenInteract2::Exception qw( oi_error );
  use OpenInteract2::Util;
  
  $OpenInteract2::Brick::VERSION  = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
  
  sub list_resources {
      my ( $self ) = @_;
!     my $all_resources = $self->get_resources;
!     return sort @{ $all_resources };
  }
  
--- 5,27 ----
  use strict;
  use base qw( Class::Factory );
+ use File::Basename           qw( basename dirname );
+ use File::Spec::Functions    qw( catfile );
+ use Log::Log4perl            qw( get_logger );
+ use OpenInteract2::Config::Readonly;
+ use OpenInteract2::Constants qw( :log );
  use OpenInteract2::Exception qw( oi_error );
  use OpenInteract2::Util;
+ use Template;
  
  $OpenInteract2::Brick::VERSION  = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
  
+ my $TEMPLATE = Template->new();
+ 
+ my ( $log );
+ 
  sub list_resources {
      my ( $self ) = @_;
!     my %all_resources = $self->get_resources;
!     return sort keys %all_resources;
  }
  
***************
*** 21,32 ****
          oi_error "You must specify a resource name to load.";
      }
!     my $all_resources = $self->get_resources;
!     my $info = $all_resources->{ $name };
      unless ( $info ) {
          oi_error "Resource '$name' is invalid. Valid resources are: ",
!                  join( ', ', sort keys %{ $all_resources } );
      }
      $info->[1] ||= 'yes';
!     return { 
          content     => $self->load( $name ),
          destination => $info->[0],
--- 31,42 ----
          oi_error "You must specify a resource name to load.";
      }
!     my %all_resources = $self->get_resources;
!     my $info = $all_resources{ $name };
      unless ( $info ) {
          oi_error "Resource '$name' is invalid. Valid resources are: ",
!                  join( ', ', sort keys %all_resources );
      }
      $info->[1] ||= 'yes';
!     return {
          content     => $self->load( $name ),
          destination => $info->[0],
***************
*** 35,38 ****
--- 45,144 ----
  }
  
+ sub copy_all_resources_to {
+     my ( $self, $dest_dir, $template_vars ) = @_;
+     return $self->copy_resources_to(
+         $dest_dir, $template_vars, $self->list_resources
+     );
+ }
+ 
+ sub copy_resources_to {
+     my ( $self, $dest_dir, $template_vars, @resource_names ) = @_;
+     $log ||= get_logger( LOG_INIT );
+ 
+     $template_vars ||= {};
+ 
+     my @copied  = ();
+     my @skipped = ();
+     my @same    = ();
+ 
+ NAME:
+     foreach my $name ( @resource_names ) {
+         my $info           = $self->load_resource( $name );
+         my ( $final_dest_spec );
+         $TEMPLATE->process( \$info->{destination}, $template_vars, \$final_dest_spec )
+             || oi_error "Cannot process destination '$info->{destination}': ",
+                         $TEMPLATE->error();
+         $log->is_info && $log->info( "Translated '$info->{destination}' ",
+                                      "-> $final_dest_spec" );
+         my @dest_spec      = split( /\s+/, $final_dest_spec );
+         my $relative_dest  = join( '/', @dest_spec );
+         my $full_dest_file = catfile( $dest_dir, @dest_spec );
+ 
+         if ( $self->_is_readonly( $full_dest_file ) ) {
+             $log->is_info &&
+                 $log->info( "Skipping '$full_dest_file', marked ",
+                             "as readonly in the destination directory" );
+             push @skipped, $full_dest_file;
+             next NAME;
+         }
+ 
+         my $content = $info->{content};
+         unless ( 'no' eq lc $info->{evaluate} ) {
+             my ( $new_content );
+             $TEMPLATE->process( \$content, $template_vars, \$new_content )
+                 || oi_error "Cannot copy and replace tokens from resource ",
+                             $TEMPLATE->error();
+             $log->is_info && $log->info( "Processed template ok" );
+             $content = $new_content;
+         }
+ 
+         if ( $self->_is_same( $full_dest_file, $content ) ) {
+             $log->is_info &&
+                 $log->info( "Skipping '$full_dest_file', content and ",
+                             "destination file are the same" );
+             push @same, $full_dest_file;
+             next NAME;
+         }
+ 
+         open( OUT, '>', $full_dest_file )
+             || oi_error "Cannot write resource '$name' to '$full_dest_file': $!";
+         print OUT $content;
+         close( OUT );
+         $log->is_info &&
+             $log->info( "Copied resource '$name' to '$full_dest_file' ok" );
+         push @copied, $full_dest_file;
+     }
+     return {
+         copied  => \@copied,
+         skipped => \@skipped,
+         same    => \@same,
+     };
+ }
+ 
+ sub _is_readonly {
+     my ( $self, $dest_file ) = @_;
+     return 0 unless ( -f $dest_file );
+     my $base_dest_file = basename( $dest_file );
+     my $full_dest_dir  = dirname( $dest_file );
+     my $ro_check = OpenInteract2::Config::Readonly->new( $full_dest_dir );
+     return ( ! $ro_check->is_writeable( $base_dest_file ) );
+ }
+ 
+ sub _is_same {
+     my ( $self, $dest_file, $content ) = @_;
+     return 0 unless ( -f $dest_file );
+     my $source_size = length $content;
+     my $dest_file_size   = (stat $dest_file)[7];
+     return 0 unless ( $source_size == $dest_file_size );
+     my $source_digest =
+         OpenInteract2::Util->digest_content( $content );
+     my $dest_digest   =
+         OpenInteract2::Util->digest_file( $dest_file );
+     return ( $source_digest eq $dest_digest );
+ }
+ 
+ ########################################
+ # SUBCLASSES
+ 
  sub get_name      { _must_implement( 'get_name', @_ ) }
  sub get_resources { _must_implement( 'get_resources', @_ ) }
***************
*** 45,49 ****
  }
  
- 
  OpenInteract2::Util->find_factory_subclasses(
      'OpenInteract2::Brick', @INC
--- 151,154 ----
***************
*** 152,155 ****
--- 257,285 ----
   package OpenInteract2::Action::BaseballStats;
  
+ B<copy_all_resources_to( $destination_dir, [ \%token_replacements ] )>
+ 
+ Copies all resources from this brick to C<$destination_dir>. See
+ L<copy_resources_to()> for more.
+ 
+ Returns: hashref with keys 'copied', 'skipped', 'same' each of which
+ has as its value an arrayref of the relevant files.
+ 
+ B<copy_resources_to( $destination_dir, \%token_replacements, @resource_names )>
+ 
+ Copies the resources with C<@resource_names> to the given
+ C<$destination_dir>. For those resources that are evaluatable use the
+ C<\%token_replacements> when evaluating as Template Toolkit templates.
+ 
+ If the source and destination are the same -- checked by the content
+ size and MD5 digest -- we don't do a copy.
+ 
+ We also don't do a copy if the resource is specified in the
+ directory's has a '.no_overwrite' file. (See
+ L<OpenInteract2::Config::Readonly> for this file's format and how we
+ use it.)
+ 
+ Returns: hashref with keys 'copied', 'skipped', 'same' each of which
+ has as its value an arrayref of the relevant files.
+ 
  =head1 SUBCLASSING