PerlFM

 view release on metacpan or  search on metacpan

lib/PerlFM.pm  view on Meta::CPAN

	my $self=$_[0];
	my $guiID=$_[1];

	if (!defined($self->{gui}{$guiID})) {
		return undef;
	}

	if ( $self->{gui}{$guiID}{watcher}->check() ) {
		$self->update($guiID, $self);
	}

	return 1;
}

=head2 chmod

This is the call back that is called when a chmod key/button is pressed.

=cut

sub chmod{
	my @selected=$_[1]->{gui}{list}->get_selected_indices;
	
	#get the entry
	my $entry=$_[1]{self}{data}{ $_[1]{gui}{id} }{data}{reverse}[$selected[0]];

	#
	my %returned=Gtk2::Chmod->ask($entry);

	#return if ok was pressed
	if ($returned{pressed} ne 'ok') {
		#update the stuff
		$_[1]{self}->update( $_[1]{gui}{id}, $_[1]{self} );
		return undef;
	}

	#process each entry
	my $int=0;
	while (defined($selected[$int])) {
		$entry=$_[1]{self}{data}{ $_[1]{gui}{id} }{data}{reverse}[$selected[$int]];
		
		#choose the proper method for file/directory
		if (-d $entry) {
			#use chmod binary if needed
			if ($returned{recursive}) {
				system('chmod -R '.shell_quote($returned{dirmode}).' '.shell_quote($entry) );
			}else {
				chmod(oct($returned{dirmode}), $entry);
			}
		}else {
			chmod(oct($returned{filemode}), $entry);
		}

		$int++;
	}

	#update the stuff
	$_[1]{self}->update( $_[1]{gui}{id}, $_[1]{self} );
}

=head2 chown

This is the call back that is called when a mkdir key/button is pressed.

=cut

sub chown{
	my $text='';
	my $window = Gtk2::Dialog->new($text,
								   undef,
								   [qw/modal destroy-with-parent/],
								   'gtk-cancel'     => 'cancel',
								   'gtk-save'     => 'accept',
								   );
	
	$window->set_position('center-always');
	
	$window->set_response_sensitive ('accept', 0);
	$window->set_response_sensitive ('reject', 0);
	
	my $vbox = $window->vbox;
	$vbox->set_border_width(5);
	
	my $label = Gtk2::Label->new_with_mnemonic('Change user/group ownership?');
	$vbox->pack_start($label, 0, 0, 1);
	$label->show;

	#group stuff
	my $ghbox=Gtk2::HBox->new;
	$ghbox->show;
	my $glabel=Gtk2::Label->new('group: ');
	$glabel->show;
	$ghbox->pack_start($glabel, 0, 1, 0);
	my $gentry = Gtk2::Entry->new();
	$gentry->show;
	$ghbox->pack_start($gentry, 0, 1, 0);
	$vbox->pack_start($ghbox, 0, 0, 1);
	
	#user stuff
	my $uhbox=Gtk2::HBox->new;
	$uhbox->show;
	my $ulabel=Gtk2::Label->new('user');
	$ulabel->show;
	$uhbox->pack_start($ulabel, 0, 1, 0);
	my $uentry = Gtk2::Entry->new();
	$uhbox->pack_start($uentry, 0, 1, 0);
	$uentry->show;	
	$vbox->pack_start($uhbox, 0, 0, 1);

	#check button
	my $recursivecheck=Gtk2::CheckButton->new('recursive');
	$recursivecheck->show;
	$vbox->pack_start($recursivecheck, 0, 0, 1);
	
	$uentry->signal_connect (changed => sub {
								my $text = $uentry->get_text;
								$window->set_response_sensitive ('accept', $text !~ m/^\s*$/);
								$window->set_response_sensitive ('reject', 1);
							}
							);

	$gentry->signal_connect (changed => sub {
								my $text = $gentry->get_text;
								$window->set_response_sensitive ('accept', $text !~ m/^\s*$/);
								$window->set_response_sensitive ('reject', 1);
							}
							);
	
	my $user;
	my $group;
	my $pressed;
	
	$window->signal_connect(response => sub {
								$user=$uentry->get_text;
								$group=$gentry->get_text;
								$pressed=$_[1];
							}
							);
	#runs the dailog and gets the response
	#'cancel' means the user decided not to create a new set
	#'accept' means the user wants to create a new set with the entered name
	my $response=$window->run;
	
	$window->destroy;

	if ($pressed eq 'reject') {
		return undef;
	}

	#set the pressed to reject if 
	if (($user eq '' )&&($group eq '')) {
		$pressed='reject'
	}

	#convert the user to a uid if the ownership is not a digit
	if ($user !~ /[[:digit:]]/) {
		my ($login, $pass, $uid)=getpwnam($user);
		if (defined($uid)) {
			$user=$uid;
		}
	}

	#convert the user to a uid if the ownership is not a digit
	if ($group !~ /[[:digit:]]/) {
		my ($name,$passwd,$gid,$members)=getgrnam($user);
		if (defined($gid)) {
			$group=$gid;
		}
	}

	#gets the data
	my %data=$_[1]{self}->datahash($_[1]{gui}{check}->get_active);

	#get the entries in question
	my @entries;
	my @selected=$_[1]{gui}{list}->get_selected_indices;
	my $int=0;
	while (defined($selected[$int])) {
		my $entry=$data{reverse}[$selected[$int]];

		push(@entries, $entry);
		
		$int++;
	}


	#chown it
	chown($user, $group, @entries);

	#update the stuff
	$_[1]{self}->update( $_[1]{gui}{id}, $_[1]{self} );
}


