.\" Automatically generated by Pod::Man 4.14 (Pod::Simple 3.43) .\" .\" Standard preamble: .\" ======================================================================== .de Sp \" Vertical space (when we can't use .PP) .if t .sp .5v .if n .sp .. .de Vb \" Begin verbatim text .ft CW .nf .ne \\$1 .. .de Ve \" End verbatim text .ft R .fi .. .\" Set up some character translations and predefined strings. \*(-- will .\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left .\" double quote, and \*(R" will give a right double quote. \*(C+ will .\" give a nicer C++. Capital omega is used to do unbreakable dashes and .\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, .\" nothing in troff, for use with C<>. .tr \(*W- .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' .ie n \{\ . ds -- \(*W- . ds PI pi . if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch . if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch . ds L" "" . ds R" "" . ds C` "" . ds C' "" 'br\} .el\{\ . ds -- \|\(em\| . ds PI \(*p . ds L" `` . ds R" '' . ds C` . ds C' 'br\} .\" .\" Escape single quotes in literal strings from groff's Unicode transform. .ie \n(.g .ds Aq \(aq .el .ds Aq ' .\" .\" If the F register is >0, we'll generate index entries on stderr for .\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index .\" entries marked with X<> in POD. Of course, you'll have to process the .\" output yourself in some meaningful fashion. .\" .\" Avoid warning from groff about undefined register 'F'. .de IX .. .nr rF 0 .if \n(.g .if rF .nr rF 1 .if (\n(rF:(\n(.g==0)) \{\ . if \nF \{\ . de IX . tm Index:\\$1\t\\n%\t"\\$2" .. . if !\nF==2 \{\ . nr % 0 . nr F 2 . \} . \} .\} .rr rF .\" .\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). .\" Fear. Run. Save yourself. No user-serviceable parts. . \" fudge factors for nroff and troff .if n \{\ . ds #H 0 . ds #V .8m . ds #F .3m . ds #[ \f1 . ds #] \fP .\} .if t \{\ . ds #H ((1u-(\\\\n(.fu%2u))*.13m) . ds #V .6m . ds #F 0 . ds #[ \& . ds #] \& .\} . \" simple accents for nroff and troff .if n \{\ . ds ' \& . ds ` \& . ds ^ \& . ds , \& . ds ~ ~ . ds / .\} .if t \{\ . ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" . ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' . ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' . ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' . ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' . ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' .\} . \" troff and (daisy-wheel) nroff accents .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' .ds 8 \h'\*(#H'\(*b\h'-\*(#H' .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] .ds ae a\h'-(\w'a'u*4/10)'e .ds Ae A\h'-(\w'A'u*4/10)'E . \" corrections for vroff .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' . \" for low resolution devices (crt and lpr) .if \n(.H>23 .if \n(.V>19 \ \{\ . ds : e . ds 8 ss . ds o a . ds d- d\h'-1'\(ga . ds D- D\h'-1'\(hy . ds th \o'bp' . ds Th \o'LP' . ds ae ae . ds Ae AE .\} .rm #[ #] #H #V #F C .\" ======================================================================== .\" .IX Title "File::Util::Cookbook 3pm" .TH File::Util::Cookbook 3pm "2022-11-29" "perl v5.36.0" "User Contributed Perl Documentation" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l .nh .SH "NAME" File::Util::Cookbook \- File::Util in Action .SH "VERSION" .IX Header "VERSION" version 4.201720 .SH "INTRODUCTION" .IX Header "INTRODUCTION" The following are fully functional programs using File::Util to accomplish some common tasks. Note that not nearly everything helpful use of File::Util could be covered here, but the following are examples showing answers to the questions commonly asked. .PP For a simple reference on File::Util, take a look at the manual at File::Util::Manual. .SH "EXAMPLES" .IX Header "EXAMPLES" These are included in the standalone scripts that come in the \&\*(L"examples\*(R" directory as part of this distribution. .SS "Batch File Rename" .IX Subsection "Batch File Rename" .Vb 4 \& # 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 "\e" 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 = \*(Aqsome/log/directory\*(Aq; \& my @files = $ftl\->list_dir( $dir => { files_only => 1 } ); \& \& foreach my $file ( @files ) { \& \& # don\*(Aqt change the file suffix unless it is *.log \& next unless $file =~ /log$/; \& \& my $newname = $file; \& $newname =~ s/\e.log$/\e.txt/; \& \& if ( rename $dir . SL . $file, $dir . SL . $newname ) { \& \& print qq($file \-> $newname), NL \& } \& else { \& \& warn qq(Couldn\*(Aqt rename "$_" to "$newname" \- $!) \& } \& } \& \& exit; .Ve .SS "Recursively remove a directory and all its contents" .IX Subsection "Recursively remove a directory and all its contents" .Vb 1 \& # 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 = \*(Aq/path/to/directory/youwanttodelete\*(Aq; \& \& my @gonners = $ftl\->list_dir( $removedir => { recurse => 1 } ); \& \& # remove directory and everything in it \& @gonners = 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 \*(AqDone!\*(Aq, NL; \& \& exit; .Ve .SS "Try opening a file, falling back to a failsafe file if there's an error" .IX Subsection "Try opening a file, falling back to a failsafe file if there's an error" .Vb 2 \& use strict; \& use warnings; \& \& use File::Util qw( NL ); \& \& my $ftl = File::Util\->new(); \& \& my $might_not_work = \*(Aq/this/might/not/work.txt\*(Aq; \& my $will_work_for_sure = \*(Aq/tmp/file.txt\*(Aq; \& my $used_backup_plan = 0; \& \& my $file_handle = $ftl\->open_handle \& ( \& $might_not_work => \& { \& mode => \*(Aqwrite\*(Aq, \& onfail => sub \& { \& my ( $err, $stack_trace ) = @_; \& \& warn "Couldn\*(Aqt open first choice, trying a backup plan..."; \& \& $used_backup_plan = 1; \& \& return $ftl\->open_handle \& ( \& $will_work_for_sure => { mode => \*(Aqwrite\*(Aq } \& ); \& }, \& } \& ); \& \& print $file_handle \*(AqHello World! The time is now \*(Aq . 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; .Ve .SS "Wrap the lines in a file at 72 columns, then save it" .IX Subsection "Wrap the lines in a file at 72 columns, then save it" .Vb 2 \& # 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 = \*(Aqmyreport.txt\*(Aq; # file to wrap and save \& \& $f\->write_file( \& filename => $textfile, \& content => wrap(\*(Aq\*(Aq, \*(Aq\*(Aq, $f\->load_file($textfile)) \& ); \& \& print \*(AqDone.\*(Aq, NL x 2; .Ve .SS "Read and increment a counter file, then save it" .IX Subsection "Read and increment a counter file, then save it" .Vb 2 \& # 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 = \*(Aqcounter.txt\*(Aq; # 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 \*(Aq Count is now: \*(Aq . $ftl\->load_file( $counterfile ); \& \& exit; .Ve .SS "Batch Search & Replace" .IX Subsection "Batch Search & Replace" .Vb 4 \& # 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 => \*(Aq./sr/searchfor\*(Aq; \& \& # will get replace pattern from file named below \& use constant RFILE => \*(Aq./sr/replacewith\*(Aq; \& \& # will perform batch operation in directory named below \& use constant INDIR => \*(Aq/foo/bar/baz\*(Aq; \& \& \& # create new File::Util object, set File::Util to send a warning for \& # fatal errors instead of dying \& my $ftl = File::Util\->new( onfail => \*(Aqwarn\*(Aq ); \& 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 : \*(Aq\*(Aq; \& } \& \& print NL . <<_\|_DONE_\|_ . NL; \& $gsbt replacements in ${\e scalar @files } files. \& _\|_DONE_\|_ \& \& exit; .Ve .SS "Pretty-Print A Directory Recursively" .IX Subsection "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 \s-1RAM.\s0 Go back and use bare callbacks (see the other example scripts that came in the \&\*(L"examples\*(R" 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. .PP .Vb 2 \& # set this to the name of the directory to pretty\-print \& my $treetrunk = \*(Aq.\*(Aq; \& \& use warnings; \& use strict; \& \& use lib \*(Aq./lib\*(Aq; \& use File::Util qw( NL SL ); \& \& my $ftl = File::Util\->new( { onfail => \*(Aqzero\*(Aq } ); \& \& 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( ( \*(Aq \*(Aq x ( $indent * 3 ) ) . ( $item || \*(Aq\*(Aq ) . NL ); \& } .Ve .SH "AUTHORS" .IX Header "AUTHORS" Tommy Butler .SH "COPYRIGHT" .IX Header "COPYRIGHT" Copyright(C) 2001\-2013, Tommy Butler. All rights reserved. .SH "LICENSE" .IX Header "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 \s-1LICENSE\s0 file that is included in this distribution. .SH "LIMITATION OF WARRANTY" .IX Header "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. .SH "SEE ALSO" .IX Header "SEE ALSO" File::Util::Cookbook