view release on metacpan or  search on metacpan

Tk/FBox.pm  view on Meta::CPAN

					? @{ $t->[1] }
					: $t->[1]);
    }

    my @types;
    my %hasDoneType;
    my %hasGotExt;
    foreach my $t (@$in) {
	my $label = $t->[0];
	my @exts;

	next if (exists $hasDoneType{$label});

	my $name = "$label (";
	my $sep = '';
	foreach my $ext (@{ $fileTypes{$label} }) {
	    next if ($ext eq '');
	    $ext =~ s/^\./*./;
	    if (!exists $hasGotExt{$label}->{$ext}) {
		$name .= "$sep$ext";
		push @exts, $ext;
		$hasGotExt{$label}->{$ext}++;
	    }
	    $sep = ',';
	}
	$name .= ')';
	push @types, [$name, \@exts];

	$hasDoneType{$label}++;
    }

    return @types;
}

# ext_chdir --
#
#       Change directory with tilde substitution
#
sub ext_chdir {
    my $dir = shift;
    if ($dir eq '~') {
	chdir _get_homedir();
    } elsif ($dir =~ m|^~/(.*)|s) {
	chdir _get_homedir() . "/" . $1;
    } elsif ($dir =~ m|^~([^/]+(.*))|s) {
	chdir _get_homedir($1) . $2;
    } else {
	chdir $dir;
    }
}

# _get_homedir --
#
#       Get home directory of the current user
#
sub _get_homedir {
    my($user) = @_;
    if (!defined $user) {
	eval {
	    local $SIG{__DIE__};
	    (getpwuid($<))[7];
	} || $ENV{HOME} || undef; # chdir undef changes to home directory, too
    } else {
	eval {
	    local $SIG{__DIE__};
	    (getpwnam($user))[7];
	};
    }
}

sub _cwd {
    #Cwd::cwd();
    Cwd::fastcwd(); # this is taint-safe
}

sub _untaint {
    my $s = shift;
    $s =~ /^(.*)$/;
    $1;
}

sub _rx_to_glob {
    my $arg = shift;
    $arg =~ s!([.+^()|\${}\[\]\\])!\\$1!g;
    $arg = join('|', map {"^$_\\z"} split(' ', $arg));
    $arg =~ s!\*!.*!g;$arg =~ s!\?!.!g;
    $arg = qr/$arg/s;
    $arg;
}

sub _get_from_icons {
    my($w, $item) = @_;
    $w->_encode_filename($w->{'icons'}->Get($item));
}

sub _get_select_path {
    my($w) = @_;
    $w->_encode_filename($w->{'selectPath'});
}

sub _encode_filename {
    my($w, $filename) = @_;
    $filename = $w->{encoding}->encode($filename);
    $filename;
}

1;