view release on metacpan or  search on metacpan

lib/File/Util/Cookbook.pod  view on Meta::CPAN

   print ' Count is now: ' . $ftl->load_file( $counterfile );

   exit;

=head2 Batch Search & Replace

   # Code does a recursive batch search/replace on the content of all files
   # in a given directory
   #
   # Note - this code skips binary files

   use strict;
   use warnings;
   use File::Util qw( NL SL );

   # will get search pattern from file named below
   use constant SFILE => './sr/searchfor';

   # will get replace pattern from file named below
   use constant RFILE => './sr/replacewith';

   # will perform batch operation in directory named below
   use constant INDIR => '/foo/bar/baz';


   # create new File::Util object, set File::Util to send a warning for
   # fatal errors instead of dying
   my $ftl   = File::Util->new( onfail => 'warn' );
   my $rstr  = $ftl->load_file( RFILE );
   my $spat  = quotemeta $ftl->load_file( SFILE ); $spat = qr/$spat/;
   my $gsbt  = 0;
   my $opts  = { files_only => 1, with_paths => 1, recurse => 1 };
   my @files = $ftl->list_dir( INDIR => $opts );

   for (my $i = 0; $i < @files; ++$i) {

      next if $ftl->is_bin( $files[$i] );

      my $sbt = 0; my $file = $ftl->load_file( $files[$i] );

      $file =~ s/$spat/++$sbt;++$gsbt;$rstr/ge;

      $ftl->write_file( file => $files[$i], content => $file );

      print $sbt ? qq($sbt replacements in $files[$i]) . NL : '';
   }

   print NL . <<__DONE__ . NL;
   $gsbt replacements in ${\ scalar @files } files.
   __DONE__

   exit;

=head2 Pretty-Print A Directory Recursively

This is the fool-proof, dead-simple way to pretty-print a directory tree.
Caveat: This isn't a method for massive directory traversal, and is subject to
the limitations inherent in stuffing an entire directory tree into RAM.  Go
back and use bare callbacks (see the other example scripts that came in the
"examples" subdirectory of this distribution) if you need a more efficient,
streaming (real-time) pretty-printer where top-level sorting is less important
than resource constraints and speed of execution.

   # set this to the name of the directory to pretty-print
   my $treetrunk = '.';

   use warnings;
   use strict;

   use lib './lib';
   use File::Util qw( NL SL );

   my $ftl = File::Util->new( { onfail => 'zero' } );

   walk( $ftl->list_dir( $treetrunk => { as_tree => 1, recurse => 1 } ) );

   exit;

   sub walk
   {
      my ( $branch, $depth ) = @_;

      $depth ||= 0;

      talk( $depth - 1, $branch->{_DIR_SELF_} . SL ) if $branch->{_DIR_SELF_};

      delete @$branch{ qw( _DIR_SELF_  _DIR_PARENT_ ) };

      talk( $depth, $branch->{ $_ } ) for sort { uc $a cmp uc $b } keys %$branch;
   }

   sub talk
   {
      my ( $indent, $item ) = @_;

      return walk( $item, $indent + 1 ) if ref $item;

      print(  ( ' ' x ( $indent * 3 ) ) . ( $item || '' ) . NL );
   }

=head1 AUTHORS

Tommy Butler L<http://www.atrixnet.com/contact>

=head1 COPYRIGHT

Copyright(C) 2001-2013, Tommy Butler.  All rights reserved.

=head1 LICENSE

This library is free software, you may redistribute it and/or modify it
under the same terms as Perl itself. For more details, see the full text of
the LICENSE file that is included in this distribution.

=head1 LIMITATION OF WARRANTY

This software is distributed in the hope that it will be useful, but without
any warranty; without even the implied warranty of merchantability or fitness
for a particular purpose.

=head1 SEE ALSO