summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorSebastien Dupont <sdupont@mandriva.com>2002-01-13 09:37:05 +0000
committerSebastien Dupont <sdupont@mandriva.com>2002-01-13 09:37:05 +0000
commitcc10ace6393edc9169db69010bd86273e2a010e9 (patch)
tree7afcad8876332d5d7ba2e56f7aee841b42e41002 /perl-install
parentd35bc8533949fe72cf77712a9e0250fd0e579fc9 (diff)
downloaddrakx-cc10ace6393edc9169db69010bd86273e2a010e9.tar
drakx-cc10ace6393edc9169db69010bd86273e2a010e9.tar.gz
drakx-cc10ace6393edc9169db69010bd86273e2a010e9.tar.bz2
drakx-cc10ace6393edc9169db69010bd86273e2a010e9.tar.xz
drakx-cc10ace6393edc9169db69010bd86273e2a010e9.zip
ftp backup work.
fix time problems. remove doc from file. security fix for configuration file.
Diffstat (limited to 'perl-install')
-rwxr-xr-xperl-install/standalone/drakbackup365
1 files changed, 48 insertions, 317 deletions
diff --git a/perl-install/standalone/drakbackup b/perl-install/standalone/drakbackup
index 31146bbf0..866ed371e 100755
--- a/perl-install/standalone/drakbackup
+++ b/perl-install/standalone/drakbackup
@@ -85,7 +85,6 @@
#
# TODO:
# 4 - change NET::FTP to ftp cmds.
-# 5 - add icons (win & lin) on adv_what_all.
# 6 - calcul disk space.
# use quota.
# 7 - ssh & rsync -> expect or .identity.pub/authorized_keys
@@ -143,6 +142,7 @@ if ("@ARGV" =~ /--help|-h/) {
in /var/backup directory so write other directory
to change to change it.
--conf_file : to read other configuration file.
+--debug : permit to see all debug messages.
);
exit(0);
}
@@ -209,6 +209,8 @@ my $table;
my @user_list_backuped = ();
my @files_corrupted = ();
my $remove_user_before_restore = 1;
+my @file_list_to_send_by_ftp = ();
+
# config. FILES -> Default PATH & Global variables.
my @sys_files = ("/etc");
@@ -284,7 +286,9 @@ sub read_passwd {
sub the_time {
$the_time = "_";
$the_time .= localtime->year() + 1900;
+ if (localtime->mon() < 9 ) { $the_time .= "0"; }
$the_time .= localtime->mon() +1;
+ if (localtime->mday() < 10 ) { $the_time .= "0"; }
$the_time .= localtime->mday();
$the_time .= "_";
if (localtime->hour() < 10 ) { $the_time .= "0"; }
@@ -337,6 +341,7 @@ sub save_conf_file {
if ($comp_mode) {push @cfg_list, "OPTION_COMP=TAR.BZ2\n"}
else { push @cfg_list, "OPTION_COMP=TAR.GZ\n" }
output_p($cfg_file, @cfg_list);
+ system("chmod 600 $cfg_file");
save_cron_files();
}
@@ -442,18 +447,33 @@ sub return_path {
}
sub ftp_client {
-# liste des fichiers à envoyer
use Net::FTP;
- my $ftp = Net::FTP->new("$host_name");
+ my $ftp;
+
+ $DEBUG and print "file list to send : $_\n " foreach @file_list_to_send_by_ftp;
+ $DEBUG and $ftp = Net::FTP->new("$host_name", Debug => 1);
+ $DEBUG or $ftp = Net::FTP->new("$host_name", Debug => 0);
$ftp->login("$login_user","$passwd_user");
$ftp->cwd("$host_path");
# $ftp->get("/ce/repertoire/ce.fichier");
-# put ( LOCAL_FILE [, REMOTE_FILE ] )
-
- $ftp->send("$save_path/*");
+ foreach (@file_list_to_send_by_ftp) {
+ $ftp->put("$_");
+ }
$ftp->quit;
}
+sub ssh_client {
+# $res = Net::SSLeay::write($ssl, $msg); # Perl knows how long $msg is
+# die_if_ssl_error("ssl write");
+# shutdown S, 1; # Half close --> No more output, sends EOF to server
+# $got = Net::SSLeay::read($ssl); # Perl returns undef on failure
+# die_if_ssl_error("ssl read");
+# print $got;
+
+# Net::SSLeay::free ($ssl); # Tear down connection
+# Net::SSLeay::CTX_free ($ctx);
+# close S;
+}
sub build_backup_files {
my $path_name;
@@ -501,30 +521,38 @@ sub build_backup_files {
if (grep /^backup\_incr\_sys/, @dir_content) {
my @more_recent = grep /^backup\_incr\_sys/, sort @dir_content;
$more_recent = pop @more_recent;
+ $DEBUG and print "more recent file: $more_recent\n ";
system("find @sys_files -cnewer $save_path/$more_recent \! -type d -print > $save_path/list_incr_sys$the_time.txt");
if (!cat_("$save_path/list_incr_sys$the_time.txt")) {
system("rm $save_path/list_incr_sys$the_time.txt");
} else {
system("$tar_cmd_sys -f $save_path/backup_incr_sys$the_time.$tar_ext -T $save_path/list_incr_sys$the_time.txt");
+ push @file_list_to_send_by_ftp, "$save_path/backup_incr_sys$the_time.$tar_ext";
+ push @file_list_to_send_by_ftp, "$save_path/list_incr_sys$the_time.txt";
}
}
elsif (grep /^backup\_base\_sys/, @dir_content) {
my @more_recent = grep /^backup\_base\_sys/, sort @dir_content;
$more_recent = pop @more_recent;
+ $DEBUG and print "more recent file: $more_recent\n ";
system("find @sys_files -cnewer $save_path/$more_recent \! -type d -print > $save_path/list_incr_sys$the_time.txt");
if (!cat_("$save_path/list_incr_sys$the_time.txt")) {
system("rm $save_path/list_incr_sys$the_time.txt");
} else {
system("$tar_cmd_sys -f $save_path/backup_incr_sys$the_time.$tar_ext -T $save_path/list_incr_sys$the_time.txt");
+ push @file_list_to_send_by_ftp, "$save_path/backup_incr_sys$the_time.$tar_ext";
+ push @file_list_to_send_by_ftp, "$save_path/list_incr_sys$the_time.txt";
}
}
else {
system("$tar_cmd_sys -f $save_path/backup_base_sys$the_time.$tar_ext @sys_files");
+ push @file_list_to_send_by_ftp, "$save_path/backup_base_sys$the_time.$tar_ext";
}
}
else {
- system("cd $save_path && rm -f backup_sys* backup_base_sys* backup_incr_sys*");
+# system("cd $save_path && rm -f backup_sys* backup_base_sys* backup_incr_sys*");
system("$tar_cmd_sys -f $save_path/backup_sys$the_time.$tar_ext @sys_files");
+ push @file_list_to_send_by_ftp, "$save_path/backup_sys$the_time.$tar_ext";
}
}
@@ -534,6 +562,7 @@ sub build_backup_files {
if (@list_other) {
system("cd $save_path && rm -f backup_other* ");
system("$tar_cmd_other -f $save_path/backup_other$the_time.$tar_ext @list_other");
+ push @file_list_to_send_by_ftp, "$save_path/backup_other$the_time.$tar_ext";
foreach (@list_other) { push @list_other_, $_ . "\n"; }
output_p( $save_path . '/list_other', @list_other_);
}
@@ -549,29 +578,37 @@ sub build_backup_files {
if (grep(/^backup\_incr\_user\_$user\_/, @dir_content)) {
my @more_recent = grep /^backup\_incr\_user\_$user\_/, sort @dir_content;
$more_recent = pop @more_recent;
+ $DEBUG and print "more recent file: $more_recent\n ";
system("find $path_name -cnewer $save_path/$more_recent \! -type d -print > $save_path/list_incr_user_$user$the_time.txt");
if (!cat_("$save_path/list_incr_user_$user$the_time.txt")) {
system("rm $save_path/list_incr_user_$user$the_time.txt");
} else {
system("$tar_cmd_user -f $save_path/backup_incr_user_$user$the_time.$tar_ext -T $save_path/list_incr_user_$user$the_time.txt");
+ push @file_list_to_send_by_ftp, "$save_path/backup_incr_user_$user$the_time.$tar_ext";
+ push @file_list_to_send_by_ftp, "$save_path/list_incr_user_$user$the_time.txt";
}
}
elsif (grep /^backup\_base\_user\_$user\_/, @dir_content) {
my @more_recent = grep /^backup\_base\_user\_$user\_/, sort @dir_content;
$more_recent = pop @more_recent;
+ $DEBUG and print "more recent file: $more_recent\n ";
system("find $path_name -cnewer $save_path/$more_recent \! -type d -print > $save_path/list_incr_user_$user$the_time.txt");
if (!cat_("$save_path/list_incr_user_$user$the_time.txt")) {
system("rm $save_path/list_incr_user_$user$the_time.txt");
} else {
system("$tar_cmd_user -f $save_path/backup_incr_user_$user$the_time.$tar_ext -T $save_path/list_incr_user_$user$the_time.txt");
+ push @file_list_to_send_by_ftp, "$save_path/backup_incr_user_$user$the_time.$tar_ext";
+ push @file_list_to_send_by_ftp, "$save_path/list_incr_user_$user$the_time.txt";
}
}
else {
system("$tar_cmd_user -f $save_path/backup_base_user_$user$the_time.$tar_ext $path_name");
+ push @file_list_to_send_by_ftp, "$save_path/backup_base_user_$user$the_time.$tar_ext";
}
} else {
system("cd $save_path && rm -f backup_user_$_* backup_base_user_$_* backup_incr_user_$_*");
system("$tar_cmd_user -f $save_path/backup_user_$_$the_time.$tar_ext $path_name");
+ push @file_list_to_send_by_ftp, "$save_path/backup_user_$_$the_time.$tar_ext";
}
}
}
@@ -580,18 +617,11 @@ sub build_backup_files {
}
if ($where_net_ssh) {
-# $res = Net::SSLeay::write($ssl, $msg); # Perl knows how long $msg is
-# die_if_ssl_error("ssl write");
-# shutdown S, 1; # Half close --> No more output, sends EOF to server
-# $got = Net::SSLeay::read($ssl); # Perl returns undef on failure
-# die_if_ssl_error("ssl read");
-# print $got;
-
-# Net::SSLeay::free ($ssl); # Tear down connection
-# Net::SSLeay::CTX_free ($ctx);
-# close S;
+ ssh_client();
+ }
+ if ($where_net_ftp) {
+ ftp_client();
}
- if ($where_net_ftp) { }
if ($where_cd) { }
}
@@ -3221,302 +3251,3 @@ Drakbacup allow to restore the system (etc, var files)
}
-
-
-
-
-
-
-
-
-
-
-
-# _____________________________________________________________ DOCS
-
-# [Perl] Comment récupérer des informations sur un fichier ?
-# Cf perldoc -f stat
-
-# Exemple pour récupérer mtime (date de dernière modification du fichier)
-# my(@etat); my($fchier)="/tmp/toto";
-# # Si le fichier existe on récupère des infos dessus
-# if (-e $fchier) {@etat=stat($fchier); }
-# # On convertit avec localtime la valeur de mtime.
-# my($date)= localtime($etat[9]);
-# print $date;
-
-
-#Telnet : En utilisant le package Net::Telnet
-# use strict;
-# use Net::Telnet;
-# use CGI qw/:standard :html3 :netscape escape unescape/;
-# use CGI::Carp qw/fatalsToBrowser/;
-# my $username="alian";
-# my $passwd="password";
-# my $HOST="indy.alianet";
-# print header;
-# my $t = new Net::Telnet (Timeout=>undef) or die "Can't connect:$!";
-# $t->open($HOST);
-# $t->login($username, $passwd);
-# my @lines = $t->cmd("/ma/commande/a/executer");
-# print join(' ',@lines);
-
-# _____________________________________________________________ DOCS2
-
-
-# Linux backups HOWTO1
-
-# Add***jbw
-# Audience: All???
-
-# /Add***jbw
-# Jerry Winegarden
-# Revised 4-04-00
-
-# Revised***jbw
-
-# There are several utilities that can be used for backups under Linux. Which is the best?
-# There isn't any one utility that is best. It depends on the media to which you are backing up,
-# whether you are backing up just one machine or several over the network, and what you intend to
-# do with the backup. There are both free utilities which come standard with a Red Hat Linux
-# installation and third-party packages (some free, others not).
-
-# /Revised***jbw
-# List of backup utilities
-
-# Add***jbw
-# Standard Red Hat Linux (GNU) backup utilities
-
-# /Add***jbw
-
-# *
-
-# tar 2
-# *
-
-# dump
-
-# Add***jbw
-# * rdump
-
-# /Add***jbw
-# *
-
-# cpio
-# *
-
-# (There are others: sharutil,find + dd, cp) 3
-
-# Add***jbw
-
-# Third-party backup packages
-
-# * BRU
-# * Networker
-# * Matt: These two are just placeholders - I need to get a proper list (I've got saved email that
-# lists some - just had time to look thru them yet)
-
-# /Add***jbw
-
-# There are different types of backups:
-
-# *
-
-# full 4
-# *
-
-# incremental
-
-# Add***jbw
-# * partial
-# * local
-# * remote (network)
-
-# /Add***jbw
-
-# Add***jbw
-# Full backups
-
-# Full backups are intended to be a complete backup of every file. Users should not be logged in during a
-# full backup so that files are not left open for writing and thus somehow not included in a full backup.
-
-# Partial backups
-
-# Partial backups include only a specified set of files or directories.
-
-# Incremental backups
-
-# Incremental backups are intended to backup only files that have changed since a previous backup.
-# A common backup scheme is to do a full backup on the weekend when no one is in the office, with
-# incremental backups being done each night of the things that changed that day. Incremental backups
-# can even be added to the same tape, without rewinding. To restore a file from backup that was
-# changed recently, it is often quicker to find the most recent version on an incremental tape backup
-# than to have to search all the way through all the files on a long full backup tape. Thus, full
-# backups tend to be done once a week only with incrementals in between.
-
-# /Add***jbw
-
-# Delete***jbw
-
-# /Delete***jbw
-
-# tar
-
-# tar ("tape archive" isn't just for tapes) is the most commonly used
-# backup utility. 5
-
-# To produce a backup of a directory to a file on the disk (e.g. in /tmp):
-
-# tar cvf /tmp/foo.tar . (output file by default is /dev/tape, so
-# the output file name must be specified
-# with the f option; here, /tmp/foo.tar)
-
-# c option = Create archive (wrap it up
-# into a "tar archive")
-
-# v option = "verbose" - messages to screen
-# when reading/writing each file
-
-# f option = specify output file name
-
-# /tmp/foo.tar = output file name specified
-
-# . = source directory to create archive of
-# (wraps up everything under the
-# current directory)
-
-# addition of the "z" option will gzip the output file to compress it into gzip format:
-
-# tar cvzf /tmp/foo.tar.gz
-
-# To move a directory:
-
-# cd fromdir; tar cvf - . | (cd todir; tar xvf -)
-
-# To unpack an archive of a directory:
-
-# cd destdir; tar xvf /tmp/foo.tar 6
-
-# Further tar options:
-
-# *
-
-# x option = eXtract archive
-# it will unpack it into the current default dir (so, first: cd destdir)
-# *
-
-# v option = verbose
-# Can be included with any other options (good to always include this flag)
-# *
-
-# f option + file name = specify the INPUT file name
-# (the name of the archive file being extracted).
-
-# "Incremental" backup with tar:
-
-# tar -cvf tarfilename --after-date="sept 1, 2000" /home
-
-# Add***jbw
-
-# dump
-
-# Dump is used to backup complete file systems, such as /, /home, or whatever file systems you have
-# defined. (File systems are listed in the file: /etc/fstab). Dump works on one file system at a time.
-
-# Dump has the concept of a dump "level", which is indicated by a non-negative integer, usually 0-6.
-# Level 0 dumps would be a full backup (of the specified file systems, which might be partial or
-# complete depending on whether all file systems are specified). Level 1 and higher dumps are used
-# for "incremental" backups. A level 1 dump will backup files which have changed (been "touched")
-# since the last level 0 dump. A level 2 dump will backup anything changed since the last level 1
-# dump. This scheme can be used to produce a full backup on weekend (level 0 dump), followed by
-# a level n dump, where n is the day of the week (Monday = 1).
-
-# The other important dump parameter is "-f", which refers to the "file" or device to dump to.
-# Thus, the dump backup of a file system can be written to a disk drive (in another file system)
-# or to a tape drive or a zip drive. In the case of a tape drive, the file name is the special
-# character device name: /dev/rmt0 or /dev/nrmt0 ("no-rewind" tape device) or /dev/tape or whatever
-# the device name of your tape drive.
-
-# A dump is performed as follows:
-
-# dump -0f /dev/rmt0 /filesystemname
-
-# (full backup)
-
-# or,
-
-# dump -2f /dev/nrmt0 /filesystemname
-
-# (incremental, level 2 backup to the no-rewind tape device (don't rewind the tape before or after writing.
-# Just add the backup to the existing tape. This is often done to have incremental backups added to the same tape).
-
-# To extract files from a dump backup, use the utility: restore
-
-# Restores can be done "interactively":
-
-# restore -i
-
-# Dump/restore to be continued...
-
-# cpio
-# CPIO is another system backup utility. The rpm package installation utility actually uses cpio
-# format to package software for system installation.
-
-# CPIO - to be continued
-
-# 1This actually reads like, not a "backups HOWTO", but a "backups using tar HOWTO". You mention
-# other archiving utilities, but don't explain how to use them, and also don't explain why tar
-# is used in this document instead of the others.
-
-# ***jbw: I haven't gotten around to writing the details on how to for dump, cpio. Sorry. I'll work
-# on it. This doc is definitely not just a tar howto (heh, I use dump myself, most often, even
-# though some duluggers call dump "evil" under linux).
-
-# 2What does each utility do? Sure, tar means "tape archiver", which is alluded to later; what about the others?
-
-# 3Is this a list that is incomplete, and the author will add to it later? Why the ellipsis?
-# ***jbw - Right! List is incomplete and to be finished later. I did add to the list, parenthetically,
-# but I didn't describe those additions. (e.g. find + dd is a two-step method: find ... | dd ...)
-
-# 4It would be helpful to explain the difference between the two. For example:
-# A full backup makes an archive of the entire contents of a user's... hard drive? Filesystem? Home directory?
-# An incremental backup only includes those parts of the... hard drive? Filesystem? Home directory? ...which
-# have changed since the last time a backup was made.
-
-# ***jbw
-
-# I added the paragraphs describing full, partial, and incremental backups, and I explained the strategy of
-# how they are used (full once a week, incrementals every night) and why such a strategy is used (easier to
-# find one file to be restored from an incremental backup tape, which will have many fewer files written).
-
-# 5Any particular reason this section is pre-formatted?
-# YES!!! As with anything that's sort of a "man page" or a real, live, .conf file, it's often done with
-
-# tag. That is quite intentional to
-# get things formatted in an easily readable format without too much work!
-# The
-
-# tag is intentional here. It is even desirable here,
-# WITHOUT quot or footnote or other tags!!! It's sort of comparable to
-# getting a screen shot to show exactly how something is seen.
-
-
-# 6This is the only part of the HOWTO that actually shows "HOW TO" do something. Even so, the reasons
-# why you'd want to do this aren't explained.
-
-#__________________
-
-# fixme use incremental backup
-#tar -cvf tarfilename --after-date="sept 1, 2000" /home
-# tar -cf archive.tar --newer="`date -r file`" /home
-# algo: liste des fichiers du meme nom, on prend le dernier puis on applique le tar ci-dessus.
-# faire fonctions qui retourne le plus recent element.
-
-
-# tar cvzf ~/toto.tar.gz `find . -name "*" `
-# find / -mtime -1 \! -type d -print > /tmp/liste.jour
-# man find:
-#-newer fichier
-# Fichier modifié plus récemment que le fichier indiqué. L'option -newer n'est affectée par l'option -follow que si
-# celle-ci la précède sur la ligne de commande.
-
pan>],$_[2]); $_[0] } sub gtkset_justify($$) { $_[0]->set_justify($_[1]); $_[0] } sub gtkset_active($$) { $_[0]->set_active($_[1]); $_[0] } sub gtksignal_connect($@) { my $w = shift; $w->signal_connect(@_); $w } sub gtkpack($@) { my $box = shift; gtkpack_($box, map {; 1, $_ } @_); } sub gtkpack__($@) { my $box = shift; gtkpack_($box, map {; 0, $_ } @_); } sub gtkpack_($@) { my $box = shift; for (my $i = 0; $i < @_; $i += 2) { my $l = $_[$i + 1]; ref $l or $l = new Gtk::Label($l); $box->pack_start($l, $_[$i], 1, 0); $l->show; } $box } sub gtkappend($@) { my $w = shift; foreach (@_) { my $l = $_; ref $l or $l = new Gtk::Label($l); $w->append($l); $l->show; } $w } sub gtkadd($@) { my $w = shift; foreach (@_) { my $l = $_; ref $l or $l = new Gtk::Label($l); $w->add($l); $l->show; } $w } sub gtktext_insert($$) { my ($w, $t) = @_; $w->freeze; $w->backward_delete($w->get_length); $w->insert(undef, undef, undef, "$t\n"); #- needs \n otherwise in case of one line text the beginning is not shown (even with the vadj->set_value) $w->set_word_wrap(1); #- $w->vadj->set_value(0); $w->thaw; $w; } sub gtkroot { Gtk->init; Gtk->set_locale; Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW); } sub gtkcolor($$$) { my ($r, $g, $b) = @_; my $color = bless { red => $r, green => $g, blue => $b }, 'Gtk::Gdk::Color'; gtkroot()->get_colormap->color_alloc($color); } sub gtkset_mousecursor($) { my ($type) = @_; gtkroot()->set_cursor(Gtk::Gdk::Cursor->new($type)); } sub gtkset_background { my ($r, $g, $b) = @_; my $root = gtkroot(); my $gc = Gtk::Gdk::GC->new($root); my $color = gtkcolor($r, $g, $b); $gc->set_foreground($color); $root->set_background($color); my ($h, $w) = $root->get_size; $root->draw_rectangle($gc, 1, 0, 0, $w, $h); } sub gtkset_default_fontset($) { my ($fontset) = @_; my $style = Gtk::Widget->get_default_style; my $f = Gtk::Gdk::Font->fontset_load($fontset) or die ''; $style->font($f); Gtk::Widget->set_default_style($style); } sub gtkcreate_xpm { my $w = shift; Gtk::Gdk::Pixmap->create_from_xpm($w->window, $w->style->bg('normal'), @_) } sub xpm_d { my $w = shift; Gtk::Gdk::Pixmap->create_from_xpm_d($w->window, undef, @_) } sub gtkxpm { new Gtk::Pixmap(gtkcreate_xpm(@_)) } #-############################################################################### #- createXXX functions #- these functions return a widget #-############################################################################### sub create_okcancel($;$$) { my ($w, $ok, $cancel) = @_; gtkadd(create_hbox(), gtksignal_connect($w->{ok} = new Gtk::Button($ok || _("Ok")), "clicked" => $w->{ok_clicked} || sub { $w->{retval} = 1; Gtk->main_quit }), ($ok xor $cancel) ? () : gtksignal_connect(new Gtk::Button($cancel || _("Cancel")), "clicked" => $w->{cancel_clicked} || sub { $w->{retval} = 0; Gtk->main_quit }), ); } sub create_box_with_title($@) { my $o = shift; my $nb_lines = map { split "\n" } @_; $o->{box} = (@_ <= 2 && $nb_lines > 4) ? gtkpack(new Gtk::VBox(0,0), gtkset_usize(createScrolledWindow(gtktext_insert(new Gtk::Text, join "\n", @_)), 400, min(250, $nb_lines * 20))) : gtkpack_(new Gtk::VBox(0,0), (map { my $w = ref $_ ? $_ : new Gtk::Label($_); $w->set_name("Title"); 0, $w; } map { ref $_ ? $_ : warp_text($_) } @_), 0, new Gtk::HSeparator, ); } sub createScrolledWindow($) { my ($W) = @_; my $w = new Gtk::ScrolledWindow(undef, undef); $w->set_policy('automatic', 'automatic'); member(ref $W, qw(Gtk::CList Gtk::CTree Gtk::Text)) ? $w->add($W) : $w->add_with_viewport($W); $W->can("set_focus_vadjustment") and $W->set_focus_vadjustment($w->get_vadjustment); $W->show; $w } sub create_menu($@) { my $title = shift; my $w = new Gtk::MenuItem($title); $w->set_submenu(gtkshow(gtkappend(new Gtk::Menu, @_))); $w } sub add2notebook { my ($n, $title, $book) = @_; my ($w1, $w2) = map { new Gtk::Label($_) } $title, $title; $book->{widget_title} = $w1; $n->append_page_menu($book, $w1, $w2); $book->show; $w1->show; $w2->show; } sub create_notebook(@) { my $n = new Gtk::Notebook; add2notebook($n, splice(@_, 0, 2)) while @_; $n } sub create_adjustment($$$) { my ($val, $min, $max) = @_; new Gtk::Adjustment($val, $min, $max + 1, 1, ($max - $min + 1) / 10, 1); } sub create_packtable($@) { my $options = shift; my $w = new Gtk::Table(0, 0, $options->{homogeneous} || 0); map_index { my ($i) = @_; map_index { my ($j) = @_; if (defined $_) { ref $_ or $_ = new Gtk::Label($_); $w->attach_defaults($_, $j, $j + 1, $i, $i + 1); $_->show; } } @$_; } @_; $w->set_col_spacings($options->{col_spacings} || 0); $w->set_row_spacings($options->{row_spacings} || 0); $w } sub create_hbox { my $w = new Gtk::HButtonBox; $w->set_layout(-spread); $w; } sub create_vbox { my $w = new Gtk::VButtonBox; $w->set_layout(-spread); $w; } sub _create_window($$) { my ($o, $title) = @_; my $w = new Gtk::Window; my $f = new Gtk::Frame(undef); $w->set_name("Title"); if ($::isStandalone || $o->{no_border} || 1) { # hack gtkadd($w, $f); } else { my $t = new Gtk::Table(0, 0, 0); my $new = sub { my $w = new Gtk::DrawingArea; $w->set_usize($border, $border); $w->set_events(['exposure_mask']); $w->signal_connect_after(expose_event => sub { $w->window->draw_rectangle($w->style->black_gc, 1, 0, 0, @{$w->allocation}[2,3]); 1 } ); $w->show; $w; }; $t->attach(&$new(), 0, 1, 0, 3, [], , ["expand","fill"], 0, 0); $t->attach(&$new(), 1, 2, 0, 1, ["expand","fill"], [], 0, 0); $t->attach($f, 1, 2, 1, 2, ["expand","fill"], ["expand","fill"], 0, 0); $t->attach(&$new(), 1, 2, 2, 3, ["expand","fill"], [], 0, 0); $t->attach(&$new(), 2, 3, 0, 3, [], ["expand","fill"], 0, 0); gtkadd($w, $t); } $w->set_title($title); $w->signal_connect(expose_event => sub { c::XSetInputFocus($w->window->XWINDOW); }) if $my_gtk::force_focus || $o->{force_focus}; $w->signal_connect(delete_event => sub { undef $o->{retval}; Gtk->main_quit }); $w->set_uposition(@{$my_gtk::force_position || $o->{force_position}}) if $my_gtk::force_position || $o->{force_position}; $w->signal_connect(focus => sub { Gtk->idle_add(sub { $w->ensure_focus($_[0]); 0 }, $_[1]) }) if $w->can('ensure_focus'); if ($::o->{mouse}{unsafe}) { $w->set_events("pointer_motion_mask"); my $signal; $signal = $w->signal_connect(motion_notify_event => sub { delete $::o->{mouse}{unsafe}; log::l("unsetting unsafe mouse"); $w->signal_disconnect($signal); }); } $w->signal_connect(key_press_event => sub { my $d = ${{ 65470 => 'help', 65481 => 'next', 65480 => 'previous' }}{$_[1]->{keyval}} or return; #- previous field is created here :( my $s; foreach (reverse @{$::o->{orderedSteps}}) { $s->{previous} = $_ if $s; $s = $::o->{steps}{$_}; } if ($d eq "help") { require install_steps_gtk; install_steps_gtk::create_big_help(); } else { my $s = $::o->{step}; do { $s = $::o->{steps}{$s}{$d} } until !$s || $::o->{steps}{$s}{reachable}; $::setstep && $s and die "setstep $s\n"; } }) unless $::isStandalone; $w->signal_connect(size_allocate => sub { my ($wi, $he) = @{$_[1]}[2,3]; my ($X, $Y, $Wi, $He) = @{$my_gtk::force_center || $o->{force_center}}; $w->set_uposition(max(0, $X + ($Wi - $wi) / 2), max(0, $Y + ($He - $he) / 2)); }) if ($my_gtk::force_center || $o->{force_center}) && !($my_gtk::force_position || $o->{force_position}) ; $o->{window} = $f; $o->{rwindow} = $w; } my ($next_child, $left, $right, $up, $down); { my $next_child = sub { my ($c, $dir) = @_; my @childs = $c->parent->children; my $i; for ($i = 0; $i < @childs; $i++) { last if $childs[$i] == $c || $childs[$i]->subtree == $c; } $i += $dir; 0 <= $i && $i < @childs ? $childs[$i] : undef; }; $left = sub { &$next_child($_[0]->parent, 0); }; $right = sub { my ($c) = @_; if ($c->subtree) { $c->expand; ($c->subtree->children)[0]; } else { $c; } }; $down = sub { my ($c) = @_; return &$right($c) if ref $c eq "Gtk::TreeItem" && $c->subtree && $c->expanded; if (my $n = &$next_child($c, 1)) { $n; } else { return if ref $c->parent ne 'Gtk::Tree'; &$down($c->parent); } }; $up = sub { my ($c) = @_; if (my $n = &$next_child($c, -1)) { $n = ($n->subtree->children)[-1] while ref $n eq "Gtk::TreeItem" && $n->subtree && $n->expanded; $n; } else { return if ref $c->parent ne 'Gtk::Tree'; &$left($c); } }; } sub create_treeitem($) { my ($name) = @_; my $w = new Gtk::TreeItem($name); $w->signal_connect(key_press_event => sub { my (undef, $e) = @_; local $_ = chr ($e->{keyval}); if ($e->{keyval} > 0x100) { my $n; $n = &$left($w) if /[Q´\x96]/; $n = &$right($w) if /[S¶\x98]/; $n = &$up($w) if /[R¸\x97]/; $n = &$down($w) if /[T²\x99]/; if ($n) { $n->focus('up'); $w->signal_emit_stop("key_press_event"); } $w->expand if /[+«]/; $w->collapse if /[-\xad]/; do { $w->expanded ? $w->collapse : $w->expand; $w->signal_emit_stop("key_press_event"); } if /[\r\x8d]/; } 1; }); $w; } #-############################################################################### #- ask_XXX #- just give a title and some args, and it will return the value given by the user #-############################################################################### sub ask_warn { my $w = my_gtk->new(shift @_); $w->_ask_warn(@_); main($w); } sub ask_yesorno { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, _("Yes"), _("No")); main($w); } sub ask_okcancel { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, _("Is this correct?"), _("Ok"), _("Cancel")); main($w); } sub ask_from_entry { my $w = my_gtk->new(shift @_); $w->_ask_from_entry(@_); main($w); } sub ask_from_list { my $w = my_gtk->new($_[0]); $w->_ask_from_list(@_); main($w); } sub ask_file { my $w = my_gtk->new(''); $w->_ask_file(@_); main($w); } sub _ask_from_entry($$@) { my ($o, @msgs) = @_; my $entry = new Gtk::Entry; my $f = sub { $o->{retval} = $entry->get_text; Gtk->main_quit }; $o->{ok_clicked} = $f; $o->{cancel_clicked} = sub { undef $o->{retval}; Gtk->main_quit }; gtkadd($o->{window}, gtkpack($o->create_box_with_title(@msgs), gtksignal_connect($entry, 'activate' => $f), ($o->{hide_buttons} ? () : create_okcancel($o))), ); $entry->grab_focus; } sub _ask_from_list { my ($o, $title, $messages, $l, $def) = @_; my (undef, @okcancel) = ref $title ? @$title : $title; my $list = new Gtk::CList(1); my ($first_time, $starting_word, $start_reg) = (1, '', "^"); my (@widgets, $timeout, $curr); my $leave = sub { $o->{retval} = $l->[$curr]; Gtk->main_quit }; my $select = sub { $list->set_focus_row($_[0]); $list->select_row($_[0], 0); $list->moveto($_[0], 0, 0.5, 0); }; ref $title && !@okcancel ? $list->signal_connect(button_release_event => $leave) : $list->signal_connect(button_press_event => sub { &$leave if $_[1]{type} =~ /^2/ }); $list->signal_connect(select_row => sub { my ($w, $row, undef, $e) = @_; $curr = $row; }); $list->signal_connect(key_press_event => sub { my ($w, $e) = @_; my $c = chr($e->{keyval} & 0xff); Gtk->timeout_remove($timeout) if $timeout; $timeout = ''; if ($e->{keyval} >= 0x100) { &$leave if $c eq "\r" || $c eq "\x8d"; $starting_word = '' if $e->{keyval} != 0xffe4; # control } else { if ($e->{state} & 4) { #- control pressed $c eq "s" or return 1; $start_reg and $start_reg = '', return 1; $curr++; } else { &$leave if $c eq ' '; $curr++ if $starting_word eq '' || $starting_word eq $c; $starting_word .= $c unless $starting_word eq $c; } my $word = quotemeta $starting_word; my $j; for ($j = 0; $j < @$l; $j++) { $l->[($j + $curr) % @$l] =~ /$start_reg$word/i and last; } $j == @$l ? $starting_word = '' : &$select(($j + $curr) % @$l); $w->{timeout} = $timeout = Gtk->timeout_add($forgetTime, sub { $timeout = $starting_word = ''; 0 } ); } 1; }); $list->set_selection_mode('browse'); $list->set_column_auto_resize(0, 1); $o->{ok_clicked} = $leave; $o->{cancel_clicked} = sub { $o->destroy; die "ask_from_list cancel" }; #- make sure windows doesn't live any more. gtkadd($o->{window}, gtkpack($o->create_box_with_title(@$messages), gtkpack_(new Gtk::VBox(0,7), 1, @$l > 15 ? gtkset_usize(createScrolledWindow($list), 200, min(350, $::windowheight - 60)) : $list, @okcancel || !ref $title ? (0, create_okcancel($o, @okcancel)) : ()) )); $o->show; #- otherwise the moveto is not done my $toselect; map_index { $list->append($_); $toselect = $::i if $def && $_ eq $def; } @$l; &$select($toselect); $list->grab_focus; } sub _ask_from_list_with_help { my ($o, $title, $messages, $l, $help, $def) = @_; my (undef, @okcancel) = ref $title ? @$title : $title; my $list = new Gtk::List(); my ($first_time, $starting_word, $start_reg) = (1, '', "^"); my (@widgets, $timeout, $curr); my $leave = sub { $o->{retval} = $l->[$curr]; Gtk->main_quit }; my $select = sub { $list->select_item($_[0]); }; ref $title && !@okcancel ? $list->signal_connect(button_release_event => $leave) : $list->signal_connect(button_press_event => sub { &$leave if $_[1]{type} =~ /^2/ }); $list->signal_connect(select_child => sub { my ($w, $row) = @_; $curr = $list->child_position($row); }); $list->signal_connect(key_press_event => sub { my ($w, $e) = @_; my $c = chr($e->{keyval} & 0xff); Gtk->timeout_remove($timeout) if $timeout; $timeout = ''; if ($e->{keyval} >= 0x100) { &$leave if $c eq "\r" || $c eq "\x8d"; $starting_word = '' if $e->{keyval} != 0xffe4; # control } else { if ($e->{state} & 4) { #- control pressed $c eq "s" or return 1; $start_reg and $start_reg = '', return 1; $curr++; } else { &$leave if $c eq ' '; $curr++ if $starting_word eq '' || $starting_word eq $c; $starting_word .= $c unless $starting_word eq $c; } my $word = quotemeta $starting_word; my $j; for ($j = 0; $j < @$l; $j++) { $l->[($j + $curr) % @$l] =~ /$start_reg$word/i and last; } $j == @$l ? $starting_word = '' : &$select(($j + $curr) % @$l); $w->{timeout} = $timeout = Gtk->timeout_add($forgetTime, sub { $timeout = $starting_word = ''; 0 } ); } 1; }); $o->{ok_clicked} = $leave; $o->{cancel_clicked} = sub { $o->destroy; die "ask_from_list cancel" }; #- make sure windows doesn't live any more. gtkadd($o->{window}, gtkpack($o->create_box_with_title(@$messages), gtkpack_(new Gtk::VBox(0,7), 1, @$l > 15 ? gtkset_usize(createScrolledWindow($list), 200, min(350, $::windowheight - 60)) : $list, @okcancel || !ref $title ? (0, create_okcancel($o, @okcancel)) : ()) )); $o->show; #- otherwise the moveto is not done my $tips = new Gtk::Tooltips; my $toselect; map_index { my $item = new Gtk::ListItem($_); $list->append_items($item); $tips->set_tip($item, $help->{$_}) if $help->{$_}; $item->show; $toselect = $::i if $def && $_ eq $def; } @$l; &$select($toselect); $list->grab_focus; } sub _ask_warn($@) { my ($o, @msgs) = @_; gtkadd($o->{window}, gtkpack($o->create_box_with_title(@msgs), gtksignal_connect(my $w = new Gtk::Button(_("Ok")), "clicked" => sub { Gtk->main_quit }), ), ); $w->grab_focus; } sub _ask_okcancel($@) { my ($o, @msgs) = @_; my ($ok, $cancel) = splice @msgs, -2; gtkadd($o->{window}, gtkpack(create_box_with_title($o, @msgs), create_okcancel($o, $ok, $cancel), ) ); $o->{ok}->grab_focus; } sub _ask_file($$) { my ($o, $title) = @_; my $f = $o->{rwindow} = new Gtk::FileSelection $title; $f->ok_button->signal_connect(clicked => sub { $o->{retval} = $f->get_filename ; Gtk->main_quit }); $f->cancel_button->signal_connect(clicked => sub { Gtk->main_quit }); $f->hide_fileop_buttons; } #-############################################################################### #- rubbish #-############################################################################### #-sub label_align($$) { #- my $w = shift; #- local $_ = shift; #- $w->set_alignment(!/W/i, !/N/i); #- $w #-}