Hello List,
I am hoping for some help with this. I did post this same question to PerlMonks.
Undefined format "STDOUT" called at find_hog.tdy line 173.
Line 173 is the 1st write statement, but since there are snips in there 173 is
not the actual line in this email.
Just look for 1st write statement.
thank you. :)
#!/usr/bin/perl
use strict ;
use warnings ;
use File::Find ;
use File::Find::Closures qw(find_by_min_size) ;
$ENV{"PATH"} = qq(/usr/bin:/bin) ;
delete @ENV{qw (IFS CDPATH KSH_ENV)} ;
my ( $key, $keys, $user, $grp, $gcos, $mod, $mod2, $sz, ) ;
my ( @sorted_large_files, @sorted_root_files, );
<snip>
sub dateme {
##-- $mod is for modification time from file(s) --##
my $mod = shift @_ ;
my ($seconds, $minutes, $hours, $day_of_month, $month,
$year, undef, undef, undef
) = localtime( $mod ) ;
##-- $mod2 is like $mod, but does more, allows user to see mod time from
sprintf --##
my $mod2 = sprintf(
"%02d:%02d:%02d-%02d/%02d/%02d",
( $hours, $minutes, $seconds, $month + 1,
$day_of_month, ( $year % 100 )
)
) ;
}
<snip>
##-- Begin Main --##
#===================#
print qq(\n) ;
my $fs = $ARGV[0] ;
my $size = ( $ARGV[1] * 1024 * 1024 ) ;
$fs =~ tr /\000//d ; ##-- Clean user input --##
$size =~ tr /\000//d ;
die qq ( \nPlease enter filesystem followed by minimum file size to search.
Usage example: find_hog /var 25 will look in /var for files >= 25Mb\n\n ),
unless ( $fs and $size ) ;
my ( @root_files, @large_files, ) ;
if ( $fs eq "/" ) { ## only if the root directory
<snip>
}
elsif ( $fs =~ m|^/\w+|i ) { ## matches /var
find_me( $fs, $size, 0 ) ;
}
elsif ( $fs =~ m|^[/.\w+]|i ) { ## matches /.ssh
find_me( $fs, $size, 0 ) ;
}
sub find_me {
my $fs = shift @_ ;
my $size = shift @_ ;
my ( $wanted, $list ) = find_by_min_size( $size ) ;
File::Find::find( { wanted => $wanted, no_chdir => +shift }, $fs ) ;
@large_files = $list->() ;
} ##-- End sub --##
##-- Gather meta-data --##
#=========================#
use constant DIVISOR => ( 1024 ) ;
use constant LINES_PER_PAGE => ( 44 ) ;
if ( @large_files ) {
my %meta ;
for my $file ( @large_files ) {
$meta{$file} = {
'uid' => ( stat( $file ) )[4],
'gid' => ( stat( $file ) )[5],
'sz' => ( stat( $file ) )[7],
'mod' => ( stat( $file ) )[9],
} ;
} ##-- End For --##
for $key ( keys %meta ) {
$user = qq(N/A)
unless $user = (getpwuid ( $meta{$key}->{'uid'} ) )[0] ; ##-- uid
name --##
$grp = qq(N/A)
unless $grp = (getgrgid ( $meta{$key}->{'gid'} ) )[0] ; ##-- gid
name --##
$gcos = qq(N/A)
unless $gcos = (getpwuid ( $meta{$key}->{'uid'} ) )[6] ; ##-- gcos
--##
$mod = qq(N/A)
unless $mod = $meta{$key}{'mod'} ;
$sz = qq(N/A)
unless $sz = $meta{$key}{'sz'} / DIVISOR / DIVISOR ;
my $ofh = select( STDOUT ) ;
$= = LINES_PER_PAGE ;
select( $ofh ) ;
write ; ## THIS IS WHERE THE ERROR IS ##
$ofh = select( LOG ) ;
$= = LINES_PER_PAGE ;
select( $ofh ) ;
write( $ofh ) ;
} ##-- End For --##
##-- Sort values according to sz --##
@sorted_large_files =
sort { $meta{$b}->{'sz'} <=> $meta{$a}->{'sz'} } keys %meta;
} ##-- End @large_files if --##
<snip>
##-- Begin Format Code --##
#==========================#
$^L = q{};
format STDOUT_TOP =
REPORT OF LARGE FILES on:
@<<<<<<<<<<
qx(hostname)
Page @<<<
$%
FileName
Owner GroupOwner Gecos LastModifiedDate Size Mb
=========================
======= =========== ====== ================= =======
.
format STDOUT =
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
@<<<<<<< @<<<<<< @<<<<<<<<<<<<<<<<<<<<<<< @||||||||||||| @##.##
@sorted_large_files,
dateme($mod,$mod2)
.
<snip>
##-- End Format Code --##
#========================#
else {
warn "\nNo file(s) over $size Mb found in $fs\n" ;
exit 0 ;
}
#print "\n";
#print join("\n",@sorted_large_files);
#print join("\n",@sorted_root_files);
END {
close( LOG ) or warn "Log '$log' failed to close $!" ;
}
____________________________________________________________________________________
Be a better friend, newshound, and
know-it-all with Yahoo! Mobile. Try it now.
http://mobile.yahoo.com/;_ylt=Ahu06i62sR8HDtDypao8Wcj9tAcJ
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
