view release on metacpan or  search on metacpan

lib/GappX/FileTree.pm  view on Meta::CPAN

                    
                    my $textrender = Gtk2::CellRendererText->new();
                    $self->gobject->pack_start( $textrender, 1 );
                    $self->gobject->set_attributes( $textrender, 'markup', 1 );
                    
                },
            )
        ]
    },
    lazy => 1,
);

has 'filter_func' => (
    is => 'rw',
    isa => 'Maybe[CodeRef]',
);

has '+model' => (
    default => sub {
        Gapp::TreeStore->new(
            columns => [qw( Glib::String Glib::String Glib::String Glib::Boolean )],
            customize => sub {
                $_[0]->gobject->set_sort_func( 0, sub {
                    my ( $model, $itera, $iterb, $self ) = @_;
                    
                    my $dira = $model->get( $itera, 3 );
                    my $dirb = $model->get( $iterb, 3 );
                    my $texta = $model->get( $itera, 1 );
                    my $textb = $model->get( $iterb, 1 );
                    
                    no warnings;
                    $dirb <=> $dira || lc $texta cmp lc $textb;
                } );
                
                $_[0]->gobject->set_sort_column_id( 0, 'ascending' );
            },
        )
    },
    lazy => 1,
);

has 'path' => (
    is => 'rw',
    isa => 'Str',
    default => '.',
    trigger => sub {
        my ( $self, $newval, $oldval ) = @_;
        
        if ( $newval ne $oldval ) {
            $self->update if $self->has_gobject;
        }
        
    }
);

after _build_gobject => sub {
    #$_[0]->update;
};


sub update {
    my ( $self ) = @_;
    
    
    $self->model->gobject->clear;
    
    my $m = $self->model->gobject;
    
    my $base = $self->path;
    $base =~ s/(\/|\\)\s*$//; # remov trailing slash
    my $baserx = quotemeta $base;
    
    my @path;
    
    my $iter = undef;
    
    find (
        sub {
            return if $_ eq '.';
            
            if ( $self->filter_func ) {
                return if $self->filter_func->( $self, $_, $File::Find::name, $File::Find::dir );
            }
            
            my $dir = $File::Find::dir;
            $dir =~ s/^$baserx//;
            my @dirs = split /\/|\\/, $dir;
            shift @dirs if @dirs && ! $dirs[0];
            
            # if this is a directory
            if ( -d $_ ) {
                
                if ( @path ) {

                    if ( ! @dirs ) {
                        while ( @path ) {
                            $iter = $m->iter_parent( $iter ) if $iter;
                            pop @path;
                        }
                        
                    }
                    else {
                        no warnings;
                        while ( $path[-1] ne $dirs[-1] ) {
                            $iter = $m->iter_parent( $iter ) if $iter ;
                            pop @path;
                        }
                        
                        
                    }
                }
                
                
                if ( @path && ( ! @dirs || $path[-1] ne $dirs[-1] ) ) {
                    $iter = $m->iter_parent( $iter ) if $iter ;
                    pop @path;
                }
                
                my $i = $m->append( $iter );
                $m->set( $i, 0 => $File::Find::name , 1 => $_, 2 => 'gtk-directory', 3 => 1 );
                $iter = $i;