=head2 datahash

This builds the data hash for the current directory. This is primarily for
internal use.

=cut

sub datahash{
	my $self=$_[0];
	my $hidden=$_[1];
	
	my $path=cwd;
	
	my %data;
	$data{names}={};

	#populates data hash
	opendir(FILEMANAGER, $path);
	my $entry=readdir(FILEMANAGER);
	while (defined($entry)) {
		my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($entry);

		my $add=1;

		#if it is a hidden file, check if it should be added or not
		if ($entry =~ /^\./) {
			$add=0;
			if ($hidden || (($entry eq '.')||($entry eq '..')) ) {
				$add=1;
			}
		}

		if ($add) {
			if (-d $entry) {
				$entry=$entry.'/';
			}
			
			$data{names}{$entry}={
								  dev=>$dev, inode=>$ino, mode=>$mode, nlink=>$nlink,
								  uid=>$uid, gid=>$gid, rdev=>$rdev, size=>$size,
								  atime=>$atime, mtime=>$mtime, ctime=>$ctime,
								  blksize=>$blksize, blocks=>$blocks,
								  };
			
		}
		$entry=readdir(FILEMANAGER);
	}
	closedir(FILEMANAGER);
	
	#sort the entries
	my @entries=keys(%{$data{names}});
	@entries=sort(@entries);

	#puts them all together

lib/PerlFM.pm  view on Meta::CPAN

	$gui{menubarmenu}=Gtk2::MenuItem->new('_m');
	$gui{menubar}->show;
	$gui{menubarmenu}->show;
	$gui{menu}=Gtk2::Menu->new;
	$gui{menu}->show;
	$gui{menuTearoff}=Gtk2::TearoffMenuItem->new;
	$gui{menuTearoff}->show;
	$gui{menu}->append($gui{menuTearoff});
	$gui{menubarmenu}->set_submenu($gui{menu});
	$gui{menubar}->append($gui{menubarmenu});
	#check
	$gui{check}=Gtk2::CheckMenuItem->new('show _hidden');
	$gui{check}->show;
	$gui{check}->set_active($gui{hidden});
	$gui{check}->signal_connect(toggled=>sub{
									$_[1]{self}{gui}{ $_[1]{id} }{hidden}=$_[1]{self}{gui}{ $_[1]{id} }{check}->get_active;
									$_[1]{self}->update( $_[1]{id}, $_[1]{self} );
								},
								{
								 self=>$self,
								 id=>$gui{id},
								 }
								);
	$gui{menu}->append($gui{check});
	$gui{menuS0}=Gtk2::SeparatorMenuItem->new();
	$gui{menuS0}->show;
	$gui{menu}->append($gui{menuS0});
	#delete menu item
	$gui{delete}=Gtk2::MenuItem->new('_delete');
	$gui{delete}->show;
	$gui{delete}->signal_connect(activate=>\&delete,
								 {
								  gui=>\%gui,
								  self=>$self,
								  }
								 );
	$gui{menu}->append($gui{delete});
	#mkdir menu item
	$gui{mkdir}=Gtk2::MenuItem->new('_mkdir');
	$gui{mkdir}->show;
	$gui{mkdir}->signal_connect(activate=>\&mkdir,
								 {
								  gui=>\%gui,
								  self=>$self,
								  }
								 );
	$gui{menu}->append($gui{mkdir});
	$gui{menuS1}=Gtk2::SeparatorMenuItem->new();
	$gui{menuS1}->show;
	$gui{menu}->append($gui{menuS1});
	#chmod
	$gui{chmod}=Gtk2::MenuItem->new('_chmod');
	$gui{chmod}->show;
	$gui{chmod}->signal_connect(activate=>\&chmod,
								 {
								  gui=>\%gui,
								  self=>$self,
								  }
								 );
	$gui{menu}->append($gui{chmod});
	#chown
	$gui{chown}=Gtk2::MenuItem->new('ch_own');
	$gui{chown}->show;
	$gui{chown}->signal_connect(activate=>\&chown,
								 {
								  gui=>\%gui,
								  self=>$self,
								  }
								 );
	$gui{menu}->append($gui{chown});
	$gui{menuS2}=Gtk2::SeparatorMenuItem->new();
	$gui{menuS2}->show;
	$gui{menu}->append($gui{menuS2});
	#show directories
	$gui{showdirectories}=Gtk2::MenuItem->new('show directories (_l)');
	$gui{showdirectories}->show;
	$gui{showdirectories}->signal_connect(activate=>sub{
											  #gets the current page
											  my $cp=$_[1]{self}{gui}{ $_[1]{id} }{DBnotebook}->get_current_page;
											  
											  if ($cp ne '0') {
												  $_[1]{self}{gui}{ $_[1]{id} }{DBnotebook}->set_current_page(0);
												  $_[1]{self}{gui}{ $_[1]{id} }{hpaned}->set_position(230);
												  $_[1]{self}{gui}{ $_[1]{id} }{dirlist}->grab_focus;
											  }else {
												  my $pos=$_[1]{self}{gui}{ $_[1]{id} }{hpaned}->get_position();
												  if ($pos ne '0') {
													  $_[1]{self}{gui}{ $_[1]{id} }{hpaned}->set_position(0);
													  $_[1]{self}{gui}{ $_[1]{id} }{list}->grab_focus;
												  }else {
													  $_[1]{self}{gui}{ $_[1]{id} }{hpaned}->set_position(230);
													  $_[1]{self}{gui}{ $_[1]{id} }{dirlist}->grab_focus;
												  }
											  }
										  },
										  {
										   id=>$gui{id},
										   self=>$self,
										  }
										  );
	$gui{menu}->append($gui{showdirectories});
	#show bookmarks
	$gui{showbookmarks}=Gtk2::MenuItem->new('show _bookmarks');
	$gui{showbookmarks}->show;
	$gui{showbookmarks}->signal_connect(activate=>sub{
											#gets the current page
											my $cp=$_[1]{self}{gui}{ $_[1]{id} }{DBnotebook}->get_current_page;
											
											if ($cp ne '1') {
												$_[1]{self}{gui}{ $_[1]{id} }{DBnotebook}->set_current_page(1);
												$_[1]{self}{gui}{ $_[1]{id} }{hpaned}->set_position(230);
												$_[1]{self}{gui}{ $_[1]{id} }{bmlist}->grab_focus;
											}else {
												my $pos=$_[1]{self}{gui}{ $_[1]{id} }{hpaned}->get_position();
												if ($pos ne '0') {
													$_[1]{self}{gui}{ $_[1]{id} }{hpaned}->set_position(0);
													$_[1]{self}{gui}{ $_[1]{id} }{list}->grab_focus;
												}else {
													$_[1]{self}{gui}{ $_[1]{id} }{hpaned}->set_position(230);
													$_[1]{self}{gui}{ $_[1]{id} }{bmlist}->grab_focus;
												}
											}
										  },
										  {
										   id=>$gui{id},
										   self=>$self,
										  }
										  );
	$gui{menu}->append($gui{showbookmarks});
	$gui{menuS3}=Gtk2::SeparatorMenuItem->new();



( run in 0.626 second using v1.01-cache-2.11-cpan-5511b514fd6 )