festival.edmaven.com:80

Linux b747.shapiroconsult.com 3.10.0-1160.119.1.vz7.224.4 #1 SMP Mon Sep 30 15:36:27 MSK 2024 x86_64
Apache
173.231.212.80

Dirbrowser.pm

# ----------------------------------------------------------------------
# Curses::UI::Dialog::Dirbrowser
# (C) 2003 by Roberto De Leo based on work
# (c) 2001-2002 by Maurice Makaay. All rights reserved.
# This file is part of Curses::UI. Curses::UI is free software.
# You can redistribute it and/or modify it under the same terms
# as perl itself.
#
# Currently maintained by Marcus Thiesen
# e-mail: marcus@cpan.thiesenweb.de
# ----------------------------------------------------------------------

package Curses::UI::Dialog::Dirbrowser;

use strict;
use Curses;
use Curses::UI::Window;
use Curses::UI::Common;
use Cwd;

use vars qw(
    $VERSION 
    @ISA
);

@ISA = qw(
    Curses::UI::Window
    Curses::UI::Common
);

$VERSION = '1.0';

sub new ()
{
    my $class = shift;

my %userargs = @_;
    keys_to_lowercase(\%userargs);

my %args = ( 
        -title          => undef,
        -path           => undef,
	-bg             => -1,
        -fg             => -1,

%userargs,

-border         => 1,
        -centered       => 1,
        -titleinverse   => 0,
        -ipad           => 1,
        -selected_cache => {},
    );

# Does -path not contain a path? Then use the 
    # current working directory.
    if (not defined $args{-path} or $args{-path} =~ /^\s*$/) {
        $args{-path} = cwd;
    }

my $this = $class->SUPER::new(%args);
    $this->layout();

my $l = $this->root->lang;

# Start at home? Goto the homedirectory of the current user
    # if the -path is not defined.
    $this->goto_homedirectory unless defined $this->{-path};

my $buttons = $this->add(
        'buttons', 'Buttonbox',
        -y               => -1,
        -x               => 0,
        -width           => undef,
        -buttonalignment => 'middle',
        -buttons         => [ 'ok', 'cancel' ],
        -bg              => $this->{-bg},
        -fg              => $this->{-fg},
    );

# Let the window in which the buttons are loose focus
    # if a button is pressed.
    $buttons->set_routine( 'press-button', \&press_button_callback );

my $one_up = $l->get('file_dirup');
    my $dirbrowser = $this->add(
        'dirbrowser', 'Listbox',
        -y               => 0,
        -border          => 1,
        -width           => $this->canvaswidth - 2,
        -padbottom       => 6,
        -values          => [],
        -vscrollbar      => 1,
        -labels          => { '..' => ".. ($one_up)" },
        -bg              => $this->{-bg},
        -fg              => $this->{-fg},
        -bbg              => $this->{-bg},
        -bfg              => $this->{-fg},

);

$dirbrowser->set_routine('option-select',\&dirselect);
    $dirbrowser->set_routine('goto-homedirectory',\&select_homedirectory);
    $dirbrowser->set_binding('goto-homedirectory', '~');

# Get language specific data.
    my $l_path = $l->get('file_path');
    my $l_mask = $l->get('file_mask');
    my $l_file = $l->get('file_file');
    my $l_len  = $l->get('file_labelsize');

my $labeloffset = 1;
    my $textoffset = $l_len + 2;

$this->add(
        'pathlabel', 'Label',
        -x              => $labeloffset, 
        -y              => $this->canvasheight - 5, 
        -text           => $l_path,
        -bg              => $this->{-bg},
        -fg              => $this->{-fg},
    );
    $this->add(
        'pathvalue', 'Label',
        -x              => $textoffset,
        -y              => $this->canvasheight - 5, 
        -width          => $this->canvaswidth - 6,
        -text           => $this->{-path},
        -bg              => $this->{-bg},
        -fg              => $this->{-fg},
    );

$this->set_binding(sub{
        my $this = shift;
        $this->getobj('buttons')->{-selected} = 1;
        $this->loose_focus;
    }, CUI_ESCAPE);

$this->layout();
    $this->get_dir;

return bless $this, $class;
}

