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