view release on metacpan or  search on metacpan

lib/Term/Clui/FileSelect.pm  view on Meta::CPAN

# Term/Clui/FileSelect.pm
#########################################################################
#        This Perl module is Copyright (c) 2002, Peter J Billam         #
#               c/o P J B Computing, www.pjb.com.au                     #
#                                                                       #
#     This module is free software; you can redistribute it and/or      #
#            modify it under the same terms as Perl itself.             #
#########################################################################

package Term::Clui::FileSelect;
our $VERSION = '1.76';
use Term::Clui(':DEFAULT','back_up', 'set_default');
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(select_file);
@EXPORT_OK = qw();

use 5.006;
no strict; no warnings;

my $home = $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>))[7];
$home =~ s#([^/])$#$1/#;

sub select_file {   my %option = @_;
	if (!defined $option{'-Path'}) { $option{'-Path'}=$option{'-initialdir'}; }
	if (!defined $option{'-FPat'}) { $option{'-FPat'}=$option{'-filter'}; }
	if (!defined $option{'-ShowAll'}) {
		$option{'-ShowAll'} = $option{'-dotfiles'};
	}
	if ($option{'-Directory'}) { $option{'-Chdir'}=1; $option{'-SelDir'}=1; }
	my $multichoice = 0;
	if (wantarray && !$option{'-Chdir'} && !$option{'-Create'}) {
		$option{'-DisableShowAll'} = 1;
		$multichoice = 1;
	} elsif (!defined $option{'-Chdir'}) {
		$option{'-Chdir'} = 1;
	}

	if ($option{'-Path'} && -d $option{'-Path'}) {
		$dir=$option{'-Path'};
		if ($dir =~ m#[^/]$#) { $dir .= '/'; }
	} else {
		$dir = $home;
	}
	if ($option{'-TopDir'}) {
		if (!-d $option{'-TopDir'}) { delete $option{'-TopDir'};
		} elsif ($option{'-TopDir'} =~ m#[^/]$#) { $option{'-TopDir'} .= '/';
		}
		if (index $dir, $option{'-TopDir'}) { $dir = $option{'-TopDir'}; }
	}

	my ($new, $file, @allfiles, @files, @dirs, @pre, @post, %seen, $isnew);
	my @dotfiles;

	while () {
		if (! opendir (D, $dir)) { warn "can't opendir $dir: $!\n"; return 0; }
		if ($option{'-SelDir'}) { @pre = ('./'); } else { @pre = (); }
		@post = ();
		@allfiles = sort grep(!/^\.\.?$/, readdir D); closedir D;
		@dotfiles = grep(/^\./, @allfiles);
		if ($option{'-ShowAll'}) {
			if (@dotfiles && !$option{'-DisableShowAll'}) {
				@post='Hide DotFiles';
			}
		} else {
			@allfiles = grep(!/^\./, @allfiles);
			if (@dotfiles && !$option{'-DisableShowAll'}) {
				@post='Show DotFiles';
			}
		}
		# split @allfiles into @files and @dirs for option processing ...
		@dirs  = grep(-d "$dir/$_" && -r "$dir/$_", @allfiles);
		if ($option{'-Directory'}) {
			@files = ();
		} elsif ($option{'-FPat'}) {
			@files = grep(!-d $_, glob("$dir/$option{'-FPat'}"));
			my $length = 1 + length $dir;
			foreach (@files) { $_ = substr $_, $length; }
		} else {
			@files = grep(!-d "$dir/$_", @allfiles);
		}