sub layout()
{
    my $this = shift;

my $w = 50;
    my $h = 18;
    $this->{-width} = $w,
    $this->{-height} = $h,

$this->SUPER::layout() or return;

return $this;
}

sub get_dir()
{
    my $this = shift;

# Get pathvalue, filevalue, dirbrowser and filebrowser objects.
    my $pv = $this->getobj('pathvalue');
    my $db = $this->getobj('dirbrowser');

my $path = $pv->text;

# Resolve path.
    $path =~ s|/+|/|g;
    my @path = split /\//, $path;
    my @resolved = ();
    foreach my $dir (@path)
    {
        if ($dir eq '.') { next }
        elsif ($dir eq '..') { pop @resolved if @resolved }
        else { push @resolved, $dir }
    }
    $path = join "/", @resolved;
    
    # Catch totally bogus paths.
    if (not -d $path) { $path = "/" }
    
    $pv->text($path);
    
    my @dirs = ();
    unless (opendir D, $path)
    {
        my $l = $this->root->lang();
        my $error = $l->get('file_err_opendir_pre')
                  . $path
                  . $l->get('file_err_opendir_post')
                  . ":\n$!";
        $this->root->error($error);
        return;
    }
    foreach my $f (sort readdir D)
    {
        next if $f =~ /^\.$|^\.\.$/;
        next if $f =~ /^\./ and not $this->{-show_hidden};
        push @dirs,  $f if -d "$path/$f";
    }
    closedir D;

unshift @dirs, ".." if $path ne '/';

$db->values(\@dirs);
    $db->{-ypos} = $this->{-selected_cache}->{$path};
    $db->{-ypos} = 0 unless defined $db->{-ypos};
    $db->{-selected} = undef;
    $db->layout_content->draw(1);

return $this;
}

# Set $this->{-path} to the homedirectory of the current user.
sub goto_homedirectory()
{
    my $this = shift;

my @pw = getpwuid($>);
    if (@pw) {
        if (-d $pw[7]) {
	    $this->{-path} = $pw[7];
        } else {
	    $this->{-path} = '/';
	    $this->root->error("Homedirectory $pw[7] not found");
	    return;
        }
    } else {
        $this->{-path} = '/';
        $this->root->error("Can't find a passwd entry for uid $>");
        return;
    }

return $this;
}

sub select_homedirectory()
{
    my $b = shift; # dir-/filebrowser
    my $this = $b->parent;
    my $pv = $this->getobj('pathvalue');

$this->goto_homedirectory or return $b;
    $pv->text($this->{-path});
    $this->get_dir;

return $b;
}

sub dirselect()
{
    my $db = shift; # dirbrowser
    my $this = $db->parent;
    my $pv = $this->getobj('pathvalue');

# Find the new path.
    my $add = $db->values->[$db->{-ypos}];
    my $savepath = $pv->text;
    $this->{-selected_cache}->{$savepath} = $db->{-ypos};
    $pv->text("/$savepath/$add");

# Get the selected directory.
    unless ($this->get_dir) {
        $pv->text($savepath);
    }

return $db;
}

sub maskbox_onchange()
{
    my $maskbox = shift; 
    my $this = $maskbox->parent;
    $this->{-activemask} = $maskbox->get;
    $this->get_dir;
    return $maskbox;
}

sub draw(;$)
{
    my $this = shift;
    my $no_doupdate = shift || 0;

# Draw Window
    $this->SUPER::draw(1) or return $this;

$this->{-canvasscr}->noutrefresh();
    doupdate() unless $no_doupdate;

return $this;
}

sub get()
{
    my $this = shift;
    if ($this->getobj('buttons')->get) {
        my $file = $this->getobj('pathvalue')->get;
        $file =~ s|/+|/|g;
        return $file;
    } else {
        return;
    }
}

