File::...okbook(3pm)

🦋 NAME 🦋

okay bestie, so this is File::Util::Cookbook — literally File::Util in Action 💅 it's giving "here's how you actually do the thing".

---

✨ VERSION ✨

version 4.201720 — yes she has a version, she's that girl 🎀

---

🌸 INTRODUCTION 🌸

So like, everything below is a fully functional program using File::Util to do some common tasks. Not me being humble but fr fr, not nearly everything helpful you could do with File::Util is covered here — these are just the answers to the questions people keep asking. The greatest hits, if you will 💖

If you want a plain-and-simple reference on File::Util, go peek at the manual at File::Util::Manual. iykyk 🫶

---

🔥 EXAMPLES 🔥

These all come included as standalone scripts in the examples directory that ships with this distribution. Slay.

🎀 Batch File Rename

# This code changes the file suffix of all files in a directory
# ending in *.log so that they end in *.txt
#
# Note - This example is NOT recursive.

use strict;
use warnings;
use vars qw( $dir );

# Regarding "SL" below: On Win/DOS, it is "\" and on Mac/BSD/Linux it is "/"
# File::Util will automatically detect this for you.
use File::Util qw( NL SL );

my $ftl   = File::Util->new();
my $dir   = 'some/log/directory';
my @files = $ftl->list_dir( $dir => { files_only => 1 } );

foreach my $file ( @files ) {

   # don't change the file suffix unless it is *.log
   next unless $file =~ /log$/;

   my $newname = $file;
      $newname =~ s/\.log$/\.txt/;

   if ( rename $dir . SL . $file, $dir . SL . $newname ) {

      print qq($file -> $newname), NL
   }
   else {

      warn qq(Couldn't rename "$_" to "$newname" - $!)
   }
}

exit;

Heads up bestie: this one is NOT recursive. She said what she said 🙈

---

🦋 Recursively remove a directory and all its contents

# This code removes a directory and everything in it

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

my $ftl = File::Util->new();
my $removedir = '/path/to/directory/youwanttodelete';

my @gonners = $ftl->list_dir( $removedir => { recurse => 1 } );

# remove directory and everything in it
@gонners = reverse sort { length $a <=> length $b } @gonners;

foreach my $gonner ( @gonners, $removedir ) {

   print "Removing $gonner ...", NL;

   -d $gonner ? rmdir $gonner || die $! : unlink $gonner || die $!;
 }

print 'Done!', NL;

exit;

💀 okay so please double-check $removedir before you run this, because it deletes the directory and everything inside it. No cap. There is no undo. The gonners are gone. 😭

---

🌈 Try opening a file, falling back to a failsafe file if there's an error

use strict;
use warnings;

use File::Util qw( NL );

my $ftl = File::Util->new();

my $might_not_work     = '/this/might/not/work.txt';
my $will_work_for_sure = '/tmp/file.txt';
my $used_backup_plan   = 0;

my $file_handle = $ftl->open_handle
(
   $might_not_work =>
   {
      mode   => 'write',
      onfail => sub
      {
         my ( $err, $stack_trace ) = @_;

         warn "Couldn't open first choice, trying a backup plan...";

         $used_backup_plan = 1;

         return $ftl->open_handle
         (
            $will_work_for_sure => { mode => 'write' }
         );
      },
   }
);

print $file_handle 'Hello World!  The time is now ' . scalar localtime;

print $file_handle NL; # portably add a new line to the end of the file

close $file_handle or die $!;

# print out whichever file we were able to successfully write
print $ftl->load_file
(
   $used_backup_plan
      ? $will_work_for_sure
      : $might_not_work
);

exit;

This is main character energy honestly — if plan A flops, plan B is right there waiting, no drama 💅

---

⭐ Wrap the lines in a file at 72 columns, then save it

# This code opens a file, wraps its lines, and saves the file with
# the newly formatted content

use strict; # always
use warnings;

use File::Util qw( NL );
use Text::Wrap qw( wrap );

$Text::Wrap::columns = 72; # wrap text at this many columns

my $f = File::Util->new();
my $textfile = 'myreport.txt'; # file to wrap and save

$f->write_file(
  filename => $textfile,
  content => wrap('', '', $f->load_file($textfile))
);

print 'Done.', NL x 2;

72 columns and cute, periodt ✨

---

💖 Read and increment a counter file, then save it

# This code opens a file, reads a number value, increments it,
# then saves the newly incremented value back to the file

# For the sake of simplicity, this code assumes:
#   * the counter file already exist and is writeable
#   * the counter file has one line, which contains only numbers

use strict; # always
use warnings;

use File::Util;

my $ftl = File::Util->new();
my $counterfile = 'counter.txt'; # the counter file needs to already exist

my $count = $ftl->load_file( $counterfile );

# convert textual number to in-memory int type, -this will default
# to a zero if it encounters non-numerical or empty content
chomp $count;
$count = int $count;

print "Count value from file: $count.";

$count++; # increment the counter value by 1

# save the incremented count back to the counter file
$ftl->write_file( filename => $counterfile, content => $count );

# verify that it worked
print ' Count is now: ' . $ftl->load_file( $counterfile );

exit;

the assumptions here are literally in the comments: the counter file already exists, it's writeable, it has one line, and that line contains only numbers. Don't come for her if you break the rules 🙈

---

👑 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;

bestie, this one skips binary files — that's the whole point of the is_bin line. Also note that onfail => 'warn' makes fatal errors warn instead of dying. 🫶

---

🧚 Pretty-Print A Directory Recursively

This is the fool-proof, dead-simple way to pretty-print a directory tree. 💖

Caveat, bestie: this isn't a method for massive directory traversal, and it's 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. She's honest about her limits, that's growth 🌱

# 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 );
}

---

🫶 AUTHORS 🫶

Tommy Butler <http://www.atrixnet.com/contact> — king behavior honestly 👑

---

💜 COPYRIGHT 💜

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

---

🌈 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. 💅

---

💀 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.

fr fr, no warranty. She said what she said. 🫠

---

⭐ SEE ALSO ⭐

• File::Util::Cookbook

---

that's a wrap bestie 🎀 this was File::...okbook(3pm) from the User Contributed Perl Documentation, perl v5.36.0, dated 2022-11-29 — go forth and cook, you ate 💖✨