1#!/usr/bin/env perl 2# 3########################################################################## 4# @(#) App::PFM::File 0.50 5# 6# Name: App::PFM::File 7# Version: 0.50 8# Author: Rene Uittenbogaard 9# Created: 1999-03-14 10# Date: 2011-10-14 11# 12 13########################################################################## 14 15=pod 16 17=head1 NAME 18 19App::PFM::File 20 21=head1 DESCRIPTION 22 23PFM File class, containing the bookkeeping for each file in the directory. 24 25=head1 METHODS 26 27=over 28 29=cut 30 31########################################################################## 32# declarations 33 34package App::PFM::File; 35 36use base 'App::PFM::Abstract'; 37 38use App::PFM::Util qw(:all); 39use POSIX qw(getcwd); 40 41use strict; 42use locale; 43 44use constant MAJORMINORTEMPLATE => '%d,%d'; 45use constant LOSTMSG => ''; # was ' (lost)' 46 47our ($_pfm); 48 49########################################################################## 50# private subs 51 52=item I<< _init(hashref { parent => string $parent_dir, entry => string >> 53I<< $filename, white => char $iswhite, mark => char $marked_flag } ) >> 54 55Initializes new instances. Called from the constructor. 56If I<entry> is defined, the method stat_entry() is called automatically. 57 58=cut 59 60sub _init { 61 my ($self, $opt) = @_; 62 if (defined $opt->{parent}) { 63 $self->{_parent} = $opt->{parent}; 64 } 65 if (defined $opt->{entry}) { 66 if ($opt->{skip_stat}) { 67 $self->dummy_entry($opt->{entry}, $opt->{mark}); 68 } else { 69 $self->stat_entry($opt->{entry}, $opt->{white}, $opt->{mark}); 70 } 71 } 72 return; 73} 74 75=item I<_decidecolor()> 76 77Decides which color should be used on a particular file. 78 79=cut 80 81sub _decidecolor { 82 my ($self) = @_; 83 my %dircolors = %{$_pfm->config->{dircolors}{$_pfm->screen->color_mode}}; 84 # by file type 85 $self->{type} eq 'w' and return $dircolors{wh}; 86 $self->{nlink} == 0 and return $dircolors{lo}; 87 # by permissions 88 $self->{mode} =~ /^d.......w[tT]/o and return $dircolors{tw}; 89 $self->{mode} =~ /^d........[tT]/o and return $dircolors{st}; 90 $self->{mode} =~ /^d.......w./o and return $dircolors{ow}; 91 $self->{mode} =~ /^-..s/o and return $dircolors{su}; 92 $self->{mode} =~ /^-.....s/o and return $dircolors{sg}; 93 # by file type 94 $self->{type} eq 'd' and return $dircolors{di}; 95 $self->{type} eq 'l' and return $dircolors{ 96 isorphan($self->{name}) ?'or':'ln' }; 97 $self->{type} eq 'b' and return $dircolors{bd}; 98 $self->{type} eq 'c' and return $dircolors{cd}; 99 $self->{type} eq 'p' and return $dircolors{pi}; 100 $self->{type} eq 's' and return $dircolors{so}; 101 $self->{type} eq 'D' and return $dircolors{'do'}; 102 $self->{type} eq 'n' and return $dircolors{nt}; 103 $self->{type} eq 'P' and return $dircolors{ep}; 104 # by filename 105 exists 106 $dircolors{"'$self->{name}'"} and return $dircolors{ 107 "'$self->{name}'"}; 108 # by nr. of hard links 109 $self->{type} eq '-' && 110 $self->{nlink} > 1 && 111 defined $dircolors{hl} and return $dircolors{hl}; 112 # by permissions 113 $self->{mode} =~ /[xst]/o and return $dircolors{ex}; 114 # by extension 115 $self->{name} =~ /(\.\w+)$/o && 116 defined ($dircolors{$1}) and return $dircolors{$1}; 117 # regular file 118 $self->{type} eq '-' and return $dircolors{fi}; 119 return; 120} 121 122########################################################################## 123# constructor, getters and setters 124 125=item I<parent()> 126 127Getter for the path of the containing directory according to 128the bookkeeping of this file. 129 130=cut 131 132sub parent { 133 my ($self) = @_; 134 return $self->{_parent}; 135} 136 137########################################################################## 138# public subs 139 140=item I<makefile(string $path)> 141 142Creates a App::PFM::File object for the given path. 143 144This is a factory method; it should be called as follows: 145 146 $file = App::PFM::File->makefile('/home/ruittenb/.profile'); 147 148=cut 149 150sub makefile { 151 my ($self, $path) = @_; 152 my $file; 153 if ($path !~ m!^/!) { 154 $path = getcwd() . '/' . $path; 155 } 156 $file = $self->new({ 157 entry => basename($path), 158 parent => dirname($path), 159 }); 160 return $file; 161} 162 163=item I<mode2str(int $st_mode)> 164 165Converts a numeric I<st_mode> field (file type/permission bits) to a 166symbolic one (I<e.g.> C<drwxr-x--->). 167Uses I<App::PFM::OS::*::ifmt2str>() to determine the inode type. 168Uses I<App::PFM::OS::*::mode2str>() to determine the symbolic 169representation of permissions. 170 171=cut 172 173sub mode2str { 174 my ($self, $nummode) = @_; 175 my $strmode; 176 my $octmode = sprintf("%lo", $nummode); 177 $octmode =~ /(\d\d?)(\d)(\d)(\d)(\d)$/; 178 $strmode = $_pfm->os->ifmt2str($1) 179 . $_pfm->os->mode2str($2, $3, $4, $5); 180 return $strmode; 181} 182 183=item I<stamp2str(int $timestamp)> 184 185Formats a timestamp for printing. 186 187=cut 188 189sub stamp2str { 190 my ($self, $time) = @_; 191 $time ||= 0; 192 return lstrftime($_pfm->config->{timestampformat}, localtime $time); 193} 194 195=item I<dummy_entry(string $entry)> 196 197Initializes the current file information as a dummy entry. 198 199=cut 200 201sub dummy_entry { 202 my ($self, $entry, $marked_flag) = @_; 203 my ($ptr); 204 my $name = $entry; 205 $ptr = { 206 name => $name, 207 display => $name, 208 bytename => $entry, 209 uid => undef, 210 gid => undef, 211 user => '', 212 group => '', 213 mode_num => 0, 214 mode => '---------- ', 215 type => '-', 216 has_acl => '', 217 device => '', 218 inode => 0, 219 nlink => 0, 220 rdev => 0, 221 mark => $marked_flag, 222 atime => 0, 223 mtime => 0, 224 ctime => 0, 225 grand => '', 226 grand_power => ' ', 227 size => 0, 228 blocks => 0, 229 blksize => 0, 230 rcs => '-', 231 gap => '', 232 }; 233 @{$self}{keys %$ptr} = values %$ptr; 234 $self->format(); 235 return $self; 236} 237 238=item I<stat_entry(string $entry, char $iswhite, char $marked_flag)> 239 240Initializes the current file information by performing a stat() on it. 241 242The I<iswhite> argument indicates if the directory already has 243an idea if this file is a whiteout. Allowed values: 'w', '?', ''. 244 245The I<marked_flag> argument is used to have the caller specify whether 246the 'mark' field of the file info should be cleared (when reading 247a new directory) or kept intact (when re-statting). 248 249=cut 250 251sub stat_entry { 252 my ($self, $entry, $iswhite, $marked_flag) = @_; 253 my ($ptr, $name, $name_too_long, $target, @white_entries); 254 my %filetypeflags = %{$_pfm->config->{filetypeflags}}; 255 my ($device, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, 256 $atime, $mtime, $ctime, $blksize, $blocks) = 257 lstat "$self->{_parent}/$entry"; 258 259 if (!defined $mode) { 260 if ($iswhite eq '?') { 261 @white_entries = $_pfm->os->listwhite($self->{_parent}); 262 chop @white_entries; 263 } 264 if ($iswhite eq 'w' or grep { $_ eq $entry } @white_entries) { 265 $mode = oct(160000); 266 } 267 } 268 $name = $entry; 269 $ptr = { 270 name => $name, 271 bytename => $entry, 272 uid => $uid, 273 gid => $gid, 274 user => find_uid($uid), 275 group => find_gid($gid), 276 mode_num => sprintf('%lo', $mode), 277 mode => $self->mode2str($mode), 278 has_acl => $_pfm->os->hasacl("$self->{_parent}/$entry"), 279 device => $device, 280 inode => $inode, 281 nlink => $nlink, 282 rdev => $rdev, 283 mark => $marked_flag, 284 atime => $atime, 285 mtime => $mtime, 286 ctime => $ctime, 287 grand => '', 288 grand_power => ' ', 289 size => $size, 290 blocks => $blocks, 291 blksize => $blksize, 292 rcs => '-', 293 gap => '', 294 }; 295 @{$self}{keys %$ptr} = values %$ptr; 296 297 $self->{type} = substr($self->{mode}, 0, 1); 298 $self->{display} = $name . $self->filetypeflag(); 299 if ($self->{type} eq 'l') { 300 $self->{target} = readlink("$self->{_parent}/$entry"); 301 $self->{display} = 302 $name . $filetypeflags{'l'} . ' -> ' . $self->{target}; 303 } elsif ($self->{type} =~ /^[bc]/o) { 304 $self->{size_num} = 305 sprintf(MAJORMINORTEMPLATE, $_pfm->os->rdev_to_major_minor($rdev)); 306 } 307 $self->{mode} .= $self->{has_acl} ? '+' : ' '; 308 $self->format(); 309 return $self; 310} 311 312=item I<filetypeflag()> 313 314Returns the correct flag for this file type. 315 316=cut 317 318sub filetypeflag { 319 my ($self) = @_; 320 my $filetypeflags = $_pfm->config->{filetypeflags}; 321 if ($self->{type} eq '-' and $self->{mode} =~ /.[xst]/) { 322 return $filetypeflags->{'x'}; 323 } else { 324 return $filetypeflags->{$self->{type}} || ''; 325 } 326} 327 328=item I<format()> 329 330Formats the fields according to the current screen size. 331 332=cut 333 334sub format { 335 my ($self) = @_; 336 my $listing = $_pfm->screen->listing; 337 338 unless ($self->{type} =~ /[bc]/) { 339 @{$self}{qw(size_num size_power)} = 340 fit2limit($self->{size}, $listing->maxfilesizelength); 341 @{$self}{qw(grand_num grand_power)} = 342 fit2limit($self->{grand}, $listing->maxgrandtotallength); 343 } 344 345 $self->{atimestring} = $self->stamp2str($self->{atime}); 346 $self->{mtimestring} = $self->stamp2str($self->{mtime}); 347 $self->{ctimestring} = $self->stamp2str($self->{ctime}); 348 $self->{gap} = ' ' x $listing->{_gaplength}; 349 $self->{name_too_long} = 350 length($self->{display}) > $listing->maxfilenamelength-1 351 ? $listing->NAMETOOLONGCHAR : ' '; 352 $self->{color} = $self->_decidecolor(); 353 return; 354} 355 356=item I<apply(coderef $do_this, string $special_mode, array @args)> 357 358Applies the supplied function to the current file. 359The function will be called as C<< $do_this->($self, @args) >> 360where I<self> is the current File object. 361 362The current file will be temporarily unregistered from the current 363directory for the duration of do_this(). 364 365If I<special_mode> does not equal 'norestat', the file is re-stat() 366after executing do_this(). 367 368=cut 369 370sub apply { 371 my ($self, $do_this, $special_mode, @args) = @_; 372 my $state = $_pfm->state; 373 my $directory = $state->directory; 374 my ($to_mark, $res); 375 $directory->unregister($self); 376 $res = $do_this->($self, @args); 377 if ($state->{multiple_mode}) { 378 $to_mark = $directory->M_OLDMARK; 379 } else { 380 $to_mark = $self->{mark}; 381 } 382 if ($special_mode ne 'norestat') { 383 $self->stat_entry($self->{name}, '?', $to_mark); 384 } else { 385 $self->{mark} = $to_mark; 386 } 387 $directory->register($self); 388 return $res; 389} 390 391########################################################################## 392 393=back 394 395=head1 SEE ALSO 396 397pfm(1). 398 399=cut 400 4011; 402 403# vim: set tabstop=4 shiftwidth=4: 404