sub press_button_callback()
{
    my $buttons = shift;
    my $this = $buttons->parent;
    my $file = $this->get;

my $ok_pressed = $buttons->get;
    if ($ok_pressed and $file =~ m|/$|) {
        my $l = $this->root->lang;
        $this->root->error($l->get('file_err_nofileselected'));
        return;
    } else {
        $this->loose_focus;
    }
}

=pod

=head1 NAME

Curses::UI::Dialog::Dirbrowser - Create and manipulate filebrowser dialogs

=head1 CLASS HIERARCHY

Curses::UI::Widget
    |
    +----Curses::UI::Container
            |
            +----Curses::UI::Window
                    |
                    +----Curses::UI::Dialog::Dirbrowser

=head1 SYNOPSIS

use Curses::UI;
    my $cui = new Curses::UI;
    my $win = $cui->add('window_id', 'Window');

# The hard way.
    # -------------
    my $dialog = $win->add(
        'mydialog', 'Dialog::Dirbrowser'
    );
    $dialog->focus;
    my $file = $dialog->get();
    $win->delete('mydialog');

# The easy way (see Curses::UI documentation).
    # --------------------------------------------
    $file = $cui->filebrowser();
    $file = $cui->loadfilebrowser();
    $file = $cui->savefilebrowser();

=head1 DESCRIPTION

Curses::UI::Dialog::Dirbrowser is a dirbrowser dialog. 
This type of dialog can be used to select a directory, anywhere
on the filesystem.

See exampes/demo-Curses::UI::Dialog::Dirbrowser in the 
distribution for a short demo.

=head1 OPTIONS

=over 4

=item * B<-title> < TEXT >

Set the title of the dialog window to TEXT.

=item * B<-path> < PATH >

Set the path to start with to PATH. If this path
does not exist, the filebrowser will start in the
rootdirectory.

=item * B<-show_hidden> < BOOLEAN >

If BOOLEAN has a true value, hidden files (the filename
starts with a dot) will also be shown. By default this
option is set to false.

=back

=head1 METHODS

=over 4

=item * B<new> ( OPTIONS )

=item * B<layout> ( )

=item * B<draw> ( BOOLEAN )

=item * B<focus> ( )

These are standard methods. See L<Curses::UI::Container|Curses::UI::Container> 
for an explanation of these.

=item * B<get> ( )

This method will return the complete path to the file that was
selected using the filebrowser. If no file was selected, this
method will return an undefined value.

=back

=head1 SPECIAL BINDINGS

=over 4

=item * B<escape>

This will invoke the cancel button, so the filebrowser widget
returns without selecting any file.

=item * B<~>

If the directory- or filelistbox of the dialog window has the
focus and the tilde (~) button is pressed, the filebrowser
will chdir to the homedirectory of the current user.

=back

=head1 SEE ALSO

L<Curses::UI|Curses::UI>, 
L<Curses::UI::Container|Curses::UI::Container>, 
L<Curses::UI::Buttonbox|Curses::UI::Buttonbox>

=head1 AUTHOR

Maintained by Marcus Thiesen (marcus@cpan.thiesenweb.de)

This package is free software and is provided "as is" without express
or implied warranty. It may be used, redistributed and/or modified
under the same terms as perl itself.

Name	Type	Size	Owner/Group	Permission	Last Modified	Actions
.	dir	-	root/root	0755	2016-10-25 06:14:21
..	dir	-	root/root	0755	2016-10-25 06:14:21
Basic.pm	text/plain	7.63 KB	root/root	0444	2011-09-01 02:07:49
Calendar.pm	text/plain	5.71 KB	root/root	0444	2011-09-01 02:07:49
Dirbrowser.pm	text/plain	10.16 KB	root/root	0444	2011-09-01 02:07:49
Error.pm	text/plain	3.41 KB	root/root	0444	2011-09-01 02:07:49
Filebrowser.pm	text/plain	15.85 KB	root/root	0444	2011-09-01 02:07:49
Progress.pm	text/plain	6.25 KB	root/root	0444	2011-09-01 02:07:49
Question.pm	text/plain	8.46 KB	root/root	0444	2011-09-01 02:07:49
Status.pm	text/plain	4.45 KB	root/root	0444	2011-09-01 02:07:49