diff options
| author | Manuel Traut <manut@mecka.net> | 2013-03-10 12:13:49 +0100 |
|---|---|---|
| committer | Manuel Traut <manut@mecka.net> | 2013-03-10 12:13:49 +0100 |
| commit | 9c0f862749f30800837a45aff5abdcb529867dbc (patch) | |
| tree | b0ca51fff64f12fac03aea4afaa1fa722376844b /beagle/debian-rfs/usr/share/perl5 | |
| parent | 33b79c725448efd2c9a72e2ae9a1fb04270492f5 (diff) | |
| parent | cea5039322781f6085dd47954af5584ca3f78911 (diff) | |
Merge branch 'schulung'
updates from current linutronix schulung.git
Conflicts:
Makefile
configpres.tex
flash-memory/ubi/handout_ubi_de.tex
handout.tex
index.txt
pres_master.tex
vorl.tex
vorl1.tex
vorl2.tex
vorl3.tex
vorl4.tex
vorl5.tex
Signed-off-by: Manuel Traut <manut@mecka.net>
Diffstat (limited to 'beagle/debian-rfs/usr/share/perl5')
114 files changed, 0 insertions, 9053 deletions
diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/AutoSelect.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/AutoSelect.pm deleted file mode 100644 index db4b704..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/AutoSelect.pm +++ /dev/null @@ -1,77 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::AutoSelect; -use strict; -use Debconf::Gettext; -use Debconf::ConfModule; -use Debconf::Config; -use Debconf::Log qw(:all); -use base qw(Exporter); -our @EXPORT_OK = qw(make_frontend make_confmodule); -our %EXPORT_TAGS = (all => [@EXPORT_OK]); - - -my %fallback=( - 'Kde' => ['Dialog', 'Readline', 'Teletype'], - 'Gnome' => ['Dialog', 'Readline', 'Teletype'], - 'Web' => ['Dialog', 'Readline', 'Teletype'], - 'Dialog' => ['Readline', 'Teletype'], - 'Gtk' => ['Dialog', 'Readline', 'Teletype'], - 'Readline' => ['Teletype', 'Dialog'], - 'Editor' => ['Readline', 'Teletype'], - 'Slang' => ['Dialog', 'Readline', 'Teletype'], - 'Text' => ['Readline', 'Teletype', 'Dialog'], - -); - -my $frontend; -my $type; - - -sub make_frontend { - my $script=shift; - my $starttype=ucfirst($type) if defined $type; - if (! defined $starttype || ! length $starttype) { - $starttype = Debconf::Config->frontend; - if ($starttype =~ /^[A-Z]/) { - warn "Please do not capitalize the first letter of the debconf frontend."; - } - $starttype=ucfirst($starttype); - } - - my $showfallback=0; - foreach $type ($starttype, @{$fallback{$starttype}}, 'Noninteractive') { - if (! $showfallback) { - debug user => "trying frontend $type"; - } - else { - warn(sprintf(gettext("falling back to frontend: %s"), $type)); - } - $frontend=eval qq{ - use Debconf::FrontEnd::$type; - Debconf::FrontEnd::$type->new(); - }; - return $frontend if defined $frontend; - - warn sprintf(gettext("unable to initialize frontend: %s"), $type); - $@=~s/\n.*//s; - warn "($@)"; - $showfallback=1; - } - - die sprintf(gettext("Unable to start a frontend: %s"), $@); -} - - -sub make_confmodule { - my $confmodule=Debconf::ConfModule->new(frontend => $frontend); - - $confmodule->startup(@_) if @_; - - return $confmodule; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Base.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Base.pm deleted file mode 100644 index 11143c9..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Base.pm +++ /dev/null @@ -1,39 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Base; -use Debconf::Log ':all'; -use strict; - - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $this=bless ({@_}, $class); - $this->init; - return $this; -} - - -sub init {} - - -sub AUTOLOAD { - (my $field = our $AUTOLOAD) =~ s/.*://; - - no strict 'refs'; - *$AUTOLOAD = sub { - my $this=shift; - - return $this->{$field} unless @_; - return $this->{$field}=shift; - }; - goto &$AUTOLOAD; -} - -sub DESTROY { -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Client/ConfModule.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Client/ConfModule.pm deleted file mode 100644 index 30bd2d9..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Client/ConfModule.pm +++ /dev/null @@ -1,164 +0,0 @@ -#!/usr/bin/perl -w - -=head1 NAME - -Debconf::Client::ConfModule - client module for ConfModules - -=head1 SYNOPSIS - - use Debconf::Client::ConfModule ':all'; - version('2.0'); - my $capb=capb('backup'); - input("medium", "foo/bar"); - my @ret=go(); - if ($ret[0] == 30) { - # Back button pressed. - ... - } - ... - -=head1 DESCRIPTION - -This is a module to ease writing ConfModules for Debian's configuration -management system. It can communicate with a FrontEnd via the debconf -protocol (which is documented in full in the debconf_specification in -Debian policy). - -The design is that each command in the protocol is represented by one -function in this module (with the name lower-cased). Call the function and -pass in any parameters you want to follow the command. If the function is -called in scalar context, it will return any textual return code. If it is -called in list context, an array consisting of the numeric return code and -the textual return code will be returned. - -This module uses Exporter to export all functions it defines. To import -everything, simply import ":all". - -=over 4 - -=cut - -package Debconf::Client::ConfModule; -use strict; -use base qw(Exporter); - -# List all valid commands here. -our @EXPORT_OK=qw(version capb stop reset title input beginblock endblock go - unset set get register unregister clear previous_module - start_frontend fset fget subst purge metaget visible exist - settitle info progress data x_loadtemplatefile); - -# Import :all to get everything. -our %EXPORT_TAGS = (all => [@EXPORT_OK]); - -# Set up valid command lookup hash. -my %commands; -map { $commands{uc $_}=1; } @EXPORT_OK; - -# Unbuffered output is required. -$|=1; - -=item import - -Ensure that a FrontEnd is running. It's a little hackish. If -DEBIAN_HAS_FRONTEND is set, a FrontEnd is assumed to be running. -If not, one is started up automatically and stdin and out are -connected to it. Note that this function is always run when the -module is loaded in the usual way. - -=cut - -sub import { - if (! $ENV{DEBIAN_HAS_FRONTEND}) { - $ENV{PERL_DL_NONLAZY}=1; - if (exists $ENV{DEBCONF_USE_CDEBCONF} and - $ENV{DEBCONF_USE_CDEBCONF} ne '') { - exec "/usr/lib/cdebconf/debconf", $0, @ARGV; - } else { - exec "/usr/share/debconf/frontend", $0, @ARGV; - } - } - - # Make the Exporter still work. - Debconf::Client::ConfModule->export_to_level(1, @_); - - # A truly gross hack. This is only needed if - # /usr/share/debconf/confmodule is loaded, and then this - # perl module is used. In that case, this module needs to write - # to fd #3, rather than stdout. See changelog 0.3.74. - if (exists $ENV{DEBCONF_REDIR} && $ENV{DEBCONF_REDIR}) { - open(STDOUT,">&3"); - } -} - -=item stop - -The frontend doesn't send a return code here, so we cannot try to read it -or we'll block. - -=cut - -sub stop { - print "STOP\n"; - return; -} - -=item AUTOLOAD - -Creates handler functions for commands on the fly. - -=cut - -sub AUTOLOAD { - my $command = uc our $AUTOLOAD; - $command =~ s|.*:||; # strip fully-qualified portion - - die "Unsupported command `$command'." - unless $commands{$command}; - - no strict 'refs'; - *$AUTOLOAD = sub { - my $c=join (' ', $command, @_); - - # Newlines in input can really badly confuse the protocol, so - # detect and warn. - if ($c=~m/\n/) { - warn "Warning: Newline present in parameters passed to debconf.\n"; - warn "This will probably cause strange things to happen!\n"; - } - - print "$c\n"; - my $ret=<STDIN>; - chomp $ret; - my @ret=split(/\s/, $ret, 2); - if ($ret[0] eq '1') { - # escaped data - local $_; - my $unescaped=''; - for (split /(\\.)/, $ret[1]) { - s/\\(.)/$1 eq "n" ? "\n" : $1/eg; - $unescaped.=$_; - } - $ret[0]='0'; - $ret[1]=$unescaped; - } - return @ret if wantarray; - return $ret[1]; - }; - goto &$AUTOLOAD; -} - -=back - -=head1 SEE ALSO - -The debconf specification -(/usr/share/doc/debian-policy/debconf_specification.txt.gz). - -=head1 AUTHOR - -Joey Hess <joeyh@debian.org> - -=cut - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/ConfModule.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/ConfModule.pm deleted file mode 100644 index d66a09c..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/ConfModule.pm +++ /dev/null @@ -1,669 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::ConfModule; -use strict; -use IPC::Open2; -use FileHandle; -use Debconf::Gettext; -use Debconf::Config; -use Debconf::Question; -use Debconf::Priority qw(priority_valid high_enough); -use Debconf::FrontEnd::Noninteractive; -use Debconf::Log ':all'; -use Debconf::Encoding; -use base qw(Debconf::Base); - - -my %codes = ( - success => 0, - escaped_data => 1, - badparams => 10, - syntaxerror => 20, - input_invisible => 30, - version_bad => 30, - go_back => 30, - progresscancel => 30, - internalerror => 100, -); - - -sub init { - my $this=shift; - - $this->version("2.0"); - - $this->owner('unknown') if ! defined $this->owner; - - $this->frontend->capb_backup(''); - - $this->seen([]); - $this->busy([]); - - $ENV{DEBIAN_HAS_FRONTEND}=1; -} - - -sub startup { - my $this=shift; - my $confmodule=shift; - - $this->frontend->clear; - $this->busy([]); - - my @args=$this->confmodule($confmodule); - push @args, @_ if @_; - - debug developer => "starting ".join(' ',@args); - $this->pid(open2($this->read_handle(FileHandle->new), - $this->write_handle(FileHandle->new), - @args)) || die $!; - - $this->caught_sigpipe(''); - $SIG{PIPE}=sub { $this->caught_sigpipe(128) }; -} - - -sub communicate { - my $this=shift; - - my $r=$this->read_handle; - $_=<$r> || return $this->finish; - chomp; - my $ret=$this->process_command($_); - my $w=$this->write_handle; - print $w $ret."\n"; - return '' unless length $ret; - return 1; -} - - -sub escape { - my $text=shift; - $text=~s/\\/\\\\/g; - $text=~s/\n/\\n/g; - return $text; -} - - -sub unescape_split { - my $text=shift; - my @words; - my $word=''; - for my $chunk (split /(\\.|\s+)/, $text) { - if ($chunk eq '\n') { - $word.="\n"; - } elsif ($chunk=~/^\\(.)$/) { - $word.=$1; - } elsif ($chunk=~/^\s+$/) { - push @words, $word; - $word=''; - } else { - $word.=$chunk; - } - } - push @words, $word if $word ne ''; - return @words; -} - - -sub process_command { - my $this=shift; - - debug developer => "<-- $_"; - return 1 unless defined && ! /^\s*#/; # Skip blank lines, comments. - chomp; - my ($command, @params); - if (defined $this->client_capb and grep { $_ eq 'escape' } @{$this->client_capb}) { - ($command, @params)=unescape_split($_); - } else { - ($command, @params)=split(' ', $_); - } - $command=lc($command); - if (lc($command) eq "stop") { - return $this->finish; - } - if (! $this->can("command_$command")) { - return $codes{syntaxerror}.' '. - "Unsupported command \"$command\" (full line was \"$_\") received from confmodule."; - } - $command="command_$command"; - my $ret=join(' ', $this->$command(@params)); - debug developer => "--> $ret"; - if ($ret=~/\n/) { - debug developer => 'Warning: return value is multiline, and would break the debconf protocol. Truncating to first line.'; - $ret=~s/\n.*//s; - debug developer => "--> $ret"; - } - return $ret; -} - - -sub finish { - my $this=shift; - - waitpid $this->pid, 0 if defined $this->pid; - $this->exitcode($this->caught_sigpipe || ($? >> 8)); - - $SIG{PIPE} = sub {}; - - foreach (@{$this->seen}) { - my $q=Debconf::Question->get($_->name); - $_->flag('seen', 'true') if $q; - } - $this->seen([]); - - return ''; -} - - -sub command_input { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 2; - my $priority=shift; - my $question_name=shift; - - my $question=Debconf::Question->get($question_name) || - return $codes{badparams}, "\"$question_name\" doesn't exist"; - - if (! priority_valid($priority)) { - return $codes{syntaxerror}, "\"$priority\" is not a valid priority"; - } - - $question->priority($priority); - - my $visible=1; - - if ($question->type ne 'error') { - $visible='' unless high_enough($priority); - - $visible='' if ! Debconf::Config->reshow && - $question->flag('seen') eq 'true'; - } - - my $markseen=$visible; - - if ($visible && ! $this->frontend->interactive) { - $visible=''; - $markseen='' unless Debconf::Config->noninteractive_seen eq 'true'; - } - - my $element; - if ($visible) { - $element=$this->frontend->makeelement($question); - unless ($element) { - return $codes{internalerror}, - "unable to make an input element"; - } - - $visible=$element->visible; - } - - if (! $visible) { - $element=Debconf::FrontEnd::Noninteractive->makeelement($question, 1); - - return $codes{input_invisible}, "question skipped" unless $element; - } - - $element->markseen($markseen); - - push @{$this->busy}, $question_name; - - $this->frontend->add($element); - if ($element->visible) { - return $codes{success}, "question will be asked"; - } - else { - return $codes{input_invisible}, "question skipped"; - } -} - - -sub command_clear { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 0; - - $this->frontend->clear; - $this->busy([]); - return $codes{success}; -} - - -sub command_version { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ > 1; - my $version=shift; - if (defined $version) { - return $codes{version_bad}, "Version too low ($version)" - if int($version) < int($this->version); - return $codes{version_bad}, "Version too high ($version)" - if int($version) > int($this->version); - } - return $codes{success}, $this->version; -} - - -sub command_capb { - my $this=shift; - $this->client_capb([@_]); - $this->frontend->capb_backup(1) if grep { $_ eq 'backup' } @_; - my @capb=('multiselect', 'escape'); - push @capb, $this->frontend->capb; - return $codes{success}, @capb; -} - - -sub command_title { - my $this=shift; - $this->frontend->title(join ' ', @_); - $this->frontend->requested_title($this->frontend->title); - - return $codes{success}; -} - - -sub command_settitle { - my $this=shift; - - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1; - my $question_name=shift; - - my $question=Debconf::Question->get($question_name) || - return $codes{badparams}, "\"$question_name\" doesn't exist"; - - if ($this->frontend->can('settitle')) { - $this->frontend->settitle($question); - } else { - $this->frontend->title($question->description); - } - $this->frontend->requested_title($this->frontend->title); - - return $codes{success}; -} - - -sub command_beginblock { - return $codes{success}; -} -sub command_endblock { - return $codes{success}; -} - - -sub command_go { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ > 0; - - my $ret=$this->frontend->go; - if ($ret && (! $this->backed_up || - grep { $_->visible } @{$this->frontend->elements})) { - foreach (@{$this->frontend->elements}) { - $_->question->value($_->value); - push @{$this->seen}, $_->question if $_->markseen && $_->question; - } - $this->frontend->clear; - $this->busy([]); - $this->backed_up(''); - return $codes{success}, "ok" - } - else { - $this->frontend->clear; - $this->busy([]); - $this->backed_up(1); - return $codes{go_back}, "backup"; - } -} - - -sub command_get { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1; - my $question_name=shift; - my $question=Debconf::Question->get($question_name) || - return $codes{badparams}, "$question_name doesn't exist"; - - my $value=$question->value; - if (defined $value) { - if (defined $this->client_capb and grep { $_ eq 'escape' } @{$this->client_capb}) { - return $codes{escaped_data}, escape($value); - } else { - return $codes{success}, $value; - } - } - else { - return $codes{success}, ''; - } -} - - -sub command_set { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ < 1; - my $question_name=shift; - my $value=join(" ", @_); - - my $question=Debconf::Question->get($question_name) || - return $codes{badparams}, "$question_name doesn't exist"; - $question->value($value); - return $codes{success}, "value set"; -} - - -sub command_reset { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1; - my $question_name=shift; - - my $question=Debconf::Question->get($question_name) || - return $codes{badparams}, "$question_name doesn't exist"; - $question->value($question->default); - $question->flag('seen', 'false'); - return $codes{success}; -} - - -sub command_subst { - my $this = shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ < 2; - my $question_name = shift; - my $variable = shift; - my $value = (join ' ', @_); - - my $question=Debconf::Question->get($question_name) || - return $codes{badparams}, "$question_name doesn't exist"; - my $result=$question->variable($variable,$value); - return $codes{internalerror}, "Substitution failed" unless defined $result; - return $codes{success}; -} - - -sub command_register { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 2; - my $template=shift; - my $name=shift; - - my $tempobj = Debconf::Question->get($template); - if (! $tempobj) { - return $codes{badparams}, "No such template, \"$template\""; - } - my $question=Debconf::Question->get($name) || - Debconf::Question->new($name, $this->owner, $tempobj->type); - if (! $question) { - return $codes{internalerror}, "Internal error making question"; - } - if (! defined $question->addowner($this->owner, $tempobj->type)) { - return $codes{internalerror}, "Internal error adding owner"; - } - if (! $question->template($template)) { - return $codes{internalerror}, "Internal error setting template"; - } - - return $codes{success}; -} - - -sub command_unregister { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1; - my $name=shift; - - my $question=Debconf::Question->get($name) || - return $codes{badparams}, "$name doesn't exist"; - if (grep { $_ eq $name } @{$this->busy}) { - return $codes{badparams}, "$name is busy, cannot unregister right now"; - } - $question->removeowner($this->owner); - return $codes{success}; -} - - -sub command_purge { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ > 0; - - my $iterator=Debconf::Question->iterator; - while (my $q=$iterator->iterate) { - $q->removeowner($this->owner); - } - - return $codes{success}; -} - - -sub command_metaget { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 2; - my $question_name=shift; - my $field=shift; - - my $question=Debconf::Question->get($question_name) || - return $codes{badparams}, "$question_name doesn't exist"; - my $lcfield=lc $field; - my $fieldval=$question->$lcfield(); - unless (defined $fieldval) { - return $codes{badparams}, "$field does not exist"; - } - if (defined $this->client_capb and grep { $_ eq 'escape' } @{$this->client_capb}) { - return $codes{escaped_data}, escape($fieldval); - } else { - return $codes{success}, $fieldval; - } -} - - -sub command_fget { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 2; - my $question_name=shift; - my $flag=shift; - - my $question=Debconf::Question->get($question_name) || - return $codes{badparams}, "$question_name doesn't exist"; - - return $codes{success}, $question->flag($flag); -} - - -sub command_fset { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ < 3; - my $question_name=shift; - my $flag=shift; - my $value=(join ' ', @_); - - my $question=Debconf::Question->get($question_name) || - return $codes{badparams}, "$question_name doesn't exist"; - - if ($flag eq 'seen') { - $this->seen([grep {$_ ne $question} @{$this->seen}]); - } - - return $codes{success}, $question->flag($flag, $value); -} - - -sub command_info { - my $this=shift; - - if (@_ == 0) { - $this->frontend->info(undef); - } elsif (@_ == 1) { - my $question_name=shift; - - my $question=Debconf::Question->get($question_name) || - return $codes{badparams}, "\"$question_name\" doesn't exist"; - - $this->frontend->info($question); - } else { - return $codes{syntaxerror}, "Incorrect number of arguments"; - } - - return $codes{success}; -} - - -sub command_progress { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ < 1; - my $subcommand=shift; - $subcommand=lc($subcommand); - - my $ret; - - if ($subcommand eq 'start') { - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 3; - my $min=shift; - my $max=shift; - my $question_name=shift; - - return $codes{syntaxerror}, "min ($min) > max ($max)" if $min > $max; - - my $question=Debconf::Question->get($question_name) || - return $codes{badparams}, "$question_name doesn't exist"; - - $this->frontend->progress_start($min, $max, $question); - $ret=1; - } - elsif ($subcommand eq 'set') { - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1; - my $value=shift; - $ret = $this->frontend->progress_set($value); - } - elsif ($subcommand eq 'step') { - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1; - my $inc=shift; - $ret = $this->frontend->progress_step($inc); - } - elsif ($subcommand eq 'info') { - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1; - my $question_name=shift; - - my $question=Debconf::Question->get($question_name) || - return $codes{badparams}, "$question_name doesn't exist"; - - $ret = $this->frontend->progress_info($question); - } - elsif ($subcommand eq 'stop') { - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 0; - $this->frontend->progress_stop(); - $ret=1; - } - else { - return $codes{syntaxerror}, "Unknown subcommand"; - } - - if ($ret) { - return $codes{success}, "OK"; - } - else { - return $codes{progresscancel}, "CANCELED"; - } -} - - -sub command_data { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ < 3; - my $template=shift; - my $item=shift; - my $value=join(' ', @_); - $value=~s/\\([n"\\])/($1 eq 'n') ? "\n" : $1/eg; - - my $tempobj=Debconf::Template->get($template); - if (! $tempobj) { - if ($item ne 'type') { - return $codes{badparams}, "Template data field '$item' received before type field"; - } - $tempobj=Debconf::Template->new($template, $this->owner, $value); - if (! $tempobj) { - return $codes{internalerror}, "Internal error making template"; - } - } else { - if ($item eq 'type') { - return $codes{badparams}, "Template type already set"; - } - $tempobj->$item(Debconf::Encoding::convert("UTF-8", $value)); - } - - return $codes{success}; -} - - -sub command_visible { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 2; - my $priority=shift; - my $question_name=shift; - - my $question=Debconf::Question->get($question_name) || - return $codes{badparams}, "$question_name doesn't exist"; - return $codes{success}, $this->frontend->visible($question, $priority) ? "true" : "false"; -} - - -sub command_exist { - my $this=shift; - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ != 1; - my $question_name=shift; - - return $codes{success}, - Debconf::Question->get($question_name) ? "true" : "false"; -} - - -sub command_x_loadtemplatefile { - my $this=shift; - - return $codes{syntaxerror}, "Incorrect number of arguments" if @_ < 1 || @_ > 2; - - my $file=shift; - my $fh=FileHandle->new($file); - if (! $fh) { - return $codes{badparams}, "failed to open $file: $!"; - } - - my $owner=$this->owner; - if (@_) { - $owner=shift; - } - - eval { - Debconf::Template->load($fh, $owner); - }; - if ($@) { - $@=~s/\n/\\n/g; - return $codes{internalerror}, $@; - } - return $codes{success}; -} - - -sub AUTOLOAD { - (my $field = our $AUTOLOAD) =~ s/.*://; - - no strict 'refs'; - *$AUTOLOAD = sub { - my $this=shift; - - return $this->{$field} unless @_; - return $this->{$field}=shift; - }; - goto &$AUTOLOAD; -} - - -sub DESTROY { - my $this=shift; - - $this->read_handle->close if $this->read_handle; - $this->write_handle->close if $this->write_handle; - - if (defined $this->pid && $this->pid > 1) { - kill 'TERM', $this->pid; - } -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Config.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Config.pm deleted file mode 100644 index 2f17f05..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Config.pm +++ /dev/null @@ -1,293 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Config; -use strict; -use Debconf::Question; -use Debconf::Gettext; -use Debconf::Priority qw(priority_valid priority_list); -use Debconf::Log qw(warn); -use Debconf::Db; - -use fields qw(config templates frontend frontend_forced priority terse reshow - admin_email log debug nowarnings smileys sigils - noninteractive_seen c_values); -our $config=fields::new('Debconf::Config'); - -our @config_files=("/etc/debconf.conf", "/usr/share/debconf/debconf.conf"); -if ($ENV{DEBCONF_SYSTEMRC}) { - unshift @config_files, $ENV{DEBCONF_SYSTEMRC}; -} else { - unshift @config_files, ((getpwuid($>))[7])."/.debconfrc"; -} - - -sub _hashify ($$) { - my $text=shift; - my $hash=shift; - - $text =~ s/\${([^}]+)}/$ENV{$1}/eg; - - my %ret; - my $i; - foreach my $line (split /\n/, $text) { - next if $line=~/^\s*#/; # comment - next if $line=~/^\s*$/; # blank - $line=~s/^\s+//; - $line=~s/\s+$//; - $i++; - my ($key, $value)=split(/\s*:\s*/, $line, 2); - $key=~tr/-/_/; - die "Parse error" unless defined $key and length $key; - $hash->{lc($key)}=$value; - } - return $i; -} - -sub _env_to_driver { - my $value=shift; - - my ($name, $options) = $value =~ m/^(\w+)(?:{(.*)})?$/; - return unless $name; - - return $name if Debconf::DbDriver->driver($name); - - my %hash = @_; # defaults from params - $hash{driver} = $name; - - if (defined $options) { - foreach (split ' ', $options) { - if (/^(\w+):(.*)/) { - $hash{$1}=$2; - } - else { - $hash{filename}=$_; - } - } - } - return Debconf::Db->makedriver(%hash)->{name}; -} - -sub load { - my $class=shift; - my $cf=shift; - my @defaults=@_; - - if (! $cf) { - for my $file (@config_files) { - $cf=$file, last if -e $file; - } - } - die "No config file found" unless $cf; - - open (DEBCONF_CONFIG, $cf) or die "$cf: $!\n"; - local $/="\n\n"; # read a stanza at a time - - 1 until _hashify(<DEBCONF_CONFIG>, $config) || eof DEBCONF_CONFIG; - - if (! exists $config->{config}) { - print STDERR "debconf: ".gettext("Config database not specified in config file.")."\n"; - exit(1); - } - if (! exists $config->{templates}) { - print STDERR "debconf: ".gettext("Template database not specified in config file.")."\n"; - exit(1); - } - - if (exists $config->{sigils} || exists $config->{smileys}) { - print STDERR "debconf: ".gettext("The Sigils and Smileys options in the config file are no longer used. Please remove them.")."\n"; - } - - while (<DEBCONF_CONFIG>) { - my %config=(@defaults); - if (exists $ENV{DEBCONF_DB_REPLACE}) { - $config{readonly} = "true"; - } - next unless _hashify($_, \%config); - eval { - Debconf::Db->makedriver(%config); - }; - if ($@) { - print STDERR "debconf: ".sprintf(gettext("Problem setting up the database defined by stanza %s of %s."),$., $cf)."\n"; - die $@; - } - } - close DEBCONF_CONFIG; - - if (exists $ENV{DEBCONF_DB_REPLACE}) { - $config->{config} = _env_to_driver($ENV{DEBCONF_DB_REPLACE}, - name => "_ENV_REPLACE"); - Debconf::Db->makedriver( - driver => "Pipe", - name => "_ENV_REPLACE_templates", - infd => "none", - outfd => "none", - ); - my @template_stack = ("_ENV_REPLACE_templates", $config->{templates}); - Debconf::Db->makedriver( - driver => "Stack", - name => "_ENV_stack_templates", - stack => join(", ", @template_stack), - ); - $config->{templates} = "_ENV_stack_templates"; - } - - my @finalstack = ($config->{config}); - if (exists $ENV{DEBCONF_DB_OVERRIDE}) { - unshift @finalstack, _env_to_driver($ENV{DEBCONF_DB_OVERRIDE}, - name => "_ENV_OVERRIDE"); - } - if (exists $ENV{DEBCONF_DB_FALLBACK}) { - push @finalstack, _env_to_driver($ENV{DEBCONF_DB_FALLBACK}, - name => "_ENV_FALLBACK", - readonly => "true"); - } - if (@finalstack > 1) { - Debconf::Db->makedriver( - driver => "Stack", - name => "_ENV_stack", - stack => join(", ", @finalstack), - ); - $config->{config} = "_ENV_stack"; - } -} - - -sub getopt { - my $class=shift; - my $usage=shift; - - my $showusage=sub { # closure - print STDERR $usage."\n"; - print STDERR gettext(<<EOF); - -f, --frontend Specify debconf frontend to use. - -p, --priority Specify minimum priority question to show. - --terse Enable terse mode. -EOF - exit 1; - }; - - return unless grep { $_ =~ /^-/ } @ARGV; - - require Getopt::Long; - Getopt::Long::Configure('bundling'); - Getopt::Long::GetOptions( - 'frontend|f=s', sub { shift; $class->frontend(shift); $config->frontend_forced(1) }, - 'priority|p=s', sub { shift; $class->priority(shift) }, - 'terse', sub { $config->{terse} = 'true' }, - 'help|h', $showusage, - @_, - ) || $showusage->(); -} - - -sub frontend { - my $class=shift; - - return $ENV{DEBIAN_FRONTEND} if exists $ENV{DEBIAN_FRONTEND}; - $config->{frontend}=shift if @_; - return $config->{frontend} if exists $config->{frontend}; - - my $ret='dialog'; - my $question=Debconf::Question->get('debconf/frontend'); - if ($question) { - $ret=lcfirst($question->value) || $ret; - } - return $ret; -} - - -sub frontend_forced { - my ($class, $val) = @_; - $config->{frontend_forced} = $val - if defined $val || exists $ENV{DEBIAN_FRONTEND}; - return $config->{frontend_forced} ? 1 : 0; -} - - -sub priority { - my $class=shift; - return $ENV{DEBIAN_PRIORITY} if exists $ENV{DEBIAN_PRIORITY}; - if (@_) { - my $newpri=shift; - if (! priority_valid($newpri)) { - warn(sprintf(gettext("Ignoring invalid priority \"%s\""), $newpri)); - warn(sprintf(gettext("Valid priorities are: %s"), join(" ", priority_list))); - } - else { - $config->{priority}=$newpri; - } - } - return $config->{priority} if exists $config->{priority}; - - my $ret='high'; - my $question=Debconf::Question->get('debconf/priority'); - if ($question) { - $ret=$question->value || $ret; - } - return $ret; -} - - -sub terse { - my $class=shift; - return $ENV{DEBCONF_TERSE} if exists $ENV{DEBCONF_TERSE}; - $config->{terse}=$_[0] if @_; - return $config->{terse} if exists $config->{terse}; - return 'false'; -} - - -sub nowarnings { - my $class=shift; - return $ENV{DEBCONF_NOWARNINGS} if exists $ENV{DEBCONF_NOWARNINGS}; - $config->{nowarnings}=$_[0] if @_; - return $config->{nowarnings} if exists $config->{nowarnings}; - return 'false'; -} - - -sub debug { - my $class=shift; - return $ENV{DEBCONF_DEBUG} if exists $ENV{DEBCONF_DEBUG}; - return $config->{debug} if exists $config->{debug}; - return ''; -} - - -sub admin_email { - my $class=shift; - return $ENV{DEBCONF_ADMIN_EMAIL} if exists $ENV{DEBCONF_ADMIN_EMAIL}; - return $config->{admin_email} if exists $config->{admin_email}; - return 'root'; -} - - -sub noninteractive_seen { - my $class=shift; - return $ENV{DEBCONF_NONINTERACTIVE_SEEN} if exists $ENV{DEBCONF_NONINTERACTIVE_SEEN}; - return $config->{noninteractive_seen} if exists $config->{noninteractive_seen}; - return 'false'; -} - - -sub c_values { - my $class=shift; - return $ENV{DEBCONF_C_VALUES} if exists $ENV{DEBCONF_C_VALUES}; - return $config->{c_values} if exists $config->{c_values}; - return 'false'; -} - - -sub AUTOLOAD { - (my $field = our $AUTOLOAD) =~ s/.*://; - my $class=shift; - - return $config->{$field}=shift if @_; - return $config->{$field} if defined $config->{$field}; - return ''; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Db.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Db.pm deleted file mode 100644 index 388b22a..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Db.pm +++ /dev/null @@ -1,57 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Db; -use strict; -use Debconf::Log qw{:all}; -use Debconf::Config; -use Debconf::DbDriver; -our $config; -our $templates; - - -sub load { - my $class=shift; - - Debconf::Config->load('', @_); # load default config file - $config=Debconf::DbDriver->driver(Debconf::Config->config); - if (not ref $config) { - die "Configuration database \"".Debconf::Config->config. - "\" was not initialized.\n"; - } - $templates=Debconf::DbDriver->driver(Debconf::Config->templates); - if (not ref $templates) { - die "Template database \"".Debconf::Config->templates. - "\" was not initialized.\n"; - } -} - - -sub makedriver { - my $class=shift; - my %config=@_; - - my $type=$config{driver} or die "driver type not specified (perhaps you need to re-read debconf.conf(5))"; - - if (! UNIVERSAL::can("Debconf::DbDriver::$type", 'new')) { - eval qq{use Debconf::DbDriver::$type}; - die $@ if $@; - } - delete $config{driver}; # not a field for the object - - debug db => "making DbDriver of type $type"; - "Debconf::DbDriver::$type"->new(%config); -} - - -sub save { - - $config->shutdown if $config; - $templates->shutdown if $templates; - $config=''; - $templates=''; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver.pm deleted file mode 100644 index bd5edac..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver.pm +++ /dev/null @@ -1,112 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::DbDriver; -use Debconf::Log qw{:all}; -use strict; -use base 1.01; # ensure that they don't have a broken perl installation - - - -use fields qw(name readonly required backup failed - accept_type reject_type accept_name reject_name); - -our %drivers; - - -sub new { - my Debconf::DbDriver $this=shift; - unless (ref $this) { - $this = fields::new($this); - } - $this->{required}=1; - $this->{readonly}=0; - $this->{failed}=0; - my %params=@_; - foreach my $field (keys %params) { - if ($field eq 'readonly' || $field eq 'required' || $field eq 'backup') { - $this->{$field}=1,next if lc($params{$field}) eq "true"; - $this->{$field}=0,next if lc($params{$field}) eq "false"; - } - elsif ($field=~/^(accept|reject)_/) { - $this->{$field}=qr/$params{$field}/i; - } - $this->{$field}=$params{$field}; - } - unless (exists $this->{name}) { - $this->{name}="(unknown)"; - $this->error("no name specified"); - } - $drivers{$this->{name}} = $this; - $this->init; - return $this; -} - - -sub init {} - - -sub error { - my $this=shift; - - if ($this->{required}) { - warn('DbDriver "'.$this->{name}.'":', @_); - exit 1; - } - else { - warn('DbDriver "'.$this->{name}.'" warning:', @_); - } -} - - -sub driver { - my $this=shift; - my $name=shift; - - return $drivers{$name}; -} - - -sub accept { - my $this=shift; - my $name=shift; - my $type=shift; - - return if $this->{failed}; - - if ((exists $this->{accept_name} && $name !~ /$this->{accept_name}/) || - (exists $this->{reject_name} && $name =~ /$this->{reject_name}/)) { - debug "db $this->{name}" => "reject $name"; - return; - } - - if (exists $this->{accept_type} || exists $this->{reject_type}) { - if (! defined $type || ! length $type) { - my $template = Debconf::Template->get($this->getfield($name, 'template')); - return 1 unless $template; # no type to act on - $type=$template->type || ''; - } - return if exists $this->{accept_type} && $type !~ /$this->{accept_type}/; - return if exists $this->{reject_type} && $type =~ /$this->{reject_type}/; - } - - return 1; -} - - -sub ispassword { - my $this=shift; - my $item=shift; - - my $template=$this->getfield($item, 'template'); - return unless defined $template; - $template=Debconf::Template->get($template); - return unless $template; - my $type=$template->type || ''; - return 1 if $type eq 'password'; - return 0; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Backup.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Backup.pm deleted file mode 100644 index 73206dc..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Backup.pm +++ /dev/null @@ -1,81 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::DbDriver::Backup; -use strict; -use Debconf::Log qw{:all}; -use base 'Debconf::DbDriver::Copy'; - - - -use fields qw(db backupdb); - - -sub init { - my $this=shift; - - foreach my $f (qw(db backupdb)) { - if (! ref $this->{$f}) { - my $db=$this->driver($this->{$f}); - unless (defined $f) { - $this->error("could not find a db named \"$this->{$f}\""); - } - $this->{$f}=$db; - } - } -} - - -sub copy { - my $this=shift; - my $item=shift; - - $this->SUPER::copy($item, $this->{db}, $this->{backupdb}); -} - - -sub shutdown { - my $this=shift; - - $this->{backupdb}->shutdown(@_); - $this->{db}->shutdown(@_); -} - -sub _query { - my $this=shift; - my $command=shift; - shift; # this again - - return $this->{db}->$command(@_); -} - -sub _change { - my $this=shift; - my $command=shift; - shift; # this again - - my $ret=$this->{db}->$command(@_); - if (defined $ret) { - $this->{backupdb}->$command(@_); - } - return $ret; -} - -sub iterator { $_[0]->_query('iterator', @_) } -sub exists { $_[0]->_query('exists', @_) } -sub addowner { $_[0]->_change('addowner', @_) } -sub removeowner { $_[0]->_change('removeowner', @_) } -sub owners { $_[0]->_query('owners', @_) } -sub getfield { $_[0]->_query('getfield', @_) } -sub setfield { $_[0]->_change('setfield', @_) } -sub fields { $_[0]->_query('fields', @_) } -sub getflag { $_[0]->_query('getflag', @_) } -sub setflag { $_[0]->_change('setflag', @_) } -sub flags { $_[0]->_query('flags', @_) } -sub getvariable { $_[0]->_query('getvariable', @_) } -sub setvariable { $_[0]->_change('setvariable', @_) } -sub variables { $_[0]->_query('variables', @_) } - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Cache.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Cache.pm deleted file mode 100644 index 0072407..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Cache.pm +++ /dev/null @@ -1,271 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::DbDriver::Cache; -use strict; -use Debconf::Log qw{:all}; -use base 'Debconf::DbDriver'; - - -use fields qw(cache dirty); - - -sub iterator { - my $this=shift; - my $subiterator=shift; - - my @items=keys %{$this->{cache}}; - my $iterator=Debconf::Iterator->new(callback => sub { - while (my $item = pop @items) { - next unless defined $this->{cache}->{$item}; - return $item; - } - return unless $subiterator; - my $ret; - do { - $ret=$subiterator->iterate; - } while defined $ret and exists $this->{cache}->{$ret}; - return $ret; - }); - return $iterator; -} - - -sub exists { - my $this=shift; - my $item=shift; - - return $this->{cache}->{$item} - if exists $this->{cache}->{$item}; - return 0; -} - - -sub init { - my $this=shift; - - $this->{cache} = {} unless exists $this->{cache}; -} - - -sub cacheadd { - my $this=shift; - my $item=shift; - my $entry=shift; - - return if exists $this->{cache}->{$item}; - - $this->{cache}->{$item}=$entry; - $this->{dirty}->{$item}=0; -} - - -sub cachedata { - my $this=shift; - my $item=shift; - - return $this->{cache}->{$item}; -} - - -sub cached { - my $this=shift; - my $item=shift; - - unless (exists $this->{cache}->{$item}) { - debug "db $this->{name}" => "cache miss on $item"; - $this->load($item); - } - return $this->{cache}->{$item}; -} - - -sub shutdown { - my $this=shift; - - return if $this->{readonly}; - - my $ret=1; - foreach my $item (keys %{$this->{cache}}) { - if (not defined $this->{cache}->{$item}) { - $ret=undef unless defined $this->remove($item); - delete $this->{cache}->{$item}; - } - elsif ($this->{dirty}->{$item}) { - $ret=undef unless defined $this->save($item, $this->{cache}->{$item}); - $this->{dirty}->{$item}=0; - } - } - return $ret; -} - - -sub addowner { - my $this=shift; - my $item=shift; - my $owner=shift; - my $type=shift; - - return if $this->{readonly}; - $this->cached($item); - - if (! defined $this->{cache}->{$item}) { - return if ! $this->accept($item, $type); - debug "db $this->{name}" => "creating in-cache $item"; - $this->{cache}->{$item}={ - owners => {}, - fields => {}, - variables => {}, - flags => {}, - } - } - - if (! exists $this->{cache}->{$item}->{owners}->{$owner}) { - $this->{cache}->{$item}->{owners}->{$owner}=1; - $this->{dirty}->{$item}=1; - } - return $owner; -} - - -sub removeowner { - my $this=shift; - my $item=shift; - my $owner=shift; - - return if $this->{readonly}; - return unless $this->cached($item); - - if (exists $this->{cache}->{$item}->{owners}->{$owner}) { - delete $this->{cache}->{$item}->{owners}->{$owner}; - $this->{dirty}->{$item}=1; - } - unless (keys %{$this->{cache}->{$item}->{owners}}) { - $this->{cache}->{$item}=undef; - $this->{dirty}->{$item}=1; - } - return $owner; -} - - -sub owners { - my $this=shift; - my $item=shift; - - return unless $this->cached($item); - return keys %{$this->{cache}->{$item}->{owners}}; -} - - -sub getfield { - my $this=shift; - my $item=shift; - my $field=shift; - - return unless $this->cached($item); - return $this->{cache}->{$item}->{fields}->{$field}; -} - - -sub setfield { - my $this=shift; - my $item=shift; - my $field=shift; - my $value=shift; - - return if $this->{readonly}; - return unless $this->cached($item); - $this->{dirty}->{$item}=1; - return $this->{cache}->{$item}->{fields}->{$field} = $value; -} - - -sub removefield { - my $this=shift; - my $item=shift; - my $field=shift; - - return if $this->{readonly}; - return unless $this->cached($item); - $this->{dirty}->{$item}=1; - return delete $this->{cache}->{$item}->{fields}->{$field}; -} - - -sub fields { - my $this=shift; - my $item=shift; - - return unless $this->cached($item); - return keys %{$this->{cache}->{$item}->{fields}}; -} - - -sub getflag { - my $this=shift; - my $item=shift; - my $flag=shift; - - return unless $this->cached($item); - return $this->{cache}->{$item}->{flags}->{$flag} - if exists $this->{cache}->{$item}->{flags}->{$flag}; - return 'false'; -} - - -sub setflag { - my $this=shift; - my $item=shift; - my $flag=shift; - my $value=shift; - - return if $this->{readonly}; - return unless $this->cached($item); - $this->{dirty}->{$item}=1; - return $this->{cache}->{$item}->{flags}->{$flag} = $value; -} - - -sub flags { - my $this=shift; - my $item=shift; - - return unless $this->cached($item); - return keys %{$this->{cache}->{$item}->{flags}}; -} - - -sub getvariable { - my $this=shift; - my $item=shift; - my $variable=shift; - - return unless $this->cached($item); - return $this->{cache}->{$item}->{variables}->{$variable}; -} - - -sub setvariable { - my $this=shift; - my $item=shift; - my $variable=shift; - my $value=shift; - - return if $this->{readonly}; - return unless $this->cached($item); - $this->{dirty}->{$item}=1; - return $this->{cache}->{$item}->{variables}->{$variable} = $value; -} - - -sub variables { - my $this=shift; - my $item=shift; - - return unless $this->cached($item); - return keys %{$this->{cache}->{$item}->{variables}}; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Copy.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Copy.pm deleted file mode 100644 index d4b3c71..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Copy.pm +++ /dev/null @@ -1,41 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::DbDriver::Copy; -use strict; -use Debconf::Log qw{:all}; -use base 'Debconf::DbDriver'; - - -sub copy { - my $this=shift; - my $item=shift; - my $src=shift; - my $dest=shift; - - debug "db $this->{name}" => "copying $item from $src->{name} to $dest->{name}"; - - my @owners=$src->owners($item); - if (! @owners) { - @owners=("unknown"); - } - foreach my $owner (@owners) { - my $template = Debconf::Template->get($src->getfield($item, 'template')); - my $type=""; - $type = $template->type if $template; - $dest->addowner($item, $owner, $type); - } - foreach my $field ($src->fields($item)) { - $dest->setfield($item, $field, $src->getfield($item, $field)); - } - foreach my $flag ($src->flags($item)) { - $dest->setflag($item, $flag, $src->getflag($item, $flag)); - } - foreach my $var ($src->variables($item)) { - $dest->setvariable($item, $var, $src->getvariable($item, $var)); - } -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Debug.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Debug.pm deleted file mode 100644 index e5af031..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Debug.pm +++ /dev/null @@ -1,52 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::DbDriver::Debug; -use strict; -use Debconf::Log qw{:all}; -use base 'Debconf::DbDriver'; - - - -use fields qw(db); - - -sub init { - my $this=shift; - - if (! ref $this->{db}) { - $this->{db}=$this->driver($this->{db}); - unless (defined $this->{db}) { - $this->error("could not find db"); - } - } -} - -sub DESTROY {} - -sub AUTOLOAD { - my $this=shift; - (my $command = our $AUTOLOAD) =~ s/.*://; - - debug "db $this->{name}" => "running $command(".join(",", map { "'$_'" } @_).") .."; - if (wantarray) { - my @ret=$this->{db}->$command(@_); - debug "db $this->{name}" => "$command returned (".join(", ", @ret).")"; - return @ret if @ret; - } - else { - my $ret=$this->{db}->$command(@_); - if (defined $ret) { - debug "db $this->{name}" => "$command returned \'$ret\'"; - return $ret; - } - else { - debug "db $this->{name}" => "$command returned undef"; - } - } - return; # failure -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/DirTree.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/DirTree.pm deleted file mode 100644 index 8447e20..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/DirTree.pm +++ /dev/null @@ -1,103 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::DbDriver::DirTree; -use strict; -use Debconf::Log qw(:all); -use base 'Debconf::DbDriver::Directory'; - - -sub init { - my $this=shift; - if (! defined $this->{extension} or ! length $this->{extension}) { - $this->{extension}=".dat"; - } - $this->SUPER::init(@_); -} - - -sub save { - my $this=shift; - my $item=shift; - - return unless $this->accept($item); - return if $this->{readonly}; - - my @dirs=split(m:/:, $this->filename($item)); - pop @dirs; # the base filename - my $base=$this->{directory}; - foreach (@dirs) { - $base.="/$_"; - next if -d $base; - mkdir $base or $this->error("mkdir $base: $!"); - } - - $this->SUPER::save($item, @_); -} - - -sub filename { - my $this=shift; - my $item=shift; - $item =~ s/\.\.//g; - return $item.$this->{extension}; -} - - -sub iterator { - my $this=shift; - - my @stack=(); - my $currentdir=""; - my $handle; - opendir($handle, $this->{directory}) or - $this->error("opendir: $this->{directory}: $!"); - - my $iterator=Debconf::Iterator->new(callback => sub { - my $i; - while ($handle or @stack) { - while (@stack and not $handle) { - $currentdir=pop @stack; - opendir($handle, "$this->{directory}/$currentdir") or - $this->error("opendir: $this->{directory}/$currentdir: $!"); - } - $i=readdir($handle); - if (not defined $i) { - closedir $handle; - $handle=undef; - next; - } - next if $i eq '.lock' || $i =~ /-old$/; - if (-d "$this->{directory}/$currentdir$i") { - if ($i ne '..' and $i ne '.') { - push @stack, "$currentdir$i/"; - } - next; - } - next unless $i=~s/$this->{extension}$//; - return $currentdir.$i; - } - return undef; - }); - - $this->SUPER::iterator($iterator); -} - - -sub remove { - my $this=shift; - my $item=shift; - - my $ret=$this->SUPER::remove($item); - return $ret unless $ret; - - my $dir=$this->filename($item); - while ($dir=~s:(.*)/[^/]*:$1: and length $dir) { - rmdir "$this->{directory}/$dir" or last; # not empty, I presume - } - return $ret; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Directory.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Directory.pm deleted file mode 100644 index c9fbbaf..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Directory.pm +++ /dev/null @@ -1,152 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::DbDriver::Directory; -use strict; -use Debconf::Log qw(:all); -use IO::File; -use POSIX (); -use Fcntl qw(:DEFAULT :flock); -use Debconf::Iterator; -use base 'Debconf::DbDriver::Cache'; - - -use fields qw(directory extension lock format); - - -sub init { - my $this=shift; - - $this->{extension} = "" unless exists $this->{extension}; - $this->{format} = "822" unless exists $this->{format}; - $this->{backup} = 1 unless exists $this->{backup}; - - $this->error("No format specified") unless $this->{format}; - eval "use Debconf::Format::$this->{format}"; - if ($@) { - $this->error("Error setting up format object $this->{format}: $@"); - } - $this->{format}="Debconf::Format::$this->{format}"->new; - if (not ref $this->{format}) { - $this->error("Unable to make format object"); - } - - $this->error("No directory specified") unless $this->{directory}; - if (not -d $this->{directory} and not $this->{readonly}) { - mkdir $this->{directory} || - $this->error("mkdir $this->{directory}:$!"); - } - if (not -d $this->{directory}) { - $this->error($this->{directory}." does not exist"); - } - debug "db $this->{name}" => "started; directory is $this->{directory}"; - - if (! $this->{readonly}) { - open ($this->{lock}, ">".$this->{directory}."/.lock") or - $this->error("could not lock $this->{directory}: $!"); - while (! flock($this->{lock}, LOCK_EX | LOCK_NB)) { - next if $! == &POSIX::EINTR; - $this->error("$this->{directory} is locked by another process: $!"); - last; - } - } -} - - -sub load { - my $this=shift; - my $item=shift; - - debug "db $this->{name}" => "loading $item"; - my $file=$this->{directory}.'/'.$this->filename($item); - return unless -e $file; - - my $fh=IO::File->new; - open($fh, $file) or $this->error("$file: $!"); - $this->cacheadd($this->{format}->read($fh)); - close $fh; -} - - -sub save { - my $this=shift; - my $item=shift; - my $data=shift; - - return unless $this->accept($item); - return if $this->{readonly}; - debug "db $this->{name}" => "saving $item"; - - my $file=$this->{directory}.'/'.$this->filename($item); - - my $fh=IO::File->new; - if ($this->ispassword($item)) { - sysopen($fh, $file."-new", O_WRONLY|O_TRUNC|O_CREAT, 0600) - or $this->error("$file-new: $!"); - } - else { - open($fh, ">$file-new") or $this->error("$file-new: $!"); - } - $this->{format}->beginfile; - $this->{format}->write($fh, $data, $item) - or $this->error("could not write $file-new: $!"); - $this->{format}->endfile; - - $fh->flush or $this->error("could not flush $file-new: $!"); - $fh->sync or $this->error("could not sync $file-new: $!"); - close $fh or $this->error("could not close $file-new: $!"); - - if (-e $file && $this->{backup}) { - rename($file, $file."-old") or - debug "db $this->{name}" => "rename failed: $!"; - } - rename("$file-new", $file) or $this->error("rename failed: $!"); -} - - -sub shutdown { - my $this=shift; - - $this->SUPER::shutdown(@_); - delete $this->{lock}; - return 1; -} - - -sub exists { - my $this=shift; - my $name=shift; - - my $incache=$this->SUPER::exists($name); - return $incache if (!defined $incache or $incache); - - return -e $this->{directory}.'/'.$this->filename($name); -} - - -sub remove { - my $this=shift; - my $name=shift; - - return if $this->{readonly} or not $this->accept($name); - debug "db $this->{name}" => "removing $name"; - my $file=$this->{directory}.'/'.$this->filename($name); - unlink $file or return undef; - if (-e $file."-old") { - unlink $file."-old" or return undef; - } - return 1; -} - - -sub accept { - my $this=shift; - my $name=shift; - - return if $name=~m#\.\./# or $name=~m#/\.\.#; - $this->SUPER::accept($name, @_); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/File.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/File.pm deleted file mode 100644 index ab09a47..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/File.pm +++ /dev/null @@ -1,138 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::DbDriver::File; -use strict; -use Debconf::Log qw(:all); -use POSIX (); -use Fcntl qw(:DEFAULT :flock); -use IO::Handle; -use base 'Debconf::DbDriver::Cache'; - - -use fields qw(filename mode format _fh); - - -sub init { - my $this=shift; - - if (exists $this->{mode}) { - $this->{mode} = oct($this->{mode}); - } - else { - $this->{mode} = 0600; - } - $this->{format} = "822" unless exists $this->{format}; - $this->{backup} = 1 unless exists $this->{backup}; - - $this->error("No format specified") unless $this->{format}; - eval "use Debconf::Format::$this->{format}"; - if ($@) { - $this->error("Error setting up format object $this->{format}: $@"); - } - $this->{format}="Debconf::Format::$this->{format}"->new; - if (not ref $this->{format}) { - $this->error("Unable to make format object"); - } - - $this->error("No filename specified") unless $this->{filename}; - - debug "db $this->{name}" => "started; filename is $this->{filename}"; - - if (! -e $this->{filename}) { - $this->{backup}=0; - sysopen(my $fh, $this->{filename}, - O_WRONLY|O_TRUNC|O_CREAT,$this->{mode}) or - $this->error("could not open $this->{filename}"); - close $fh; - } - - my $implicit_readonly=0; - if (! $this->{readonly}) { - if (open ($this->{_fh}, "+<", $this->{filename})) { - while (! flock($this->{_fh}, LOCK_EX | LOCK_NB)) { - next if $! == &POSIX::EINTR; - $this->error("$this->{filename} is locked by another process: $!"); - last; - } - } - else { - $implicit_readonly=1; - } - } - if ($this->{readonly} || $implicit_readonly) { - if (! open ($this->{_fh}, "<", $this->{filename})) { - $this->error("could not open $this->{filename}: $!"); - return; # always abort, even if not throwing fatal error - } - } - - $this->SUPER::init(@_); - - debug "db $this->{name}" => "loading database"; - - while (! eof $this->{_fh}) { - my ($item, $cache)=$this->{format}->read($this->{_fh}); - $this->{cache}->{$item}=$cache; - } - if ($this->{readonly} || $implicit_readonly) { - close $this->{_fh}; - } -} - - -sub shutdown { - my $this=shift; - - return if $this->{readonly}; - - if (grep $this->{dirty}->{$_}, keys %{$this->{cache}}) { - debug "db $this->{name}" => "saving database"; - } - else { - debug "db $this->{name}" => "no database changes, not saving"; - - delete $this->{_fh}; - - return 1; - } - - sysopen(my $fh, $this->{filename}."-new", - O_WRONLY|O_TRUNC|O_CREAT,$this->{mode}) or - $this->error("could not write $this->{filename}-new: $!"); - while (! flock($fh, LOCK_EX | LOCK_NB)) { - next if $! == &POSIX::EINTR; - $this->error("$this->{filename}-new is locked by another process: $!"); - last; - } - $this->{format}->beginfile; - foreach my $item (sort keys %{$this->{cache}}) { - next unless defined $this->{cache}->{$item}; # skip deleted - $this->{format}->write($fh, $this->{cache}->{$item}, $item) - or $this->error("could not write $this->{filename}-new: $!"); - } - $this->{format}->endfile; - - $fh->flush or $this->error("could not flush $this->{filename}-new: $!"); - $fh->sync or $this->error("could not sync $this->{filename}-new: $!"); - - if (-e $this->{filename} && $this->{backup}) { - rename($this->{filename}, $this->{filename}."-old") or - debug "db $this->{name}" => "rename failed: $!"; - } - rename($this->{filename}."-new", $this->{filename}) or - $this->error("rename failed: $!"); - - delete $this->{_fh}; - - return 1; -} - - -sub load { - return undef; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/LDAP.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/LDAP.pm deleted file mode 100644 index f2664f6..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/LDAP.pm +++ /dev/null @@ -1,263 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::DbDriver::LDAP; -use strict; -use Debconf::Log qw(:all); -use Net::LDAP; -use base 'Debconf::DbDriver::Cache'; - - -use fields qw(server port basedn binddn bindpasswd exists keybykey ds accept_attribute reject_attribute); - - -sub binddb { - my $this=shift; - - $this->error("No server specified") unless exists $this->{server}; - $this->error("No Base DN specified") unless exists $this->{basedn}; - - $this->{binddn} = "" unless exists $this->{binddn}; - $this->{port} = 389 unless exists $this->{port}; - - debug "db $this->{name}" => "talking to $this->{server}, data under $this->{basedn}"; - - $this->{ds} = Net::LDAP->new($this->{server}, port => $this->{port}, version => 3); - if (! $this->{ds}) { - $this->error("Unable to connect to LDAP server"); - return; # if not fatal, give up anyway - } - - my $rv = ""; - if (!($this->{binddn} && $this->{bindpasswd})) { - debug "db $this->{name}" => "binding anonymously; hope that's OK"; - $rv = $this->{ds}->bind; - } else { - debug "db $this->{name}" => "binding as $this->{binddn}"; - $rv = $this->{ds}->bind($this->{binddn}, password => $this->{bindpasswd}); - } - if ($rv->code) { - $this->error("Bind Failed: ".$rv->error); - } - - return $this->{ds}; -} - - -sub init { - my $this = shift; - - $this->SUPER::init(@_); - - $this->binddb; - return unless $this->{ds}; - - $this->{exists} = {}; - - if ($this->{keybykey}) { - debug "db $this->{name}" => "will get database data key by key"; - } - else { - debug "db $this->{name}" => "getting database data"; - my $data = $this->{ds}->search(base => $this->{basedn}, sizelimit => 0, timelimit => 0, filter => "(objectclass=debconfDbEntry)"); - if ($data->code) { - $this->error("Search failed: ".$data->error); - } - - my $records = $data->as_struct(); - debug "db $this->{name}" => "Read ".$data->count()." entries"; - - $this->parse_records($records); - - $this->{ds}->unbind; - } -} - - -sub shutdown -{ - my $this = shift; - - return if $this->{readonly}; - - if (grep $this->{dirty}->{$_}, keys %{$this->{cache}}) { - debug "db $this->{name}" => "saving changes"; - } else { - debug "db $this->{name}" => "no database changes, not saving"; - return 1; - } - - unless ($this->{keybykey}) { - $this->binddb; - return unless $this->{ds}; - } - - foreach my $item (keys %{$this->{cache}}) { - next unless defined $this->{cache}->{$item}; # skip deleted - next unless $this->{dirty}->{$item}; # skip unchanged - (my $entry_cn = $item) =~ s/([,+="<>#;])/\\$1/g; - my $entry_dn = "cn=$entry_cn,$this->{basedn}"; - debug "db $this->{name}" => "writing out to $entry_dn"; - - my %data = %{$this->{cache}->{$item}}; - my %modify_data; - my $add_data = [ 'objectclass' => 'top', - 'objectclass' => 'debconfdbentry', - 'cn' => $item - ]; - - my @fields = keys %{$data{fields}}; - foreach my $field (@fields) { - my $ldapname = $field; - if ( $ldapname =~ s/_(\w)/uc($1)/ge ) { - $data{fields}->{$ldapname} = $data{fields}->{$field}; - delete $data{fields}->{$field}; - } - } - - foreach my $field (keys %{$data{fields}}) { - next if ($data{fields}->{$field} eq '' && - !($field eq 'value')); - if ((exists $this->{accept_attribute} && - $field !~ /$this->{accept_attribute}/) or - (exists $this->{reject_attribute} && - $field =~ /$this->{reject_attribute}/)) { - debug "db $item" => "reject $field"; - next; - } - - $modify_data{$field}=$data{fields}->{$field}; - push(@{$add_data}, $field); - push(@{$add_data}, $data{fields}->{$field}); - } - - my @owners = keys %{$data{owners}}; - debug "db $this->{name}" => "owners is ".join(" ", @owners); - $modify_data{owners} = \@owners; - push(@{$add_data}, 'owners'); - push(@{$add_data}, \@owners); - - my @flags = grep { $data{flags}->{$_} eq 'true' } keys %{$data{flags}}; - if (@flags) { - $modify_data{flags} = \@flags; - push(@{$add_data}, 'flags'); - push(@{$add_data}, \@flags); - } - - $modify_data{variables} = []; - foreach my $var (keys %{$data{variables}}) { - my $variable = "$var=$data{variables}->{$var}"; - push (@{$modify_data{variables}}, $variable); - push(@{$add_data}, 'variables'); - push(@{$add_data}, $variable); - } - - my $rv=""; - if ($this->{exists}->{$item}) { - $rv = $this->{ds}->modify($entry_dn, replace => \%modify_data); - } else { - $rv = $this->{ds}->add($entry_dn, attrs => $add_data); - } - if ($rv->code) { - $this->error("Modify failed: ".$rv->error); - } - } - - $this->{ds}->unbind(); - - $this->SUPER::shutdown(@_); -} - - -sub load { - my $this = shift; - return unless $this->{keybykey}; - my $entry_cn = shift; - - my $records = $this->get_key($entry_cn); - return unless $records; - - debug "db $this->{name}" => "Read entry for $entry_cn"; - - $this->parse_records($records); -} - - -sub remove { - return 1; -} - - -sub save { - return 1; -} - - -sub get_key { - my $this = shift; - return unless $this->{keybykey}; - my $entry_cn = shift; - - my $data = $this->{ds}->search( - base => 'cn=' . $entry_cn . ',' . $this->{basedn}, - sizelimit => 0, - timelimit => 0, - filter => "(objectclass=debconfDbEntry)"); - - if ($data->code) { - $this->error("Search failed: ".$data->error); - } - - return unless $data->entries; - $data->as_struct(); -} - -sub parse_records { - my $this = shift; - my $records = shift; - - foreach my $dn (keys %{$records}) { - my $entry = $records->{$dn}; - debug "db $this->{name}" => "Reading data from $dn"; - my %ret = (owners => {}, - fields => {}, - variables => {}, - flags => {}, - ); - my $name = ""; - - foreach my $attr (keys %{$entry}) { - if ($attr eq 'objectclass') { - next; - } - my $values = $entry->{$attr}; - - $attr =~ s/([a-z])([A-Z])/$1.'_'.lc($2)/ge; - - debug "db $this->{name}" => "Setting data for $attr"; - foreach my $val (@{$values}) { - debug "db $this->{name}" => "$attr = $val"; - if ($attr eq 'owners') { - $ret{owners}->{$val}=1; - } elsif ($attr eq 'flags') { - $ret{flags}->{$val}='true'; - } elsif ($attr eq 'cn') { - $name = $val; - } elsif ($attr eq 'variables') { - my ($var, $value)=split(/\s*=\s*/, $val, 2); - $ret{variables}->{$var}=$value; - } else { - $val=~s/\\n/\n/g; - $ret{fields}->{$attr}=$val; - } - } - } - - $this->{cache}->{$name} = \%ret; - $this->{exists}->{$name} = 1; - } -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/PackageDir.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/PackageDir.pm deleted file mode 100644 index a595c3f..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/PackageDir.pm +++ /dev/null @@ -1,170 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::DbDriver::PackageDir; -use strict; -use Debconf::Log qw(:all); -use IO::File; -use Fcntl qw(:DEFAULT :flock); -use Debconf::Iterator; -use base 'Debconf::DbDriver::Directory'; - - -use fields qw(mode _loaded); - - -sub init { - my $this=shift; - - if (exists $this->{mode}) { - $this->{mode} = oct($this->{mode}); - } - else { - $this->{mode} = 0600; - } - $this->SUPER::init(@_); -} - - -sub loadfile { - my $this=shift; - my $file=$this->{directory}."/".shift; - - return if $this->{_loaded}->{$file}; - $this->{_loaded}->{$file}=1; - - debug "db $this->{name}" => "loading $file"; - return unless -e $file; - - my $fh=IO::File->new; - open($fh, $file) or $this->error("$file: $!"); - my @item = $this->{format}->read($fh); - while (@item) { - $this->cacheadd(@item); - @item = $this->{format}->read($fh); - } - close $fh; -} - - -sub load { - my $this=shift; - my $item=shift; - $this->loadfile($this->filename($item)); -} - - -sub filename { - my $this=shift; - my $item=shift; - - if ($item =~ m!^([^/]+)(?:/|$)!) { - return $1.$this->{extension}; - } - else { - $this->error("failed parsing item name \"$item\"\n"); - } -} - - -sub iterator { - my $this=shift; - - my $handle; - opendir($handle, $this->{directory}) || - $this->error("opendir: $!"); - - while (my $file=readdir($handle)) { - next if length $this->{extension} and - not $file=~m/$this->{extension}/; - next unless -f $this->{directory}."/".$file; - next if $file eq '.lock' || $file =~ /-old$/; - $this->loadfile($file); - } - - $this->SUPER::iterator; -} - - -sub exists { - my $this=shift; - my $name=shift; - my $incache=$this->Debconf::DbDriver::Cache::exists($name); - return $incache if (!defined $incache or $incache); - my $file=$this->{directory}.'/'.$this->filename($name); - return unless -e $file; - - $this->load($name); - - return $this->Debconf::DbDriver::Cache::exists($name); -} - - -sub shutdown { - my $this=shift; - - return if $this->{readonly}; - - my (%files, %filecontents, %killfiles, %dirtyfiles); - foreach my $item (keys %{$this->{cache}}) { - my $file=$this->filename($item); - $files{$file}++; - - if (! defined $this->{cache}->{$item}) { - $killfiles{$file}++; - delete $this->{cache}->{$item}; - } - else { - push @{$filecontents{$file}}, $item; - } - - if ($this->{dirty}->{$item}) { - $dirtyfiles{$file}++; - $this->{dirty}->{$item}=0; - } - } - - foreach my $file (keys %files) { - if (! $filecontents{$file} && $killfiles{$file}) { - debug "db $this->{name}" => "removing $file"; - my $filename=$this->{directory}."/".$file; - unlink $filename or - $this->error("unable to remove $filename: $!"); - if (-e $filename."-old") { - unlink $filename."-old" or - $this->error("unable to remove $filename-old: $!"); - } - } - elsif ($dirtyfiles{$file}) { - debug "db $this->{name}" => "saving $file"; - my $filename=$this->{directory}."/".$file; - - sysopen(my $fh, $filename."-new", - O_WRONLY|O_TRUNC|O_CREAT,$this->{mode}) or - $this->error("could not write $filename-new: $!"); - $this->{format}->beginfile; - foreach my $item (@{$filecontents{$file}}) { - $this->{format}->write($fh, $this->{cache}->{$item}, $item) - or $this->error("could not write $filename-new: $!"); - } - $this->{format}->endfile; - - $fh->flush or $this->error("could not flush $filename-new: $!"); - $fh->sync or $this->error("could not sync $filename-new: $!"); - - if (-e $filename && $this->{backup}) { - rename($filename, $filename."-old") or - debug "db $this->{name}" => "rename failed: $!"; - } - rename($filename."-new", $filename) or - $this->error("rename failed: $!"); - } - } - - $this->SUPER::shutdown(@_); - return 1; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Pipe.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Pipe.pm deleted file mode 100644 index 17a2132..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Pipe.pm +++ /dev/null @@ -1,90 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::DbDriver::Pipe; -use strict; -use Debconf::Log qw(:all); -use base 'Debconf::DbDriver::Cache'; - - -use fields qw(infd outfd format); - - -sub init { - my $this=shift; - - $this->{format} = "822" unless exists $this->{format}; - - $this->error("No format specified") unless $this->{format}; - eval "use Debconf::Format::$this->{format}"; - if ($@) { - $this->error("Error setting up format object $this->{format}: $@"); - } - $this->{format}="Debconf::Format::$this->{format}"->new; - if (not ref $this->{format}) { - $this->error("Unable to make format object"); - } - - my $fh; - if (defined $this->{infd}) { - if ($this->{infd} ne 'none') { - open ($fh, "<&=$this->{infd}") or - $this->error("could not open file descriptor #$this->{infd}: $!"); - } - } - else { - open ($fh, '-'); - } - - $this->SUPER::init(@_); - - debug "db $this->{name}" => "loading database"; - - if (defined $fh) { - while (! eof $fh) { - my ($item, $cache)=$this->{format}->read($fh); - $this->{cache}->{$item}=$cache; - } - close $fh; - } -} - - -sub shutdown { - my $this=shift; - - return if $this->{readonly}; - - my $fh; - if (defined $this->{outfd}) { - if ($this->{outfd} ne 'none') { - open ($fh, ">&=$this->{outfd}") or - $this->error("could not open file descriptor #$this->{outfd}: $!"); - } - } - else { - open ($fh, '>-'); - } - - if (defined $fh) { - $this->{format}->beginfile; - foreach my $item (sort keys %{$this->{cache}}) { - next unless defined $this->{cache}->{$item}; # skip deleted - $this->{format}->write($fh, $this->{cache}->{$item}, $item) - or $this->error("could not write to pipe: $!"); - } - $this->{format}->endfile; - close $fh or $this->error("could not close pipe: $!"); - } - - return 1; -} - - -sub load { - return undef; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Stack.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Stack.pm deleted file mode 100644 index ebfe5b3..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Stack.pm +++ /dev/null @@ -1,246 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::DbDriver::Stack; -use strict; -use Debconf::Log qw{:all}; -use Debconf::Iterator; -use base 'Debconf::DbDriver::Copy'; - - - -use fields qw(stack stack_change_errors); - - -sub init { - my $this=shift; - - if (! ref $this->{stack}) { - my @stack; - foreach my $name (split(/\s*,\s/, $this->{stack})) { - my $driver=$this->driver($name); - unless (defined $driver) { - $this->error("could not find a db named \"$name\" to use in the stack (it should be defined before the stack in the config file)"); - next; - } - push @stack, $driver; - } - $this->{stack}=[@stack]; - } - - $this->error("no stack set") if ! ref $this->{stack}; - $this->error("stack is empty") if ! @{$this->{stack}}; -} - - -sub iterator { - my $this=shift; - - my %seen; - my @iterators = map { $_->iterator } @{$this->{stack}}; - my $i = pop @iterators; - my $iterator=Debconf::Iterator->new(callback => sub { - for (;;) { - while (my $ret = $i->iterate) { - next if $seen{$ret}; - $seen{$ret}=1; - return $ret; - } - $i = pop @iterators; - return undef unless defined $i; - } - }); -} - - -sub shutdown { - my $this=shift; - - my $ret=1; - foreach my $driver (@{$this->{stack}}) { - $ret=undef if not defined $driver->shutdown(@_); - } - - if ($this->{stack_change_errors}) { - $this->error("unable to save changes to: ". - join(" ", @{$this->{stack_change_errors}})); - $ret=undef; - } - - return $ret; -} - - -sub exists { - my $this=shift; - - foreach my $driver (@{$this->{stack}}) { - return 1 if $driver->exists(@_); - } - return 0; -} - -sub _query { - my $this=shift; - my $command=shift; - shift; # this again - - debug "db $this->{name}" => "trying to $command(@_) .."; - foreach my $driver (@{$this->{stack}}) { - if (wantarray) { - my @ret=$driver->$command(@_); - debug "db $this->{name}" => "$command done by $driver->{name}" if @ret; - return @ret if @ret; - } - else { - my $ret=$driver->$command(@_); - debug "db $this->{name}" => "$command done by $driver->{name}" if defined $ret; - return $ret if defined $ret; - } - } - return; # failure -} - -sub _change { - my $this=shift; - my $command=shift; - shift; # this again - my $item=shift; - - debug "db $this->{name}" => "trying to $command($item @_) .."; - - foreach my $driver (@{$this->{stack}}) { - if ($driver->exists($item)) { - last if $driver->{readonly}; # nope, hit a readonly one - debug "db $this->{name}" => "passing to $driver->{name} .."; - return $driver->$command($item, @_); - } - } - - my $src=0; - - foreach my $driver (@{$this->{stack}}) { - if ($driver->exists($item)) { - my $ret=$this->_nochange($driver, $command, $item, @_); - if (defined $ret) { - debug "db $this->{name}" => "skipped $command($item) as it would have no effect"; - return $ret; - } - - $src=$driver; - last - } - } - - my $writer; - foreach my $driver (@{$this->{stack}}) { - if ($driver == $src) { - push @{$this->{stack_change_errors}}, $item; - return; - } - if (! $driver->{readonly}) { - if ($command eq 'addowner') { - if ($driver->accept($item, $_[1])) { - $writer=$driver; - last; - } - } - elsif ($driver->accept($item)) { - $writer=$driver; - last; - } - } - } - - unless ($writer) { - debug "db $this->{name}" => "FAILED $command"; - return; - } - - if ($src) { - $this->copy($item, $src, $writer); - } - - debug "db $this->{name}" => "passing to $writer->{name} .."; - return $writer->$command($item, @_); -} - -sub _nochange { - my $this=shift; - my $driver=shift; - my $command=shift; - my $item=shift; - - if ($command eq 'addowner') { - my $value=shift; - foreach my $owner ($driver->owners($item)) { - return $value if $owner eq $value; - } - return; - } - elsif ($command eq 'removeowner') { - my $value=shift; - - foreach my $owner ($driver->owners($item)) { - return if $owner eq $value; - } - return $value; # no change - } - elsif ($command eq 'removefield') { - my $value=shift; - - foreach my $field ($driver->fields($item)) { - return if $field eq $value; - } - return $value; # no change - } - - my @list; - my $get; - if ($command eq 'setfield') { - @list=$driver->fields($item); - $get='getfield'; - } - elsif ($command eq 'setflag') { - @list=$driver->flags($item); - $get='getflag'; - } - elsif ($command eq 'setvariable') { - @list=$driver->variables($item); - $get='getvariable'; - } - else { - $this->error("internal error; bad command: $command"); - } - - my $thing=shift; - my $value=shift; - my $currentvalue=$driver->$get($item, $thing); - - my $exists=0; - foreach my $i (@list) { - $exists=1, last if $thing eq $i; - } - return $currentvalue unless $exists; - - return $currentvalue if $currentvalue eq $value; - return undef; -} - -sub addowner { $_[0]->_change('addowner', @_) } -sub removeowner { $_[0]->_change('removeowner', @_) } -sub owners { $_[0]->_query('owners', @_) } -sub getfield { $_[0]->_query('getfield', @_) } -sub setfield { $_[0]->_change('setfield', @_) } -sub removefield { $_[0]->_change('removefield', @_) } -sub fields { $_[0]->_query('fields', @_) } -sub getflag { $_[0]->_query('getflag', @_) } -sub setflag { $_[0]->_change('setflag', @_) } -sub flags { $_[0]->_query('flags', @_) } -sub getvariable { $_[0]->_query('getvariable', @_) } -sub setvariable { $_[0]->_change('setvariable', @_) } -sub variables { $_[0]->_query('variables', @_) } - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element.pm deleted file mode 100644 index 4d07acd..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element.pm +++ /dev/null @@ -1,20 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element; -use strict; -use base qw(Debconf::Base); - - -sub visible { - my $this=shift; - - return 1; -} - - -sub show {} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Boolean.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Boolean.pm deleted file mode 100644 index 3976414..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Boolean.pm +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Dialog::Boolean; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - my @params=('--yesno'); - push @params, $this->frontend->dashsep if $this->frontend->dashsep; - push @params, $this->frontend->makeprompt($this->question, 1); - if (defined $this->question->value && $this->question->value eq 'false') { - unshift @params, '--defaultno'; - } - - my ($ret, $value)=$this->frontend->showdialog($this->question, @params); - if (defined $ret) { - $this->value($ret eq 0 ? 'true' : 'false'); - } - else { - my $default=''; - $default=$this->question->value - if defined $this->question->value; - $this->value($default); - } -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Error.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Error.pm deleted file mode 100644 index c0a25b4..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Error.pm +++ /dev/null @@ -1,20 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Dialog::Error; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - $this->frontend->showtext($this->question, - $this->question->description."\n\n". - $this->question->extended_description - ); - $this->value(''); -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Multiselect.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Multiselect.pm deleted file mode 100644 index e62f3d4..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Multiselect.pm +++ /dev/null @@ -1,69 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Dialog::Multiselect; -use strict; -use base qw(Debconf::Element::Multiselect); -use Debconf::Encoding qw(width); - - -sub show { - my $this=shift; - - my ($text, $lines, $columns)= - $this->frontend->makeprompt($this->question, -2); - - my $screen_lines=$this->frontend->screenheight - $this->frontend->spacer; - my @params=(); - my @choices=$this->question->choices_split; - my %value = map { $_ => 1 } $this->translate_default; - - my $menu_height=$#choices + 1; - if ($lines + $#choices + 2 >= $screen_lines) { - $menu_height = $screen_lines - $lines - 4; - if ($menu_height < 3 && $#choices + 1 > 2) { - $this->frontend->showtext($this->question, $this->question->extended_description); - ($text, $lines, $columns)=$this->frontend->sizetext($this->question->description); - $menu_height=$#choices + 1; - if ($lines + $#choices + 2 >= $screen_lines) { - $menu_height = $screen_lines - $lines - 4; - } - } - } - - $lines=$lines + $menu_height + $this->frontend->spacer; - my $selectspacer = $this->frontend->selectspacer; - my $c=1; - foreach (@choices) { - push @params, ($_, ""); - push @params, ($value{$_} ? 'on' : 'off'); - - if ($columns < width($_) + $selectspacer) { - $columns = width($_) + $selectspacer; - } - } - - if ($this->frontend->dashsep) { - unshift @params, $this->frontend->dashsep; - } - - @params=('--separate-output', '--checklist', - $text, $lines, $columns, $menu_height, @params); - - my $value=$this->frontend->showdialog($this->question, @params); - - if (defined $value) { - $this->value(join(", ", $this->order_values( - map { $this->translate_to_C($_) } - split(/\n/, $value)))); - } - else { - my $default=''; - $default=$this->question->value - if defined $this->question->value; - $this->value($default); - } -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Note.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Note.pm deleted file mode 100644 index 4cab4cf..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Note.pm +++ /dev/null @@ -1,20 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Dialog::Note; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - $this->frontend->showtext($this->question, - $this->question->description."\n\n". - $this->question->extended_description - ); - $this->value(''); -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Password.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Password.pm deleted file mode 100644 index e32f863..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Password.pm +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Dialog::Password; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - my ($text, $lines, $columns)= - $this->frontend->makeprompt($this->question); - - my @params=('--passwordbox'); - push @params, $this->frontend->dashsep if $this->frontend->dashsep; - push @params, ($text, $lines + $this->frontend->spacer, $columns); - my $ret=$this->frontend->showdialog($this->question, @params); - - if (! defined $ret || $ret eq '') { - my $default=''; - $default=$this->question->value - if defined $this->question->value; - $this->value($default); - } - else { - $this->value($ret); - } -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Progress.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Progress.pm deleted file mode 100644 index 53f6270..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Progress.pm +++ /dev/null @@ -1,87 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Dialog::Progress; -use strict; -use base qw(Debconf::Element); - - -sub _communicate { - my $this=shift; - my $data=shift; - my $dialoginput = $this->frontend->dialog_input_wtr; - - print $dialoginput $data; -} - -sub _percent { - my $this=shift; - - use integer; - return (($this->progress_cur() - $this->progress_min()) * 100 / ($this->progress_max() - $this->progress_min())); -} - -sub start { - my $this=shift; - - $this->frontend->title($this->question->description); - - my ($text, $lines, $columns); - if (defined $this->_info) { - ($text, $lines, $columns)=$this->frontend->sizetext($this->_info->description); - } else { - ($text, $lines, $columns)=$this->frontend->sizetext(' '); - } - if ($this->frontend->screenwidth - $this->frontend->columnspacer > $columns) { - $columns = $this->frontend->screenwidth - $this->frontend->columnspacer; - } - - my @params=('--gauge'); - push @params, $this->frontend->dashsep if $this->frontend->dashsep; - push @params, ($text, $lines + $this->frontend->spacer, $columns, $this->_percent); - - $this->frontend->startdialog($this->question, 1, @params); - - $this->_lines($lines); - $this->_columns($columns); -} - -sub set { - my $this=shift; - my $value=shift; - - $this->progress_cur($value); - $this->_communicate($this->_percent . "\n"); - - return 1; -} - -sub info { - my $this=shift; - my $question=shift; - - $this->_info($question); - - my ($text, $lines, $columns)=$this->frontend->sizetext($question->description); - if ($lines > $this->_lines or $columns > $this->_columns) { - $this->stop; - $this->start; - } - - - $this->_communicate( - sprintf("XXX\n%d\n%s\nXXX\n%d\n", - $this->_percent, $text, $this->_percent)); - - return 1; -} - -sub stop { - my $this=shift; - - $this->frontend->waitdialog; - $this->frontend->title($this->frontend->requested_title); -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Select.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Select.pm deleted file mode 100644 index 09a45d4..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Select.pm +++ /dev/null @@ -1,57 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Dialog::Select; -use strict; -use base qw(Debconf::Element::Select); -use Debconf::Encoding qw(width); - - -sub show { - my $this=shift; - - my ($text, $lines, $columns)= - $this->frontend->makeprompt($this->question, -2); - - my $screen_lines=$this->frontend->screenheight - $this->frontend->spacer; - my $default=$this->translate_default; - my @params=(); - my @choices=$this->question->choices_split; - - my $menu_height=$#choices + 1; - if ($lines + $#choices + 2 >= $screen_lines) { - $menu_height = $screen_lines - $lines - 4; - } - - $lines=$lines + $menu_height + $this->frontend->spacer; - my $c=1; - my $selectspacer = $this->frontend->selectspacer; - foreach (@choices) { - push @params, $_, ''; - - if ($columns < width($_) + $selectspacer) { - $columns = width($_) + $selectspacer; - } - } - - if ($this->frontend->dashsep) { - unshift @params, $this->frontend->dashsep; - } - - @params=('--default-item', $default, '--menu', - $text, $lines, $columns, $menu_height, @params); - - my $value=$this->frontend->showdialog($this->question, @params); - if (defined $value) { - $this->value($this->translate_to_C($value)) if defined $value; - } - else { - my $default=''; - $default=$this->question->value - if defined $this->question->value; - $this->value($default); - } -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/String.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/String.pm deleted file mode 100644 index 6978724..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/String.pm +++ /dev/null @@ -1,36 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Dialog::String; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - my ($text, $lines, $columns)= - $this->frontend->makeprompt($this->question); - - my $default=''; - $default=$this->question->value if defined $this->question->value; - - my @params=('--inputbox'); - push @params, $this->frontend->dashsep if $this->frontend->dashsep; - push @params, ($text, $lines + $this->frontend->spacer, - $columns, $default); - - my $value=$this->frontend->showdialog($this->question, @params); - if (defined $value) { - $this->value($value); - } - else { - my $default=''; - $default=$this->question->value - if defined $this->question->value; - $this->value($default); - } -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Text.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Text.pm deleted file mode 100644 index 9169b85..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Dialog/Text.pm +++ /dev/null @@ -1,20 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Dialog::Text; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - $this->frontend->showtext($this->question, - $this->question->description."\n\n". - $this->question->extended_description - ); - $this->value(''); -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Boolean.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Boolean.pm deleted file mode 100644 index d16124c..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Boolean.pm +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Editor::Boolean; -use strict; -use Debconf::Gettext; -use base qw(Debconf::Element); - - - -sub show { - my $this=shift; - - $this->frontend->comment($this->question->extended_description."\n\n". - "(".gettext("Choices").": ".join(", ", gettext("yes"), gettext("no")).")\n". - $this->question->description."\n"); - - my $default=''; - $default=$this->question->value if defined $this->question->value; - if ($default eq 'true') { - $default=gettext("yes"); - } - elsif ($default eq 'false') { - $default=gettext("no"); - } - - $this->frontend->item($this->question->name, $default); -} - - -sub value { - my $this=shift; - - return $this->SUPER::value() unless @_; - my $value=shift; - - if ($value eq 'yes' || $value eq gettext("yes")) { - return $this->SUPER::value('true'); - } - elsif ($value eq 'no' || $value eq gettext("no")) { - return $this->SUPER::value('false'); - } - else { - return $this->SUPER::value($this->question->value); - } -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Error.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Error.pm deleted file mode 100644 index 5733c98..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Error.pm +++ /dev/null @@ -1,9 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Editor::Error; -use strict; -use base qw(Debconf::Element::Editor::Text); - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Multiselect.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Multiselect.pm deleted file mode 100644 index 7cadbe8..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Multiselect.pm +++ /dev/null @@ -1,39 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Editor::Multiselect; -use strict; -use Debconf::Gettext; -use base qw(Debconf::Element::Multiselect); - - -sub show { - my $this=shift; - - my @choices=$this->question->choices_split; - - $this->frontend->comment($this->question->extended_description."\n\n". - "(".gettext("Choices").": ".join(", ", @choices).")\n". - gettext("(Enter zero or more items separated by a comma followed by a space (', ').)")."\n". - $this->question->description."\n"); - - $this->frontend->item($this->question->name, join ", ", $this->translate_default); -} - - -sub value { - my $this=shift; - - return $this->SUPER::value() unless @_; - my @values=split(',\s+', shift); - - my %valid=map { $_ => 1 } $this->question->choices_split; - - $this->SUPER::value(join(', ', $this->order_values( - map { $this->translate_to_C($_) } - grep { $valid{$_} } @values))); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Note.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Note.pm deleted file mode 100644 index fd5006a..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Note.pm +++ /dev/null @@ -1,9 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Editor::Note; -use strict; -use base qw(Debconf::Element::Editor::Text); - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Password.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Password.pm deleted file mode 100644 index f1dce00..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Password.pm +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Editor::Password; -use strict; -use base qw(Debconf::Element::Editor::String); - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Progress.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Progress.pm deleted file mode 100644 index c538abb..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Progress.pm +++ /dev/null @@ -1,25 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Editor::Progress; -use strict; -use base qw(Debconf::Element); - - - -sub start { -} - -sub set { - return 1; -} - -sub info { - return 1; -} - -sub stop { -} - -1; diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Select.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Select.pm deleted file mode 100644 index f73d126..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Select.pm +++ /dev/null @@ -1,41 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Editor::Select; -use strict; -use Debconf::Gettext; -use base qw(Debconf::Element::Select); - - -sub show { - my $this=shift; - - my $default=$this->translate_default; - my @choices=$this->question->choices_split; - - $this->frontend->comment($this->question->extended_description."\n\n". - "(".gettext("Choices").": ".join(", ", @choices).")\n". - $this->question->description."\n"); - $this->frontend->item($this->question->name, $default); -} - - -sub value { - my $this=shift; - - return $this->SUPER::value() unless @_; - my $value=shift; - - my %valid=map { $_ => 1 } $this->question->choices_split; - - if ($valid{$value}) { - return $this->SUPER::value($this->translate_to_C($value)); - } - else { - return $this->SUPER::value($this->question->value); - } -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/String.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/String.pm deleted file mode 100644 index 4b9676d..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/String.pm +++ /dev/null @@ -1,22 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Editor::String; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - $this->frontend->comment($this->question->extended_description."\n\n". - $this->question->description."\n"); - - my $default=''; - $default=$this->question->value if defined $this->question->value; - - $this->frontend->item($this->question->name, $default); -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Text.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Text.pm deleted file mode 100644 index 172031c..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Editor/Text.pm +++ /dev/null @@ -1,19 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Editor::Text; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - $this->frontend->comment($this->question->extended_description."\n\n". - $this->question->description."\n\n"); - - $this->value(''); -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome.pm deleted file mode 100644 index 655c8bd..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome.pm +++ /dev/null @@ -1,145 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Gnome; -use strict; -use utf8; -use Gtk2; -use Debconf::Gettext; -use Debconf::Encoding qw(to_Unicode); -use base qw(Debconf::Element); - - -sub init { - my $this=shift; - - $this->hbox(Gtk2::VBox->new(0, 10)); - - $this->hline1(Gtk2::HBox->new(0, 10)); - $this->hline1->show; - $this->line1(Gtk2::VBox->new(0, 10)); - $this->line1->show; - $this->line1->pack_end ($this->hline1, 1, 1, 0); - - $this->hline2(Gtk2::HBox->new(0, 10)); - $this->hline2->show; - $this->line2(Gtk2::VBox->new(0, 10)); - $this->line2->show; - $this->line2->pack_end ($this->hline2, 1, 1, 0); - - $this->vbox(Gtk2::VBox->new(0, 5)); - $this->vbox->pack_start($this->line1, 0, 0, 0); - $this->vbox->pack_start($this->line2, 1, 1, 0); - $this->vbox->show; - - $this->hbox->pack_start($this->vbox, 1, 1, 0); - $this->hbox->show; - - $this->fill(0); - $this->expand(0); - $this->multiline(0); -} - - -sub addwidget { - my $this=shift; - my $widget=shift; - - if ($this->multiline == 0) { - $this->hline1->pack_start($widget, 1, 1, 0); - } - else { - $this->hline2->pack_start($widget, 1, 1, 0); - } -} - - -sub adddescription { - my $this=shift; - my $description=to_Unicode($this->question->description); - - my $label=Gtk2::Label->new($description); - $label->show; - $this->line1->pack_start($label, 0, 0, 0); -} - - -sub addbutton { - my $this=shift; - my $text = shift; - my $callback = shift; - - my $button = Gtk2::Button->new_with_mnemonic(to_Unicode($text)); - $button->show; - $button->signal_connect("clicked", $callback); - - my $vbox = Gtk2::VBox->new(0, 0); - $vbox->show; - $vbox->pack_start($button, 1, 0, 0); - $this->hline1->pack_end($vbox, 0, 0, 0); -} - - -sub create_message_dialog { - my $this = shift; - my $type = shift; - my $title = shift; - my $text = shift; - - my $dialog = - Gtk2::Dialog->new_with_buttons(to_Unicode($title), undef, - "modal", "gtk-close", "close"); - $dialog->set_border_width(3); - - my $hbox = Gtk2::HBox->new(0); - $dialog->vbox->pack_start($hbox, 1, 1, 5); - $hbox->show; - - my $alignment = Gtk2::Alignment->new(0.5, 0.0, 1.0, 0.0); - $hbox->pack_start($alignment, 1, 1, 3); - $alignment->show; - - my $image = Gtk2::Image->new_from_stock($type, "dialog"); - $alignment->add($image); - $image->show; - - my $label = Gtk2::Label->new(to_Unicode($text)); - $label->set_line_wrap(1); - $hbox->pack_start($label, 1, 1, 2); - $label->show; - - $dialog->run; - $dialog->destroy; -} - - -sub addhelp { - my $this=shift; - - my $help=$this->question->extended_description; - return unless length $help; - - $this->addbutton(gettext("_Help"), sub { - $this->create_message_dialog("gtk-dialog-info", - gettext("Help"), - to_Unicode($help)); - }); - - if (defined $this->tip ){ - $this->tooltips( Gtk2::Tooltips->new() ); - $this->tooltips->set_tip($this->tip, to_Unicode($help), - undef ); - $this->tooltips->enable; - } -} - - -sub value { - my $this=shift; - - return ''; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Boolean.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Boolean.pm deleted file mode 100644 index 1ee52af..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Boolean.pm +++ /dev/null @@ -1,40 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Gnome::Boolean; -use strict; -use Gtk2; -use utf8; -use Debconf::Encoding qw(to_Unicode); -use base qw(Debconf::Element::Gnome); - - -sub init { - my $this=shift; - my $description=to_Unicode($this->question->description); - - $this->SUPER::init(@_); - - $this->widget(Gtk2::CheckButton->new($description)); - $this->widget->show; - $this->widget->set_active(($this->question->value eq 'true') ? 1 : 0); - $this->addwidget($this->widget); - $this->tip( $this->widget ); - $this->addhelp; -} - - -sub value { - my $this=shift; - - if ($this->widget->get_active) { - return "true"; - } - else { - return "false"; - } -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Error.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Error.pm deleted file mode 100644 index 6394a75..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Error.pm +++ /dev/null @@ -1,51 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Gnome::Error; -use strict; -use Debconf::Gettext; -use Gtk2; -use utf8; -use Debconf::Encoding qw(to_Unicode); -use base qw(Debconf::Element::Gnome); - - -sub init { - my $this=shift; - my $extended_description = to_Unicode($this->question->extended_description); - - $this->SUPER::init(@_); - $this->multiline(1); - $this->fill(1); - $this->expand(1); - $this->widget(Gtk2::HBox->new(0, 0)); - - my $image = Gtk2::Image->new_from_stock("gtk-dialog-error", "dialog"); - $image->show; - - my $text = Gtk2::TextView->new(); - my $textbuffer = $text->get_buffer; - $text->show; - $text->set_wrap_mode ("word"); - $text->set_editable (0); - - my $scrolled_window = Gtk2::ScrolledWindow->new(); - $scrolled_window->show; - $scrolled_window->set_policy('automatic', 'automatic'); - $scrolled_window->set_shadow_type('in'); - $scrolled_window->add ($text); - - $this->widget->show; - $this->widget->pack_start($image, 0, 0, 6); - $this->widget->pack_start($scrolled_window, 1, 1, 0); - - $textbuffer->set_text($extended_description); - - $this->widget->show; - $this->adddescription; - $this->addwidget($this->widget); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Multiselect.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Multiselect.pm deleted file mode 100644 index 34a1f4d..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Multiselect.pm +++ /dev/null @@ -1,94 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Gnome::Multiselect; -use strict; -use Gtk2; -use utf8; -use Debconf::Encoding qw(to_Unicode); -use base qw(Debconf::Element::Gnome Debconf::Element::Multiselect); - -use constant SELECTED_COLUMN => 0; -use constant CHOICES_COLUMN => 1; - -sub init { - my $this=shift; - my @choices = map { to_Unicode($_) } $this->question->choices_split; - my %default=map { to_Unicode($_) => 1 } $this->translate_default; - - $this->SUPER::init(@_); - $this->multiline(1); - - $this->adddescription; - - $this->widget(Gtk2::ScrolledWindow->new); - $this->widget->show; - $this->widget->set_policy('automatic', 'automatic'); - - my $list_store = Gtk2::ListStore->new('Glib::Boolean', 'Glib::String'); - $this->list_view(Gtk2::TreeView->new($list_store)); - $this->list_view->set_headers_visible(0); - - my $renderer_toggle = Gtk2::CellRendererToggle->new; - $renderer_toggle->signal_connect(toggled => sub { - my $path_string = $_[1]; - my $model = $_[2]; - my $iter = $model->get_iter_from_string($path_string); - $model->set($iter, SELECTED_COLUMN, - not $model->get($iter, SELECTED_COLUMN)); - }, $list_store); - - $this->list_view->append_column( - Gtk2::TreeViewColumn->new_with_attributes('Selected', - $renderer_toggle, 'active', SELECTED_COLUMN)); - $this->list_view->append_column( - Gtk2::TreeViewColumn->new_with_attributes('Choices', - Gtk2::CellRendererText->new, 'text', CHOICES_COLUMN)); - $this->list_view->show; - - $this->widget->add($this->list_view); - - for (my $i=0; $i <= $#choices; $i++) { - my $iter = $list_store->append(); - $list_store->set($iter, CHOICES_COLUMN, $choices[$i]); - if ($default{$choices[$i]}) { - $list_store->set($iter, SELECTED_COLUMN, 1); - } - } - $this->addwidget($this->widget); - $this->tip($this->list_view); - $this->addhelp; - - $this->fill(1); - $this->expand(1); - -} - - -sub value { - my $this=shift; - my $list_view = $this->list_view; - my $list_store = $list_view->get_model (); - my ($ret, $val); - - my @vals; - $this->question->template->i18n(''); - my @choices=$this->question->choices_split; - $this->question->template->i18n(1); - - my $iter = $list_store->get_iter_first(); - for (my $i=0; $i <= $#choices; $i++) { - if ($list_store->get($iter, SELECTED_COLUMN)) { - push @vals, $choices[$i]; - } - $iter = $list_store->iter_next($iter); - } - - return join(', ', $this->order_values(@vals)); -} - -*visible = \&Debconf::Element::Multiselect::visible; - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Note.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Note.pm deleted file mode 100644 index 68ac016..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Note.pm +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Gnome::Note; -use strict; -use Debconf::Gettext; -use Gtk2; -use utf8; -use Debconf::Encoding qw(to_Unicode); -use Debconf::Element::Noninteractive::Note; -use base qw(Debconf::Element::Gnome); - - -sub init { - my $this=shift; - my $extended_description = to_Unicode($this->question->extended_description); - - $this->SUPER::init(@_); - $this->multiline(1); - $this->fill(1); - $this->expand(1); - $this->widget(Gtk2::HBox->new(0, 0)); - - my $text = Gtk2::TextView->new(); - my $textbuffer = $text->get_buffer; - $text->show; - $text->set_wrap_mode ("word"); - $text->set_editable (0); - - my $scrolled_window = Gtk2::ScrolledWindow->new(); - $scrolled_window->show; - $scrolled_window->set_policy('automatic', 'automatic'); - $scrolled_window->set_shadow_type('in'); - $scrolled_window->add ($text); - - $this->widget->show; - $this->widget->pack_start($scrolled_window, 1, 1, 0); - - $textbuffer->set_text($extended_description); - - $this->widget->show; - $this->adddescription; - $this->addwidget($this->widget); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Password.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Password.pm deleted file mode 100644 index 5ea5c80..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Password.pm +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Gnome::Password; -use strict; -use Gtk2; -use utf8; -use base qw(Debconf::Element::Gnome); - - - -sub init { - my $this=shift; - - $this->SUPER::init(@_); - $this->adddescription; - - $this->widget(Gtk2::Entry->new); - $this->widget->show; - $this->widget->set_visibility(0); - $this->addwidget($this->widget); - $this->tip( $this->widget ); - $this->addhelp; -} - - -sub value { - my $this=shift; - - my $text = $this->widget->get_chars(0, -1); - $text = $this->question->value if $text eq ''; - return $text; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Progress.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Progress.pm deleted file mode 100644 index e1663fa..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Progress.pm +++ /dev/null @@ -1,63 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Gnome::Progress; -use strict; -use Gtk2; -use utf8; -use Debconf::Encoding qw(to_Unicode); -use base qw(Debconf::Element::Gnome); - - -sub _fraction { - my $this=shift; - - return (($this->progress_cur() - $this->progress_min()) / ($this->progress_max() - $this->progress_min())); -} - -sub start { - my $this=shift; - my $description=to_Unicode($this->question->description); - my $frontend=$this->frontend; - - $this->SUPER::init(@_); - $this->multiline(1); - $this->expand(1); - - $frontend->title($description); - - $this->widget(Gtk2::ProgressBar->new()); - $this->widget->show; - $this->widget->set_text(' '); - $this->addwidget($this->widget); - $this->addhelp; -} - -sub set { - my $this=shift; - my $value=shift; - - $this->progress_cur($value); - $this->widget->set_fraction($this->_fraction); - - return 1; -} - -sub info { - my $this=shift; - my $question=shift; - - $this->widget->set_text(to_Unicode($question->description)); - - return 1; -} - -sub stop { - my $this=shift; - my $frontend=$this->frontend; - - $frontend->title($frontend->requested_title); -} - -1; diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Select.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Select.pm deleted file mode 100644 index 8e63f86..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Select.pm +++ /dev/null @@ -1,52 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Gnome::Select; -use strict; -use Gtk2; -use Gnome2; -use utf8; -use Debconf::Encoding qw(to_Unicode); -use base qw(Debconf::Element::Gnome Debconf::Element::Select); - - -sub init { - my $this=shift; - - my $default=$this->translate_default; - my @choices= map { to_Unicode($_) } $this->question->choices_split; - - $this->SUPER::init(@_); - - $this->widget(Gtk2::Combo->new); - $this->widget->show; - - $this->widget->set_popdown_strings(@choices); - $this->widget->set_value_in_list(1, 0); - $this->widget->entry->set_editable(0); - - if (defined($default) and length($default) != 0) { - $this->widget->entry->set_text(to_Unicode($default)); - } - else { - $this->widget->entry->set_text($choices[0]); - } - - $this->adddescription; - $this->addwidget($this->widget); - $this->tip( $this->widget->entry ); - $this->addhelp; -} - - -sub value { - my $this=shift; - - return $this->translate_to_C_uni($this->widget->entry->get_chars(0, -1)); -} - -*visible = \&Debconf::Element::Select::visible; - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/String.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/String.pm deleted file mode 100644 index 0bb922d..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/String.pm +++ /dev/null @@ -1,40 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Gnome::String; -use strict; -use Gtk2; -use utf8; -use Debconf::Encoding qw(to_Unicode); -use base qw(Debconf::Element::Gnome); - - -sub init { - my $this=shift; - - $this->SUPER::init(@_); - - $this->widget(Gtk2::Entry->new); - $this->widget->show; - - my $default=''; - $default=$this->question->value if defined $this->question->value; - - $this->widget->set_text(to_Unicode($default)); - - $this->adddescription; - $this->addwidget($this->widget); - $this->tip( $this->widget ); - $this->addhelp; -} - - -sub value { - my $this=shift; - - return $this->widget->get_chars(0, -1); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Text.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Text.pm deleted file mode 100644 index 9d6518f..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Gnome/Text.pm +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Gnome::Text; -use strict; -use Debconf::Gettext; -use Gtk2; -use utf8; -use base qw(Debconf::Element::Gnome); - - -sub init { - my $this=shift; - - $this->SUPER::init(@_); - $this->adddescription; # yeah, that's all -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde.pm deleted file mode 100644 index 0b74574..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde.pm +++ /dev/null @@ -1,141 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Kde::ElementWidget; -use QtCore4; -use QtCore4::isa @ISA = qw(Qt::Widget); -use QtGui4; - - -sub NEW { - shift->SUPER::NEW ($_[0]); - this->{mytop} = undef; -} - - -sub settop { - this->{mytop} = shift; -} - - -sub init { - this->{toplayout} = Qt::VBoxLayout(this); - this->{mytop} = Qt::Widget(this); - this->{toplayout}->addWidget (this->{mytop}); - this->{layout} = Qt::VBoxLayout(); - this->{mytop}->setLayout(this->{layout}); -} - - -sub destroy { - this->{toplayout} -> removeWidget (this->{mytop}); - undef this->{mytop}; -} - - -sub top { - return this->{mytop}; -} - - -sub addwidget { - this->{layout}->addWidget(@_); -} - - -sub addlayout { - this->{layout}->addLayout (@_); -} - - - - - - -package Debconf::Element::Kde; -use strict; -use QtCore4; -use QtGui4; -use Debconf::Gettext; -use base qw(Debconf::Element); -use Debconf::Element::Kde::ElementWidget; -use Debconf::Encoding qw(to_Unicode); - - -sub create { - my $this=shift; - $this->parent(shift); - $this->top(Debconf::Element::Kde::ElementWidget($this->parent, undef, - undef, undef)); - $this->top->init; - $this->top->show; -} - - -sub destroy { - my $this=shift; - $this->top(undef); -} - - -sub addwidget { - my $this=shift; - my $widget=shift; - $this->cur->addwidget($widget); -} - - -sub description { - my $this=shift; - my $label=Qt::Label($this->cur->top); - $label->setText("<b>".to_Unicode($this->question->description."</b>")); - $label->show; - return $label; -} - - -sub startsect { - my $this = shift; - my $ew = Debconf::Element::Kde::ElementWidget($this->top); - $ew->init; - $this->cur($ew); - $this->top->addwidget($ew); - $ew->show; -} - - -sub endsect { - my $this = shift; - $this->cur($this->top); -} - - -sub adddescription { - my $this=shift; - my $label=$this->description; - $this->addwidget($label); -} - - -sub addhelp { - my $this=shift; - - my $help=to_Unicode($this->question->extended_description); - return unless length $help; - my $label=Qt::Label($this->cur->top); - $label->setText($help); - $label->setWordWrap(1); - $this->addwidget($label); # line1 - $label->setMargin(5); - $label->show; -} - - -sub value { - my $this=shift; - return ''; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Boolean.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Boolean.pm deleted file mode 100644 index 1d5d9be..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Boolean.pm +++ /dev/null @@ -1,41 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Kde::Boolean; -use strict; -use QtCore4; -use QtGui4; -use base qw(Debconf::Element::Kde); -use Debconf::Encoding qw(to_Unicode); - - -sub create { - my $this=shift; - - $this->SUPER::create(@_); - - $this->startsect; - $this->widget(Qt::CheckBox( to_Unicode($this->question->description))); - $this->widget->setChecked(($this->question->value eq 'true') ? 1 : 0); - $this->widget->setText(to_Unicode($this->question->description)); - $this->adddescription; - $this->addhelp; - $this->addwidget($this->widget); - $this->endsect; -} - - -sub value { - my $this = shift; - - if ($this -> widget -> isChecked) { - return "true"; - } - else { - return "false"; - } -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Error.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Error.pm deleted file mode 100644 index 8e7ae99..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Error.pm +++ /dev/null @@ -1,23 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Kde::Error; -use strict; -use Debconf::Gettext; -use QtCore4; -use QtGui4; -use base qw(Debconf::Element::Kde); - - -sub create { - my $this=shift; - $this->SUPER::create(@_); - $this->startsect; - $this->adddescription; - $this->addhelp; - $this->endsect; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Multiselect.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Multiselect.pm deleted file mode 100644 index dcbdb79..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Multiselect.pm +++ /dev/null @@ -1,58 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Kde::Multiselect; -use strict; -use QtCore4; -use QtGui4; -use base qw(Debconf::Element::Kde Debconf::Element::Multiselect); -use Debconf::Encoding qw(to_Unicode); - - -sub create { - my $this=shift; - - my @choices = $this->question->choices_split; - my %default = map { $_ => 1 } $this->translate_default; - - $this->SUPER::create(@_); - $this->startsect; - $this->adddescription; - $this->addhelp; - - my @buttons; - for (my $i=0; $i <= $#choices; $i++) { - $buttons[$i] = Qt::CheckBox($this->cur->top); - $buttons[$i]->setText(to_Unicode($choices[$i])); - $buttons[$i]->show; - $buttons[$i]->setChecked($default{$choices[$i]} ? 1 : 0); - $this->addwidget($buttons[$i]); - } - - $this->buttons(\@buttons); - $this->endsect; -} - - -sub value { - my $this = shift; - my @buttons = @{$this->buttons}; - my ($ret, $val); - my @vals; - $this->question->template->i18n(''); - my @choices=$this->question->choices_split; - $this->question->template->i18n(1); - - for (my $i = 0; $i <= $#choices; $i++) { - if ($buttons [$i] -> isChecked()) { - push @vals, $choices[$i]; - } - } - return join(', ', $this->order_values(@vals)); -} - -*visible = \&Debconf::Element::Multiselect::visible; - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Note.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Note.pm deleted file mode 100644 index 405ac16..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Note.pm +++ /dev/null @@ -1,23 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Kde::Note; -use strict; -use Debconf::Gettext; -use Qt; -use Debconf::Element::Noninteractive::Note; -use base qw(Debconf::Element::Kde); - - -sub create { - my $this=shift; - $this->SUPER::create(@_); - $this->startsect; - $this->adddescription; - $this->addhelp; - $this->endsect; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Password.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Password.pm deleted file mode 100644 index 95cf6c1..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Password.pm +++ /dev/null @@ -1,36 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Kde::Password; -use strict; -use QtCore4; -use QtGui4; -use base qw(Debconf::Element::Kde); - - -sub create { - my $this=shift; - - $this->SUPER::create(@_); - $this->startsect; - $this->widget(Qt::LineEdit($this->cur->top)); - $this->widget->show; - $this->widget->setEchoMode(2); - $this->addwidget($this->description); - $this->addhelp; - $this->addwidget($this->widget); - $this->endsect; -} - - -sub value { - my $this=shift; - - my $text = $this->widget->text(); - $text = $this->question->value if $text eq ''; - return $text; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Progress.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Progress.pm deleted file mode 100644 index ff013a7..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Progress.pm +++ /dev/null @@ -1,60 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Kde::Progress; -use strict; -use QtCore4; -use QtGui4; -use base qw(Debconf::Element::Kde); -use Debconf::Encoding qw(to_Unicode); - - -sub start { - my $this=shift; - my $description=to_Unicode($this->question->description); - my $frontend=$this->frontend; - - $this->SUPER::create($frontend->frame); - - $this->startsect; - $this->addhelp; - $this->adddescription; - my $vbox = Qt::VBoxLayout($this->widget); - - $this->progress_bar(Qt::ProgressBar($this->cur->top)); - $this->progress_bar->setMinimum($this->progress_min()); - $this->progress_bar->setMaximum($this->progress_max()); - $this->progress_bar->show; - $this->addwidget($this->progress_bar); - - $this->progress_label(Qt::Label($this->cur->top)); - $this->progress_label->show; - $this->addwidget($this->progress_label); - - $this->endsect; -} - -sub set { - my $this=shift; - my $value=shift; - - - $this->progress_cur($value); - $this->progress_bar->setValue($this->progress_cur); - return 1; -} - -sub info { - my $this=shift; - my $question=shift; - - $this->progress_label->setText(to_Unicode($question->description)); - - return 1; -} - -sub stop { -} - -1; diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Select.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Select.pm deleted file mode 100644 index 2cb341b..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Select.pm +++ /dev/null @@ -1,49 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Kde::Select; -use strict; -use QtCore4; -use QtGui4; -use base qw(Debconf::Element::Kde Debconf::Element::Select); -use Debconf::Encoding qw(to_Unicode); - - -sub create { - my $this=shift; - - my $default=$this->translate_default; - my @choices=map { to_Unicode($_) } $this->question->choices_split; - - $this->SUPER::create(@_); - $this->startsect; - $this->widget(Qt::ComboBox($this->cur->top)); - $this->widget->show; - $this->widget->addItems(\@choices); - if (defined($default) and length($default) != 0) { - for (my $i = 0 ; $i < @choices ; $i++) { - if ($choices[$i] eq $default ) { - $this->widget->setCurrentIndex($i);# //FIXME find right index to_Unicode($default)); - last; - } - } - } - $this->addwidget($this->description); - $this->addhelp; - $this->addwidget($this->widget); - $this->endsect; -} - - -sub value { - my $this=shift; - - my @choices=$this->question->choices_split; - return $this->translate_to_C_uni($this->widget->currentText()); -} - -*visible = \&Debconf::Element::Select::visible; - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/String.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/String.pm deleted file mode 100644 index 65e16f7..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/String.pm +++ /dev/null @@ -1,35 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Kde::String; -use strict; -use QtCore4; -use QtGui4; -use base qw(Debconf::Element::Kde); -use Debconf::Encoding qw(to_Unicode); - - -sub create { - my $this=shift; - - $this->SUPER::create(@_); - $this->startsect; - $this->widget(Qt::LineEdit($this->cur->top)); - my $default=''; - $default=$this->question->value if defined $this->question->value; - $this->widget->setText(to_Unicode($default)); - $this->adddescription; - $this->addhelp; - $this->addwidget ($this->widget); - $this->endsect; -} - - -sub value { - my $this=shift; - return $this->widget->text(); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Text.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Text.pm deleted file mode 100644 index 394319f..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Kde/Text.pm +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Kde::Text; -use strict; -use Debconf::Gettext; -use Qt; -use base qw(Debconf::Element::Kde); - - -sub create { - my $this=shift; - $this->SUPER::create(@_); - $this->startsect; - $this->adddescription; # yeah, that's all - $this->endsect; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Multiselect.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Multiselect.pm deleted file mode 100644 index 1d1b26e..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Multiselect.pm +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Multiselect; -use strict; -use base qw(Debconf::Element::Select); - - -sub order_values { - my $this=shift; - my %vals=map { $_ => 1 } @_; - $this->question->template->i18n(''); - my @ret=grep { $vals{$_} } $this->question->choices_split; - $this->question->template->i18n(1); - return @ret; -} - - -sub visible { - my $this=shift; - - my @choices=$this->question->choices_split; - return ($#choices >= 0); -} - - -sub translate_default { - my $this=shift; - - my @choices=$this->question->choices_split; - $this->question->template->i18n(''); - my @choices_c=$this->question->choices_split; - $this->question->template->i18n(1); - - my @ret; - foreach my $c_default ($this->question->value_split) { - foreach (my $x=0; $x <= $#choices; $x++) { - push @ret, $choices[$x] - if $choices_c[$x] eq $c_default; - } - } - return @ret; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive.pm deleted file mode 100644 index b2e5cee..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive.pm +++ /dev/null @@ -1,26 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Noninteractive; -use strict; -use base qw(Debconf::Element); - - -sub visible { - my $this=shift; - - return; -} - - -sub show { - my $this=shift; - - my $default=''; - $default=$this->question->value if defined $this->question->value; - $this->value($default); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Boolean.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Boolean.pm deleted file mode 100644 index b57d144..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Boolean.pm +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Noninteractive::Boolean; -use strict; -use base qw(Debconf::Element::Noninteractive); - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Error.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Error.pm deleted file mode 100644 index 59701db..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Error.pm +++ /dev/null @@ -1,63 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Noninteractive::Error; -use strict; -use Text::Wrap; -use Debconf::Gettext; -use Debconf::Config; -use Debconf::Log ':all'; -use base qw(Debconf::Element::Noninteractive); - - - -sub show { - my $this=shift; - - if ($this->question->flag('seen') ne 'true') { - $this->sendmail(gettext("Debconf was not configured to display this error message, so it mailed it to you.")); - } - $this->value(''); -} - - -sub sendmail { - my $this=shift; - my $footer=shift; - return unless length Debconf::Config->admin_email; - if (-x '/usr/bin/mail') { - debug user => "mailing a note"; - my $title=gettext("Debconf").": ". - $this->frontend->title." -- ". - $this->question->description; - unless (open(MAIL, "|-")) { # child - exec("mail", "-s", $title, Debconf::Config->admin_email) or return ''; - } - my $old_columns=$Text::Wrap::columns; - $Text::Wrap::columns=75; - if ($this->question->extended_description ne '') { - print MAIL wrap('', '', $this->question->extended_description); - } - else { - print MAIL wrap('', '', $this->question->description); - } - print MAIL "\n\n"; - my $hostname=`hostname -f 2>/dev/null`; - if (! defined $hostname) { - $hostname="unknown system"; - } - print MAIL "-- \n", sprintf(gettext("Debconf, running at %s"), $hostname, "\n"); - print MAIL "[ ", wrap('', '', $footer), " ]\n" if $footer; - close MAIL or return ''; - - $Text::Wrap::columns=$old_columns; - - $this->question->flag('seen', 'true'); - - return 1; - } -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Multiselect.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Multiselect.pm deleted file mode 100644 index a30c804..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Multiselect.pm +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Noninteractive::Multiselect; -use strict; -use base qw(Debconf::Element::Noninteractive); - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Note.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Note.pm deleted file mode 100644 index 6567819..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Note.pm +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Noninteractive::Note; -use strict; -use base qw(Debconf::Element::Noninteractive); - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Password.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Password.pm deleted file mode 100644 index da6dcce..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Password.pm +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Noninteractive::Password; -use strict; -use base qw(Debconf::Element::Noninteractive); - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Progress.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Progress.pm deleted file mode 100644 index 3c14c47..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Progress.pm +++ /dev/null @@ -1,24 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Noninteractive::Progress; -use strict; -use base qw(Debconf::Element::Noninteractive); - - -sub start { -} - -sub set { - return 1; -} - -sub info { - return 1; -} - -sub stop { -} - -1; diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Select.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Select.pm deleted file mode 100644 index 5b74aec..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Select.pm +++ /dev/null @@ -1,35 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Noninteractive::Select; -use strict; -use base qw(Debconf::Element::Noninteractive); - - -sub show { - my $this=shift; - - $this->question->template->i18n(''); - my @choices=$this->question->choices_split; - $this->question->template->i18n(1); - my $value=$this->question->value; - $value='' unless defined $value; - my $inlist=0; - map { $inlist=1 if $_ eq $value } @choices; - - if (! $inlist) { - if (@choices) { - $this->value($choices[0]); - } - else { - $this->value(''); - } - } - else { - $this->value($value); - } -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/String.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/String.pm deleted file mode 100644 index adbc516..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/String.pm +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Noninteractive::String; -use strict; -use base qw(Debconf::Element::Noninteractive); - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Text.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Text.pm deleted file mode 100644 index be14ae8..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Noninteractive/Text.pm +++ /dev/null @@ -1,16 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Noninteractive::Text; -use strict; -use base qw(Debconf::Element::Noninteractive); - - -sub show { - my $this=shift; - - $this->value(''); -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Select.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Select.pm deleted file mode 100644 index 4082518..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Select.pm +++ /dev/null @@ -1,78 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Select; -use strict; -use Debconf::Log ':all'; -use Debconf::Gettext; -use base qw(Debconf::Element); -use Debconf::Encoding qw(to_Unicode); - - -sub visible { - my $this=shift; - - my @choices=$this->question->choices_split; - - if (@choices > 1) { - return 1; - } - else { - debug 'developer' => 'Not displaying select list '. - $this->question->name.' with '. - (@choices+0).' choice'.((@choices == 0) ? 's' : ''); - return 0; - } -} - - -sub translate_default { - my $this=shift; - - my @choices=$this->question->choices_split; - $this->question->template->i18n(''); - my @choices_c=$this->question->choices_split; - $this->question->template->i18n(1); - - my $c_default=''; - $c_default=$this->question->value if defined $this->question->value; - foreach (my $x=0; $x <= $#choices; $x++) { - return $choices[$x] if $choices_c[$x] eq $c_default; - } - return ''; -} - - -sub translate_to_C { - my $this=shift; - my $value=shift; - - my @choices=$this->question->choices_split; - $this->question->template->i18n(''); - my @choices_c=$this->question->choices_split; - $this->question->template->i18n(1); - - for (my $x=0; $x <= $#choices; $x++) { - return $choices_c[$x] if $choices[$x] eq $value; - } - debug developer => sprintf(gettext("Input value, \"%s\" not found in C choices! This should never happen. Perhaps the templates were incorrectly localized."), $value); - return ''; -} - -sub translate_to_C_uni { - my $this=shift; - my $value=shift; - my @choices=$this->question->choices_split; - $this->question->template->i18n(''); - my @choices_c=$this->question->choices_split; - $this->question->template->i18n(1); - - for (my $x=0; $x <= $#choices; $x++) { - return $choices_c[$x] if to_Unicode($choices[$x]) eq $value; - } - debug developer => sprintf(gettext("Input value, \"%s\" not found in C choices! This should never happen. Perhaps the templates were incorrectly localized."), $value); - return ''; -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Boolean.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Boolean.pm deleted file mode 100644 index 584ebca..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Boolean.pm +++ /dev/null @@ -1,67 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Teletype::Boolean; -use strict; -use Debconf::Gettext; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - my $y=gettext("yes"); - my $n=gettext("no"); - - $this->frontend->display($this->question->extended_description."\n"); - - my $default=''; - $default=$this->question->value if defined $this->question->value; - if ($default eq 'true') { - $default=$y; - } - elsif ($default eq 'false') { - $default=$n; - } - - my $value=''; - - while (1) { - $_=$this->frontend->prompt( - default => $default, - completions => [$y, $n], - prompt => $this->question->description, - question => $this->question, - ); - return unless defined $_; - - if (substr($y, 0, 1) ne substr($n, 0, 1)) { - $y=substr($y, 0, 1); - $n=substr($n, 0, 1); - } - if (/^\Q$y\E/i) { - $value='true'; - last; - } - elsif (/^\Q$n\E/i) { - $value='false'; - last; - } - - if (/^y/i) { - $value='true'; - last; - } - elsif (/^n/i) { - $value='false'; - last; - } - } - - $this->frontend->display("\n"); - $this->value($value); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Error.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Error.pm deleted file mode 100644 index 3f0543f..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Error.pm +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Teletype::Error; -use strict; -use base qw(Debconf::Element::Teletype::Text); - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Multiselect.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Multiselect.pm deleted file mode 100644 index 8bc89a3..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Multiselect.pm +++ /dev/null @@ -1,78 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Teletype::Multiselect; -use strict; -use Debconf::Gettext; -use Debconf::Config; -use base qw(Debconf::Element::Multiselect Debconf::Element::Teletype::Select); - - -sub show { - my $this=shift; - - my @selected; - my $none_of_the_above=gettext("none of the above"); - - my @choices=$this->question->choices_split; - my %value = map { $_ => 1 } $this->translate_default; - if ($this->frontend->promptdefault && $this->question->value ne '') { - push @choices, $none_of_the_above; - } - my @completions=@choices; - my $i=1; - my %choicenum=map { $_ => $i++ } @choices; - - $this->frontend->display($this->question->extended_description."\n"); - - my $default; - if (Debconf::Config->terse eq 'false') { - $this->printlist(@choices); - $this->frontend->display("\n(".gettext("Enter the items you want to select, separated by spaces.").")\n"); - push @completions, 1..@choices; - $default=join(" ", map { $choicenum{$_} } - grep { $value{$_} } @choices); - } - else { - $default=join(" ", grep { $value{$_} } @choices); - } - - while (1) { - $_=$this->frontend->prompt( - prompt => $this->question->description, - default => $default, - completions => [@completions], - completion_append_character => " ", - question => $this->question, - ); - return unless defined $_; - - @selected=split(/[ ,]+/, $_); - - @selected=map { $this->expandabbrev($_, @choices) } @selected; - - next if grep { $_ eq '' } @selected; - - if ($#selected > 0) { - map { next if $_ eq $none_of_the_above } @selected; - } - - last; - } - - $this->frontend->display("\n"); - - if (defined $selected[0] && $selected[0] eq $none_of_the_above) { - $this->value(''); - } - else { - my %selected=map { $_ => 1 } @selected; - - $this->value(join(', ', $this->order_values( - map { $this->translate_to_C($_) } - keys %selected))); - } -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Note.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Note.pm deleted file mode 100644 index 086f6d2..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Note.pm +++ /dev/null @@ -1,26 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Teletype::Note; -use strict; -use base qw(Debconf::Element); - - - -sub visible { - my $this=shift; - - return (Debconf::Config->terse eq 'false'); -} - -sub show { - my $this=shift; - - $this->frontend->display($this->question->description."\n\n". - $this->question->extended_description."\n"); - - $this->value(''); -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Password.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Password.pm deleted file mode 100644 index 3d07d59..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Password.pm +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Teletype::Password; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - $this->frontend->display( - $this->question->extended_description."\n"); - - my $default=''; - $default=$this->question->value if defined $this->question->value; - - my $value=$this->frontend->prompt_password( - prompt => $this->question->description, - default => $default, - question => $this->question, - ); - return unless defined $value; - - if ($value eq '') { - $value=$default; - } - - $this->frontend->display("\n"); - $this->value($value); -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Progress.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Progress.pm deleted file mode 100644 index 35985dd..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Progress.pm +++ /dev/null @@ -1,46 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Teletype::Progress; -use strict; -use base qw(Debconf::Element); - - -sub start { - my $this=shift; - - $this->frontend->title($this->question->description); - $this->frontend->display(''); - $this->last(0); -} - -sub set { - my $this=shift; - my $value=shift; - - $this->progress_cur($value); - - use integer; - my $new = ($this->progress_cur() - $this->progress_min()) * 100 / ($this->progress_max() - $this->progress_min()); - $this->last(0) if $new < $this->last; - return if $new / 10 == $this->last / 10; - - $this->last($new); - $this->frontend->display("..$new%"); - - return 1; -} - -sub info { - return 1; -} - -sub stop { - my $this=shift; - - $this->frontend->display("\n"); - $this->frontend->title($this->frontend->requested_title); -} - -1; diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Select.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Select.pm deleted file mode 100644 index e5a02a3..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Select.pm +++ /dev/null @@ -1,144 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Teletype::Select; -use strict; -use Debconf::Config; -use POSIX qw(ceil); -use base qw(Debconf::Element::Select); - - -sub expandabbrev { - my $this=shift; - my $input=shift; - my @choices=@_; - - if (Debconf::Config->terse eq 'false' and - $input=~m/^[0-9]+$/ and $input ne '0' and $input <= @choices) { - return $choices[$input - 1]; - } - - my @matches=(); - foreach (@choices) { - return $_ if /^\Q$input\E$/; - push @matches, $_ if /^\Q$input\E/; - } - return $matches[0] if @matches == 1; - - if (! @matches) { - foreach (@choices) { - return $_ if /^\Q$input\E$/i; - push @matches, $_ if /^\Q$input\E/i; - } - return $matches[0] if @matches == 1; - } - - return ''; -} - - -sub printlist { - my $this=shift; - my @choices=@_; - my $width=$this->frontend->screenwidth; - - my $choice_min=length $choices[0]; - map { $choice_min = length $_ if length $_ < $choice_min } @choices; - my $max_cols=int($width / (2 + length(@choices) + 2 + $choice_min)) - 1; - $max_cols = $#choices if $max_cols > $#choices; - - my $max_lines; - my $num_cols; -COLUMN: for ($num_cols = $max_cols; $num_cols >= 0; $num_cols--) { - my @col_width; - my $total_width; - - $max_lines=ceil(($#choices + 1) / ($num_cols + 1)); - - next if ceil(($#choices + 1) / $max_lines) - 1 < $num_cols; - - foreach (my $choice=1; $choice <= $#choices + 1; $choice++) { - my $choice_length=2 - + length(@choices) + 2 - + length($choices[$choice - 1]); - my $current_col=ceil($choice / $max_lines) - 1; - if (! defined $col_width[$current_col] || - $choice_length > $col_width[$current_col]) { - $col_width[$current_col]=$choice_length; - $total_width=0; - map { $total_width += $_ } @col_width; - next COLUMN if $total_width > $width; - } - } - - last; - } - - my $line=0; - my $max_len=0; - my $col=0; - my @output=(); - for (my $choice=0; $choice <= $#choices; $choice++) { - $output[$line] .= " ".($choice+1).". " . $choices[$choice]; - if (length $output[$line] > $max_len) { - $max_len = length $output[$line]; - } - if (++$line >= $max_lines) { - if ($col++ != $num_cols) { - for (my $l=0; $l <= $#output; $l++) { - $output[$l] .= ' ' x ($max_len - length $output[$l]); - } - } - - $line=0; - $max_len=0; - } - } - - @output = map { s/\s+$//; $_ } @output; - - map { $this->frontend->display_nowrap($_) } @output; -} - -sub show { - my $this=shift; - - my $default=$this->translate_default; - my @choices=$this->question->choices_split; - my @completions=@choices; - - $this->frontend->display($this->question->extended_description."\n"); - - if (Debconf::Config->terse eq 'false') { - for (my $choice=0; $choice <= $#choices; $choice++) { - if ($choices[$choice] eq $default) { - $default=$choice + 1; - last; - } - } - - $this->printlist(@choices); - $this->frontend->display("\n"); - - push @completions, 1..@choices; - } - - my $value; - while (1) { - $value=$this->frontend->prompt( - prompt => $this->question->description, - default => $default ? $default : '', - completions => [@completions], - question => $this->question, - ); - return unless defined $value; - $value=$this->expandabbrev($value, @choices); - last if $value ne ''; - } - $this->frontend->display("\n"); - $this->value($this->translate_to_C($value)); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/String.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/String.pm deleted file mode 100644 index 9b935b3..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/String.pm +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Teletype::String; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - $this->frontend->display( - $this->question->extended_description."\n"); - - my $default=''; - $default=$this->question->value if defined $this->question->value; - - my $value=$this->frontend->prompt( - prompt => $this->question->description, - default => $default, - question => $this->question, - ); - return unless defined $value; - - $this->frontend->display("\n"); - $this->value($value); -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Text.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Text.pm deleted file mode 100644 index e24e8c6..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Teletype/Text.pm +++ /dev/null @@ -1,19 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Teletype::Text; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - $this->frontend->display($this->question->description."\n\n". - $this->question->extended_description."\n"); - - $this->value(''); -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Boolean.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Boolean.pm deleted file mode 100644 index 37748e6..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Boolean.pm +++ /dev/null @@ -1,36 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Web::Boolean; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - $_=$this->question->extended_description; - s/\n/\n<br>\n/g; - $_.="\n<p>\n"; - - my $default=''; - $default=$this->question->value if defined $this->question->value; - my $id=$this->id; - $_.="<input type=checkbox name=\"$id\"". ($default eq 'true' ? ' checked' : ''). ">\n<b>". - $this->question->description."</b>"; - - return $_; -} - - -sub value { - my $this=shift; - - return $this->SUPER::value() unless @_; - my $value=shift; - $this->SUPER::value($value eq 'on' ? 'true' : 'false'); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Error.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Error.pm deleted file mode 100644 index cad58e3..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Error.pm +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Web::Error; -use strict; -use base qw(Debconf::Element::Web::Text); - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Multiselect.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Multiselect.pm deleted file mode 100644 index 18bad0d..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Multiselect.pm +++ /dev/null @@ -1,51 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Web::Multiselect; -use strict; -use base qw(Debconf::Element::Multiselect); - - -sub show { - my $this=shift; - - $_=$this->question->extended_description; - s/\n/\n<br>\n/g; - $_.="\n<p>\n"; - - my %value = map { $_ => 1 } $this->translate_default; - - my $id=$this->id; - $_.="<b>".$this->question->description."</b>\n<select multiple name=\"$id\">\n"; - my $c=0; - foreach my $x ($this->question->choices_split) { - if (! $value{$x}) { - $_.="<option value=".$c++.">$x\n"; - } - else { - $_.="<option value=".$c++." selected>$x\n"; - } - } - $_.="</select>\n"; - - return $_; -} - - -sub value { - my $this=shift; - - return $this->SUPER::value() unless @_; - - my @values=@_; - - $this->question->template->i18n(''); - my @choices=$this->question->choices_split; - $this->question->template->i18n(1); - - $this->SUPER::value(join(', ', $this->order_values(map { $choices[$_] } @values))); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Note.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Note.pm deleted file mode 100644 index d7fd359..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Note.pm +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Web::Note; -use strict; -use base qw(Debconf::Element::Web::Text); - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Password.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Password.pm deleted file mode 100644 index 0242e5e..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Password.pm +++ /dev/null @@ -1,26 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Web::Password; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - $_=$this->question->extended_description; - s/\n/\n<br>\n/g; - $_.="\n<p>\n"; - - my $default=''; - $default=$this->question->value if defined $this->question->value; - my $id=$this->id; - $_.="<b>".$this->question->description."</b><input type=password name=\"$id\" value=\"$default\">\n"; - - return $_; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Progress.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Progress.pm deleted file mode 100644 index d186fe8..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Progress.pm +++ /dev/null @@ -1,24 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Web::Progress; -use strict; -use base qw(Debconf::Element); - - -sub start { -} - -sub set { - return 1; -} - -sub info { - return 1; -} - -sub stop { -} - -1; diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Select.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Select.pm deleted file mode 100644 index 1a3b456..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Select.pm +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Web::Select; -use strict; -use base qw(Debconf::Element::Select); - - -sub show { - my $this=shift; - - $_=$this->question->extended_description; - s/\n/\n<br>\n/g; - $_.="\n<p>\n"; - - my $default=$this->translate_default; - my $id=$this->id; - $_.="<b>".$this->question->description."</b>\n<select name=\"$id\">\n"; - my $c=0; - foreach my $x ($this->question->choices_split) { - if ($x ne $default) { - $_.="<option value=".$c++.">$x\n"; - } - else { - $_.="<option value=".$c++." selected>$x\n"; - } - } - $_.="</select>\n"; - - return $_; -} - - -sub value { - my $this=shift; - - return $this->SUPER::value() unless @_; - my $value=shift; - - $this->question->template->i18n(''); - my @choices=$this->question->choices_split; - $this->question->template->i18n(1); - $this->SUPER::value($choices[$value]); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/String.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/String.pm deleted file mode 100644 index 3fefbf2..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/String.pm +++ /dev/null @@ -1,26 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Web::String; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - $_=$this->question->extended_description; - s/\n/\n<br>\n/g; - $_.="\n<p>\n"; - - my $default=''; - $default=$this->question->value if defined $this->question->value; - my $id=$this->id; - $_.="<b>".$this->question->description."</b><input name=\"$id\" value=\"$default\">\n"; - - return $_; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Text.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Text.pm deleted file mode 100644 index fad43f0..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Element/Web/Text.pm +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Element::Web::Text; -use strict; -use base qw(Debconf::Element); - - -sub show { - my $this=shift; - - $_=$this->question->extended_description; - s/\n/\n<br>\n/g; - $_.="\n<p>\n"; - - return "<b>".$this->question->description."</b>$_<p>"; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Encoding.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Encoding.pm deleted file mode 100644 index 2837f9a..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Encoding.pm +++ /dev/null @@ -1,73 +0,0 @@ -#!/usr/bin/perl -# This file was preprocessed, do not edit! - - -package Debconf::Encoding; - -use strict; -use warnings; - -our $charmap; -BEGIN { - no warnings; - eval q{ use Text::Iconv }; - use warnings; - if (! $@) { - $charmap = `locale charmap`; - chomp $charmap; - } - - no warnings; - eval q{ use Text::WrapI18N; use Text::CharWidth }; - use warnings; - if (! $@) { - *wrap = *Text::WrapI18N::wrap; - *columns = *Text::WrapI18N::columns; - *width = *Text::CharWidth::mbswidth; - } - else { - require Text::Wrap; - require Text::Tabs; - sub _wrap { return Text::Tabs::expand(Text::Wrap::wrap(@_)) } - *wrap = *_wrap; - *columns = *Text::Wrap::columns; - sub _dumbwidth { length shift } - *width = *_dumbwidth; - } -} - -use base qw(Exporter); -our @EXPORT_OK=qw(wrap $columns width convert $charmap to_Unicode); - -my $converter; -my $old_input_charmap; -sub convert { - my $input_charmap = shift; - my $string = shift; - - return unless defined $charmap; - - if (! defined $old_input_charmap || - $input_charmap ne $old_input_charmap) { - $converter = Text::Iconv->new($input_charmap, $charmap); - $old_input_charmap = $input_charmap; - } - return $converter->convert($string); -} - -my $unicode_conv; -sub to_Unicode { - my $string = shift; - my $result; - - return $string if utf8::is_utf8($string); - if (!defined $unicode_conv) { - $unicode_conv = Text::Iconv->new($charmap, "UTF-8"); - } - $result = $unicode_conv->convert($string); - utf8::decode($result); - return $result; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Format.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Format.pm deleted file mode 100644 index 5058937..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Format.pm +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Format; -use strict; -use base qw(Debconf::Base); - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Format/822.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Format/822.pm deleted file mode 100644 index 7d627b3..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Format/822.pm +++ /dev/null @@ -1,109 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Format::822; -use strict; -use base 'Debconf::Format'; - - -sub beginfile {} -sub endfile {} - -sub read { - my $this=shift; - my $fh=shift; - - local $/="\n"; - - my $name; - my %ret=( - owners => {}, - fields => {}, - variables => {}, - flags => {}, - ); - - my $invars=0; - my $line; - while ($line = <$fh>) { - chomp $line; - last if $line eq ''; # blank line is our record delimiter - - if ($invars) { - if ($line =~ /^\s/) { - $line =~ s/^\s+//; - my ($var, $value)=split(/\s*=\s?/, $line, 2); - $value=~s/\\n/\n/g; - $ret{variables}->{$var}=$value; - next; - } - else { - $invars=0; - } - } - - my ($key, $value)=split(/:\s?/, $line, 2); - $key=lc($key); - if ($key eq 'owners') { - foreach my $owner (split(/,\s+/, $value)) { - $ret{owners}->{$owner}=1; - } - } - elsif ($key eq 'flags') { - foreach my $flag (split(/,\s+/, $value)) { - $ret{flags}->{$flag}='true'; - } - } - elsif ($key eq 'variables') { - $invars=1; - } - elsif ($key eq 'name') { - $name=$value; - } - elsif (length $key) { - $value=~s/\\n/\n/g; - $ret{fields}->{$key}=$value; - } - } - - return unless defined $name; - return $name, \%ret; -} - -sub write { - my $this=shift; - my $fh=shift; - my %data=%{shift()}; - my $name=shift; - - print $fh "Name: $name\n" or return undef; - foreach my $field (sort keys %{$data{fields}}) { - my $val=$data{fields}->{$field}; - $val=~s/\n/\\n/g; - print $fh ucfirst($field).": $val\n" or return undef; - } - if (keys %{$data{owners}}) { - print $fh "Owners: ".join(", ", sort keys(%{$data{owners}}))."\n" - or return undef; - } - if (grep { $data{flags}->{$_} eq 'true' } keys %{$data{flags}}) { - print $fh "Flags: ".join(", ", - grep { $data{flags}->{$_} eq 'true' } - sort keys(%{$data{flags}}))."\n" - or return undef; - } - if (keys %{$data{variables}}) { - print $fh "Variables:\n" or return undef; - foreach my $var (sort keys %{$data{variables}}) { - my $val=$data{variables}->{$var}; - $val=~s/\n/\\n/g; - print $fh " $var = $val\n" or return undef; - } - } - print $fh "\n" or return undef; # end of record delimiter - return 1; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd.pm deleted file mode 100644 index 46c69a0..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd.pm +++ /dev/null @@ -1,172 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::FrontEnd; -use strict; -use Debconf::Gettext; -use Debconf::Priority; -use Debconf::Log ':all'; -use base qw(Debconf::Base); - - -sub init { - my $this=shift; - - $this->elements([]); - $this->interactive(''); - $this->capb(''); - $this->title(''); - $this->requested_title(''); - $this->info(undef); - $this->need_tty(1); -} - - -sub elementtype { - my $this=shift; - - my $ret; - if (ref $this) { - ($ret) = ref($this) =~ m/Debconf::FrontEnd::(.*)/; - } - else { - ($ret) = $this =~ m/Debconf::FrontEnd::(.*)/; - } - return $ret; -} - -my %nouse; - -sub _loadelementclass { - my $this=shift; - my $type=shift; - my $nodebug=shift; - - if (! UNIVERSAL::can("Debconf::Element::$type", 'new')) { - return if $nouse{$type}; - eval qq{use Debconf::Element::$type}; - if ($@ || ! UNIVERSAL::can("Debconf::Element::$type", 'new')) { - warn sprintf(gettext("Unable to load Debconf::Element::%s. Failed because: %s"), $type, $@) if ! $nodebug; - $nouse{$type}=1; - return; - } - } -} - - -sub makeelement { - my $this=shift; - my $question=shift; - my $nodebug=shift; - - my $type=$this->elementtype.'::'.ucfirst($question->type); - $type=~s/::$//; # in case the question has no type.. - - $this->_loadelementclass($type, $nodebug); - - my $element="Debconf::Element::$type"->new(question => $question); - return if ! ref $element; - return $element; -} - - -sub add { - my $this=shift; - my $element=shift; - - foreach (@{$this->elements}) { - return if $element->question == $_->question; - } - - $element->frontend($this); - push @{$this->elements}, $element; -} - - -sub go { - my $this=shift; - $this->backup(''); - foreach my $element (@{$this->elements}) { - $element->show; - return if $this->backup && $this->capb_backup; - } - return 1; -} - - -sub progress_start { - my $this=shift; - my $min=shift; - my $max=shift; - my $question=shift; - - my $type = $this->elementtype.'::Progress'; - $this->_loadelementclass($type); - - my $element="Debconf::Element::$type"->new(question => $question); - unless (ref $element) { - return; - } - $element->frontend($this); - $element->progress_min($min); - $element->progress_max($max); - $element->progress_cur($min); - - $element->start; - - $this->progress_bar($element); -} - - -sub progress_set { - my $this=shift; - my $value=shift; - - return $this->progress_bar->set($value); -} - - -sub progress_step { - my $this=shift; - my $inc=shift; - - return $this->progress_set($this->progress_bar->progress_cur + $inc); -} - - -sub progress_info { - my $this=shift; - my $question=shift; - - return $this->progress_bar->info($question); -} - - -sub progress_stop { - my $this=shift; - - $this->progress_bar->stop; - $this->progress_bar(undef); -} - - -sub clear { - my $this=shift; - - $this->elements([]); -} - - -sub default_title { - my $this=shift; - - $this->title(sprintf(gettext("Configuring %s"), shift)); - $this->requested_title($this->title); -} - - -sub shutdown {} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Dialog.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Dialog.pm deleted file mode 100644 index 61ac411..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Dialog.pm +++ /dev/null @@ -1,317 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::FrontEnd::Dialog; -use strict; -use Debconf::Gettext; -use Debconf::Priority; -use Debconf::TmpFile; -use Debconf::Log qw(:all); -use Debconf::Encoding qw(wrap $columns width); -use IPC::Open3; -use POSIX; -use Fcntl; -use base qw(Debconf::FrontEnd::ScreenSize); - - -sub init { - my $this=shift; - - $this->SUPER::init(@_); - - delete $ENV{POSIXLY_CORRECT} if exists $ENV{POSIXLY_CORRECT}; - delete $ENV{POSIX_ME_HARDER} if exists $ENV{POSIX_ME_HARDER}; - - if (! exists $ENV{TERM} || ! defined $ENV{TERM} || $ENV{TERM} eq '') { - die gettext("TERM is not set, so the dialog frontend is not usable.")."\n"; - } - elsif ($ENV{TERM} =~ /emacs/i) { - die gettext("Dialog frontend is incompatible with emacs shell buffers")."\n"; - } - elsif ($ENV{TERM} eq 'dumb' || $ENV{TERM} eq 'unknown') { - die gettext("Dialog frontend will not work on a dumb terminal, an emacs shell buffer, or without a controlling terminal.")."\n"; - } - - $this->interactive(1); - $this->capb('backup'); - - if (-x "/usr/bin/whiptail" && - (! defined $ENV{DEBCONF_FORCE_DIALOG} || ! -x "/usr/bin/dialog") && - (! defined $ENV{DEBCONF_FORCE_XDIALOG} || ! -x "/usr/bin/Xdialog")) { - $this->program('whiptail'); - $this->dashsep('--'); - $this->borderwidth(5); - $this->borderheight(6); - $this->spacer(1); - $this->titlespacer(10); - $this->columnspacer(3); - $this->selectspacer(13); - $this->hasoutputfd(1); - } - elsif (-x "/usr/bin/dialog" && - (! defined $ENV{DEBCONF_FORCE_XDIALOG} || ! -x "/usr/bin/Xdialog")) { - $this->program('dialog'); - $this->dashsep(''); # dialog does not need (or support) - $this->borderwidth(7); - $this->borderheight(6); - $this->spacer(0); - $this->titlespacer(4); - $this->columnspacer(2); - $this->selectspacer(0); - $this->hasoutputfd(1); - } - elsif (-x "/usr/bin/Xdialog" && defined $ENV{DISPLAY}) { - $this->program("Xdialog"); - $this->borderwidth(7); - $this->borderheight(20); - $this->spacer(0); - $this->titlespacer(10); - $this->selectspacer(0); - $this->columnspacer(2); - $this->screenheight(200); - } - else { - die gettext("No usable dialog-like program is installed, so the dialog based frontend cannot be used."); - } - - if ($this->screenheight < 13 || $this->screenwidth < 31) { - die gettext("Dialog frontend requires a screen at least 13 lines tall and 31 columns wide.")."\n"; - } -} - - -sub sizetext { - my $this=shift; - my $text=shift; - - $columns = $this->screenwidth - $this->borderwidth - $this->columnspacer; - $text=wrap('', '', $text); - my @lines=split(/\n/, $text); - - my $window_columns=width($this->title) + $this->titlespacer; - map { - my $w=width($_); - $window_columns = $w if $w > $window_columns; - } @lines; - - return $text, $#lines + 1 + $this->borderheight, - $window_columns + $this->borderwidth; -} - - -sub hide_escape { - my $line = $_; - - $line =~ s/\\n/\\\xe2\x81\xa0n/g; - return $line; -} - - -sub showtext { - my $this=shift; - my $question=shift; - my $intext=shift; - - my $lines = $this->screenheight; - my ($text, $height, $width)=$this->sizetext($intext); - - my @lines = split(/\n/, $text); - my $num; - my @args=('--msgbox', join("\n", @lines)); - if ($lines - 4 - $this->borderheight <= $#lines) { - $num=$lines - 4 - $this->borderheight; - if ($this->program eq 'whiptail') { - push @args, '--scrolltext'; - } - else { - my $fh=Debconf::TmpFile::open(); - print $fh join("\n", map &hide_escape, @lines); - close $fh; - @args=("--textbox", Debconf::TmpFile::filename()); - } - } - else { - $num=$#lines + 1; - } - $this->showdialog($question, @args, $num + $this->borderheight, $width); - if ($args[0] eq '--textbox') { - Debconf::TmpFile::cleanup(); - } -} - - -sub makeprompt { - my $this=shift; - my $question=shift; - my $freelines=$this->screenheight - $this->borderheight + 1; - $freelines += shift if @_; - - my ($text, $lines, $columns)=$this->sizetext( - $question->extended_description."\n\n". - $question->description - ); - - if ($lines > $freelines) { - $this->showtext($question, $question->extended_description); - ($text, $lines, $columns)=$this->sizetext($question->description); - } - - return ($text, $lines, $columns); -} - -sub startdialog { - my $this=shift; - my $question=shift; - my $wantinputfd=shift; - - debug debug => "preparing to run dialog. Params are:" , - join(",", $this->program, @_); - - use vars qw{*SAVEOUT *SAVEIN}; - open(SAVEOUT, ">&STDOUT") || die $!; - $this->dialog_saveout(\*SAVEOUT); - if ($wantinputfd) { - $this->dialog_savein(undef); - } else { - open(SAVEIN, "<&STDIN") || die $!; - $this->dialog_savein(\*SAVEIN); - } - - $this->dialog_savew($^W); - $^W=0; - - unless ($this->capb_backup || grep { $_ eq '--defaultno' } @_) { - if ($this->program ne 'Xdialog') { - unshift @_, '--nocancel'; - } - else { - unshift @_, '--no-cancel'; - } - } - - if ($this->program eq 'Xdialog' && $_[0] eq '--passwordbox') { - $_[0]='--password --inputbox' - } - - use vars qw{*OUTPUT_RDR *OUTPUT_WTR}; - if ($this->hasoutputfd) { - pipe(OUTPUT_RDR, OUTPUT_WTR) || die "pipe: $!"; - my $flags=fcntl(\*OUTPUT_WTR, F_GETFD, 0); - fcntl(\*OUTPUT_WTR, F_SETFD, $flags & ~FD_CLOEXEC); - $this->dialog_output_rdr(\*OUTPUT_RDR); - unshift @_, "--output-fd", fileno(\*OUTPUT_WTR); - } - - my $backtitle=''; - if (defined $this->info) { - $backtitle = $this->info->description; - } else { - $backtitle = gettext("Package configuration"); - } - - use vars qw{*INPUT_RDR *INPUT_WTR}; - if ($wantinputfd) { - pipe(INPUT_RDR, INPUT_WTR) || die "pipe: $!"; - autoflush INPUT_WTR 1; - my $flags=fcntl(\*INPUT_RDR, F_GETFD, 0); - fcntl(\*INPUT_RDR, F_SETFD, $flags & ~FD_CLOEXEC); - $this->dialog_input_wtr(\*INPUT_WTR); - } else { - $this->dialog_input_wtr(undef); - } - - use vars qw{*ERRFH}; - my $pid = open3($wantinputfd ? '<&INPUT_RDR' : '<&STDIN', '>&STDOUT', - \*ERRFH, $this->program, - '--backtitle', $backtitle, - '--title', $this->title, @_); - $this->dialog_errfh(\*ERRFH); - $this->dialog_pid($pid); - close OUTPUT_WTR if $this->hasoutputfd; -} - -sub waitdialog { - my $this=shift; - - my $input_wtr=$this->dialog_input_wtr; - if ($input_wtr) { - close $input_wtr; - } - my $output_rdr=$this->dialog_output_rdr; - my $errfh=$this->dialog_errfh; - my $output=''; - if ($this->hasoutputfd) { - while (<$output_rdr>) { - $output.=$_; - } - my $error=0; - while (<$errfh>) { - print STDERR $_; - $error++; - } - if ($error) { - die sprintf("debconf: %s output the above errors, giving up!", $this->program)."\n"; - } - } - else { - while (<$errfh>) { # ugh - $output.=$_; - } - } - chomp $output; - - waitpid($this->dialog_pid, 0); - $^W=$this->dialog_savew; - - if (defined $this->dialog_savein) { - open(STDIN, '<&', $this->dialog_savein) || die $!; - } - open(STDOUT, '>&', $this->dialog_saveout) || die $!; - - my $ret=$? >> 8; - if ($ret == 255 || ($ret == 1 && join(' ', @_) !~ m/--yesno\s/)) { - $this->backup(1); - return undef; - } - - if (wantarray) { - return $ret, $output; - } - else { - return $output; - } -} - - -sub showdialog { - my $this=shift; - my $question=shift; - - @_=map &hide_escape, @_; - - if (defined $this->progress_bar) { - $this->progress_bar->stop; - } - - $this->startdialog($question, 0, @_); - my (@ret, $ret); - if (wantarray) { - @ret=$this->waitdialog(@_); - } else { - $ret=$this->waitdialog(@_); - } - - if (defined $this->progress_bar) { - $this->progress_bar->start; - } - - if (wantarray) { - return @ret; - } else { - return $ret; - } -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Editor.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Editor.pm deleted file mode 100644 index 489db6c..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Editor.pm +++ /dev/null @@ -1,102 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::FrontEnd::Editor; -use strict; -use Debconf::Encoding q(wrap); -use Debconf::TmpFile; -use Debconf::Gettext; -use base qw(Debconf::FrontEnd::ScreenSize); - -my $fh; - - -sub init { - my $this=shift; - - $this->SUPER::init(@_); - $this->interactive(1); -} - - -sub comment { - my $this=shift; - my $comment=shift; - - print $fh wrap('# ','# ',$comment); - $this->filecontents(1); -} - - -sub divider { - my $this=shift; - - print $fh ("\n".('#' x ($this->screenwidth - 1))."\n"); -} - - -sub item { - my $this=shift; - my $name=shift; - my $value=shift; - - print $fh "$name=\"$value\"\n\n"; - $this->filecontents(1); -} - - -sub go { - my $this=shift; - my @elements=@{$this->elements}; - return 1 unless @elements; - - $fh = Debconf::TmpFile::open('.sh'); - - $this->comment(gettext("You are using the editor-based debconf frontend to configure your system. See the end of this document for detailed instructions.")); - $this->divider; - print $fh ("\n"); - - $this->filecontents(''); - foreach my $element (@elements) { - $element->show; - } - - if (! $this->filecontents) { - Debconf::TmpFile::cleanup(); - return 1; - } - - $this->divider; - $this->comment(gettext("The editor-based debconf frontend presents you with one or more text files to edit. This is one such text file. If you are familiar with standard unix configuration files, this file will look familiar to you -- it contains comments interspersed with configuration items. Edit the file, changing any items as necessary, and then save it and exit. At that point, debconf will read the edited file, and use the values you entered to configure the system.")); - print $fh ("\n"); - close $fh; - - my $editor=$ENV{EDITOR} || $ENV{VISUAL} || '/usr/bin/editor'; - system "$editor ".Debconf::TmpFile->filename; - - my %eltname=map { $_->question->name => $_ } @elements; - open (IN, "<".Debconf::TmpFile::filename()); - while (<IN>) { - next if /^\s*#/; - - if (/(.*?)="(.*)"/ && $eltname{$1}) { - $eltname{$1}->value($2); - } - } - close IN; - - Debconf::TmpFile::cleanup(); - - return 1; -} - - -sub screenwidth { - my $this=shift; - - $Debconf::Encoding::columns=$this->SUPER::screenwidth(@_); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Gnome.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Gnome.pm deleted file mode 100644 index bb08af0..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Gnome.pm +++ /dev/null @@ -1,180 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::FrontEnd::Gnome; -use strict; -use utf8; -use Debconf::Gettext; -use Debconf::Config; -use Debconf::Encoding qw(to_Unicode); -use base qw{Debconf::FrontEnd}; - -eval q{ - use Gtk2; - use Gnome2; -}; -die "Unable to load Gnome -- is libgnome2-perl installed?\n" if $@; - - -our @ARGV_for_gnome=('--sm-disable'); - -sub create_druid_page { - my $this=shift; - - $this->druid_page(Gnome2::DruidPageStandard->new); - $this->druid_page->set_logo($this->logo); - $this->druid_page->signal_connect("back", sub { - $this->goback(1); - Gtk2->main_quit; - return 1; - }); - $this->druid_page->signal_connect("next", sub { - $this->goback(0); - Gtk2->main_quit; - return 1; - }); - $this->druid_page->signal_connect("cancel", sub { exit 1 }); - $this->druid_page->show; - $this->druid->append_page($this->druid_page); - $this->druid->set_page($this->druid_page); -} - -sub init { - my $this=shift; - - if (fork) { - wait(); # for child - if ($? != 0) { - die "DISPLAY problem?\n"; - } - } - else { - @ARGV=@ARGV_for_gnome; # temporary change at first - Gnome2::Program->init('GNOME Debconf', '2.0'); - exit(0); # success - } - - my @gnome_sucks=@ARGV; - @ARGV=@ARGV_for_gnome; - Gnome2::Program->init('GNOME Debconf', '2.0'); - @ARGV=@gnome_sucks; - - $this->SUPER::init(@_); - $this->interactive(1); - $this->capb('backup'); - $this->need_tty(0); - - $this->win(Gtk2::Window->new("toplevel")); - $this->win->set_position("center"); - $this->win->set_default_size(600, 400); - my $hostname = `hostname`; - chomp $hostname; - $this->win->set_title(to_Unicode(sprintf(gettext("Debconf on %s"), $hostname))); - $this->win->signal_connect("delete_event", sub { exit 1 }); - - my $distribution=''; - if (system('type lsb_release >/dev/null 2>&1') == 0) { - $distribution=lc(`lsb_release -is`); - chomp $distribution; - } elsif (-e '/etc/debian_version') { - $distribution='debian'; - } - - my $logo="/usr/share/pixmaps/$distribution-logo.png"; - if (-e $logo) { - $this->logo(Gtk2::Gdk::Pixbuf->new_from_file($logo)); - } - - $this->druid(Gnome2::Druid->new); - $this->druid->show; - $this->win->add($this->druid); - - $this->create_druid_page (); -} - - -sub go { - my $this=shift; - my @elements=@{$this->elements}; - - my $interactive=''; - foreach my $element (@elements) { - next unless $element->hbox; - - $interactive=1; - $this->druid_page->vbox->pack_start($element->hbox, $element->fill, $element->expand, 0); - } - - if ($interactive) { - $this->druid_page->set_title(to_Unicode($this->title)); - if ($this->capb_backup) { - $this->druid->set_buttons_sensitive(1, 1, 1, 1); - } - else { - $this->druid->set_buttons_sensitive(0, 1, 1, 1); - } - $this->win->show; - Gtk2->main; - $this->create_druid_page (); - } - - foreach my $element (@elements) { - $element->show; - } - - return '' if $this->goback; - return 1; -} - -sub progress_start { - my $this=shift; - $this->SUPER::progress_start(@_); - - my $element=$this->progress_bar; - $this->druid_page->vbox->pack_start($element->hbox, $element->fill, $element->expand, 0); - $this->druid_page->set_title(to_Unicode($this->title)); - $this->druid->set_buttons_sensitive(0, 0, 1, 1); - $this->win->show; - - while (Gtk2->events_pending) { - Gtk2->main_iteration; - } -} - -sub progress_set { - my $this=shift; - - my $ret=$this->SUPER::progress_set(@_); - - while (Gtk2->events_pending) { - Gtk2->main_iteration; - } - - return $ret; -} - -sub progress_info { - my $this=shift; - my $ret=$this->SUPER::progress_info(@_); - - while (Gtk2->events_pending) { - Gtk2->main_iteration; - } - - return $ret; -} - -sub progress_stop { - my $this=shift; - $this->SUPER::progress_stop(@_); - - while (Gtk2->events_pending) { - Gtk2->main_iteration; - } - - $this->create_druid_page(); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde.pm deleted file mode 100644 index 5483568..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde.pm +++ /dev/null @@ -1,212 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::FrontEnd::Kde; -use strict; -use utf8; -use Debconf::Gettext; -use Debconf::Config; -BEGIN { - eval { require QtCore4 }; - die "Unable to load QtCore -- is libqtcore4-perl installed?\n" if $@; - eval { require QtGui4 }; - die "Unable to load QtGui -- is libqtgui4-perl installed?\n" if $@; -} -use Debconf::FrontEnd::Kde::Wizard; -use Debconf::Log ':all'; -use base qw{Debconf::FrontEnd}; -use Debconf::Encoding qw(to_Unicode); - - - -our @ARGV_KDE=(); - -sub init { - my $this=shift; - - $this->SUPER::init(@_); - $this->interactive(1); - $this->cancelled(0); - $this->createdelements([]); - $this->dupelements([]); - $this->capb('backup'); - $this->need_tty(0); - - if (fork) { - wait(); # for child - if ($? != 0) { - die "DISPLAY problem?\n"; - } - } - else { - $this->qtapp(Qt::Application(\@ARGV_KDE)); - exit(0); # success - } - - $this->window_initted(0); - $this->kde_initted(0); -} - -sub init_kde { - my $this=shift; - - return if $this->kde_initted; - - debug frontend => "QTF: initializing app"; - $this->qtapp(Qt::Application(\@ARGV_KDE)); - $this->kde_initted(1); -} - -sub init_window { - my $this=shift; - $this->init_kde(); - return if $this->window_initted; - $this->{vbox} = Qt::VBoxLayout; - - debug frontend => "QTF: initializing wizard"; - $this->win(Debconf::FrontEnd::Kde::Wizard(undef,undef, $this)); - debug frontend => "QTF: setting size"; - $this->win->resize(620, 430); - my $hostname = `hostname`; - chomp $hostname; - $this->hostname($hostname); - debug frontend => "QTF: setting title"; - $this->win->setTitle(to_Unicode(sprintf(gettext("Debconf on %s"), $this->hostname))); - debug frontend => "QTF: initializing main widget"; - $this->{toplayout} = Qt::HBoxLayout(); - $this->win->setMainFrameLayout($this->toplayout); - $this->win->setTitle(to_Unicode(sprintf(gettext("Debconf on %s"), $this->hostname))); - $this->window_initted(1); -} - - -sub go { - my $this=shift; - my @elements=@{$this->elements}; - - - $this->init_window; - - - my $interactive=''; - debug frontend => "QTF: -- START ------------------"; - foreach my $element (@elements) { - next unless $element->can("create"); - - $element->create($this->frame); - $interactive=1; - debug frontend => "QTF: ADD: " . $element->question->description; - $this->{vbox}->addWidget($element->top); - } - - if ($interactive) { - foreach my $element (@elements) { - next unless $element->top; - debug frontend => "QTF: SHOW: " . $element->question->description; - $element->top->show; - } - my $scroll = Qt::ScrollArea($this->win); - my $widget = Qt::Widget($scroll); - $widget->setLayout($this->{vbox}); - $scroll->setWidget($widget); - $this->toplayout->addWidget($scroll); - - - if ($this->capb_backup) { - $this->win->setBackEnabled(1); - } - else { - $this->win->setBackEnabled(0); - } - $this->win->setNextEnabled(1); - - $this->win->show; - debug frontend => "QTF: -- ENTER EVENTLOOP --------"; - $this->qtapp->exec; - $this->qtapp->exit; - debug frontend => "QTF: -- LEFT EVENTLOOP --------"; - - $this->win->destroy(); - $this->window_initted(0); - - - } else { - foreach my $element (@elements) { - $element->show; - } - } - - debug frontend => "QTF: -- END --------------------"; - if ($this->cancelled) { - exit 1; - } - return '' if $this->goback; - return 1; -} - -sub progress_start { - my $this=shift; - $this->init_window; - $this->SUPER::progress_start(@_); - - my $element=$this->progress_bar; - $this->{vbox}->addWidget($element->top); - $element->top->show; - my $scroll = Qt::ScrollArea($this->win); - my $widget = Qt::Widget($scroll); - $widget->setLayout($this->{vbox}); - $scroll->setWidget($widget); - $this->toplayout->addWidget($scroll); - $this->win->setBackEnabled(0); - $this->win->setNextEnabled(0); - $this->win->show; - $this->qtapp->processEvents; -} - -sub progress_set { - my $this=shift; - my $ret=$this->SUPER::progress_set(@_); - - $this->qtapp->processEvents; - - return $ret; -} - -sub progress_info { - my $this=shift; - my $ret=$this->SUPER::progress_info(@_); - - $this->qtapp->processEvents; - - return $ret; -} - -sub progress_stop { - my $this=shift; - my $element=$this->progress_bar; - $this->SUPER::progress_stop(@_); - - $this->qtapp->processEvents; - - $this->win->setAttribute(Qt::WA_DeleteOnClose()); - $this->win->close; - $this->window_initted(0); - - if ($this->cancelled) { - exit 1; - } -} - - -sub shutdown { - my $this = shift; - if ($this->kde_initted) { - if($this->win) { - $this->win->destroy; - } - } -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde/Ui_DebconfWizard.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde/Ui_DebconfWizard.pm deleted file mode 100644 index c8caf71..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde/Ui_DebconfWizard.pm +++ /dev/null @@ -1,154 +0,0 @@ - - -package Debconf::FrontEnd::Kde::Ui_DebconfWizard; - -use strict; -use warnings; -use utf8; -use QtCore4; - -sub vboxLayout { - return shift->{vboxLayout}; -} - -sub title { - return shift->{title}; -} - -sub line1 { - return shift->{line1}; -} - -sub mainFrame { - return shift->{mainFrame}; -} - -sub hboxLayout { - return shift->{hboxLayout}; -} - -sub bHelp { - return shift->{bHelp}; -} - -sub spacer1 { - return shift->{spacer1}; -} - -sub bBack { - return shift->{bBack}; -} - -sub bNext { - return shift->{bNext}; -} - -sub bCancel { - return shift->{bCancel}; -} - - -sub setupUi { - my ( $class, $debconfWizard ) = @_; - my $self = bless {}, $class; - if ( !defined $debconfWizard->objectName() ) { - $debconfWizard->setObjectName( 'debconfWizard' ); - } - $debconfWizard->resize( 660, 460 ); - my $vboxLayout = Qt::VBoxLayout( $debconfWizard ); - $self->{vboxLayout} = $vboxLayout; - $vboxLayout->setSpacing( 6 ); - $vboxLayout->setMargin( 11 ); - $vboxLayout->setObjectName( 'vboxLayout' ); - my $title = Qt::Label( $debconfWizard ); - $self->{title} = $title; - $title->setObjectName( 'title' ); - my $sizePolicy = Qt::SizePolicy( Qt::SizePolicy::Preferred(), Qt::SizePolicy::Fixed() ); - $self->{$sizePolicy} = $sizePolicy; - $sizePolicy->setHorizontalStretch( 0 ); - $sizePolicy->setVerticalStretch( 0 ); - $sizePolicy->setHeightForWidth( $title->sizePolicy()->hasHeightForWidth() ); - $title->setSizePolicy( $sizePolicy ); - $title->setWordWrap( 0 ); - - $vboxLayout->addWidget( $title ); - - my $line1 = Qt::Frame( $debconfWizard ); - $self->{line1} = $line1; - $line1->setObjectName( 'line1' ); - $sizePolicy->setHeightForWidth( $line1->sizePolicy()->hasHeightForWidth() ); - $line1->setSizePolicy( $sizePolicy ); - $line1->setFrameShape( Qt::Frame::HLine() ); - $line1->setFrameShadow( Qt::Frame::Sunken() ); - - $vboxLayout->addWidget( $line1 ); - - my $mainFrame = Qt::Widget( $debconfWizard ); - $self->{mainFrame} = $mainFrame; - $mainFrame->setObjectName( 'mainFrame' ); - - $vboxLayout->addWidget( $mainFrame ); - - my $hboxLayout = Qt::HBoxLayout( ); - $self->{hboxLayout} = $hboxLayout; - $hboxLayout->setSpacing( 6 ); - $hboxLayout->setObjectName( 'hboxLayout' ); - my $bHelp = Qt::PushButton( $debconfWizard ); - $self->{bHelp} = $bHelp; - $bHelp->setObjectName( 'bHelp' ); - - $hboxLayout->addWidget( $bHelp ); - - my $spacer1 = Qt::SpacerItem( 161, 20, Qt::SizePolicy::Expanding(), Qt::SizePolicy::Minimum() ); - - $hboxLayout->addItem( $spacer1 ); - - my $bBack = Qt::PushButton( $debconfWizard ); - $self->{bBack} = $bBack; - $bBack->setObjectName( 'bBack' ); - - $hboxLayout->addWidget( $bBack ); - - my $bNext = Qt::PushButton( $debconfWizard ); - $self->{bNext} = $bNext; - $bNext->setObjectName( 'bNext' ); - - $hboxLayout->addWidget( $bNext ); - - my $bCancel = Qt::PushButton( $debconfWizard ); - $self->{bCancel} = $bCancel; - $bCancel->setObjectName( 'bCancel' ); - - $hboxLayout->addWidget( $bCancel ); - - - $vboxLayout->addLayout( $hboxLayout ); - - - $self->retranslateUi( $debconfWizard ); - - Qt::MetaObject->connectSlotsByName( $debconfWizard ); - return $self; -} # setupUi - -sub setup_ui { - my ( $debconfWizard ) = @_; - return setupUi( $debconfWizard ); -} - -sub retranslateUi { - my ( $self, $debconfWizard ) = @_; - $debconfWizard->setWindowTitle( Qt::Application::translate( 'DebconfWizard', 'Debconf', undef, Qt::Application::UnicodeUTF8() ) ); - $self->title()->setText( Qt::Application::translate( 'DebconfWizard', 'title', undef, Qt::Application::UnicodeUTF8() ) ); - $self->bHelp()->setText( Qt::Application::translate( 'DebconfWizard', 'Help', undef, Qt::Application::UnicodeUTF8() ) ); - $self->bBack()->setText( Qt::Application::translate( 'DebconfWizard', '< Back', undef, Qt::Application::UnicodeUTF8() ) ); - $self->bNext()->setText( Qt::Application::translate( 'DebconfWizard', 'Next >', undef, Qt::Application::UnicodeUTF8() ) ); - $self->bCancel()->setText( Qt::Application::translate( 'DebconfWizard', 'Cancel', undef, Qt::Application::UnicodeUTF8() ) ); -} # retranslateUi - -sub retranslate_ui { - my ( $debconfWizard ) = @_; - retranslateUi( $debconfWizard ); -} - -1;
\ No newline at end of file diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde/Wizard.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde/Wizard.pm deleted file mode 100644 index fc1030b..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde/Wizard.pm +++ /dev/null @@ -1,80 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::FrontEnd::Kde::Wizard; -use strict; -use utf8; -use Debconf::Log ':all'; -use QtCore4; -use QtGui4; -use QtCore4::isa qw(Qt::Widget Debconf::FrontEnd::Kde::Ui_DebconfWizard); -use QtCore4::slots 'goNext' => [], 'goBack' => [], 'goBye' => []; -use Debconf::FrontEnd::Kde::Ui_DebconfWizard; - -use Data::Dumper; -sub NEW { - - my ( $class, $parent ) = @_; - $class->SUPER::NEW($parent ); - this->{frontend} = $_[3]; - - my $ui = this->{ui} = $class->setupUi(this); - - my $bNext = $ui->{bNext}; - my $bBack = $ui->{bBack}; - my $bCancel = $ui->{bCancel}; - this->setObjectName("Wizard"); - this->connect($bNext, SIGNAL 'clicked ()', SLOT 'goNext ()'); - this->connect($bBack, SIGNAL 'clicked ()', SLOT 'goBack ()'); - this->connect($bCancel, SIGNAL 'clicked ()', SLOT 'goBye ()'); - - this->{ui}->mainFrame->setObjectName("mainFrame");; -} - - -sub setTitle { - this->{ui}->{title}->setText($_[0]); -} - - -sub setNextEnabled { - this->{ui}->{bNext}->setEnabled(shift); -} - - -sub setBackEnabled { - this->{ui}->{bBack}->setEnabled(shift); -} - - -sub goNext { - debug frontend => "QTF: -- LEAVE EVENTLOOP --------"; - this->{frontend}->goback(0); - this->{frontend}->win->close; -} - - -sub goBack { - debug frontend => "QTF: -- LEAVE EVENTLOOP --------"; - this->{frontend}->goback(1); - this->{frontend}->win->close; -} - -sub setMainFrameLayout { - debug frontend => "QTF: -- SET MAIN LAYOUT --------"; - if(this->{ui}->mainFrame->layout) { - this->{ui}->mainFrame->layout->DESTROY; - } - this->{ui}->mainFrame->setLayout(shift); -} - - -sub goBye { - debug developer => "QTF: -- LEAVE EVENTLOOP --------"; - this->{frontend}->cancelled(1); - this->{frontend}->win->close; -} - - -1; diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Noninteractive.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Noninteractive.pm deleted file mode 100644 index dfca0eb..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Noninteractive.pm +++ /dev/null @@ -1,20 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::FrontEnd::Noninteractive; -use strict; -use base qw(Debconf::FrontEnd); - - - -sub init { - my $this=shift; - - $this->SUPER::init(@_); - - $this->need_tty(0); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Passthrough.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Passthrough.pm deleted file mode 100644 index 96a3f0b..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Passthrough.pm +++ /dev/null @@ -1,287 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::FrontEnd::Passthrough; -use strict; -use Carp; -use IO::Socket; -use IO::Handle; -use Debconf::FrontEnd; -use Debconf::Element; -use Debconf::Element::Select; -use Debconf::Element::Multiselect; -use Debconf::Log qw(:all); -use Debconf::Encoding; -use base qw(Debconf::FrontEnd); - -my ($READFD, $WRITEFD, $SOCKET); -if (defined $ENV{DEBCONF_PIPE}) { - $SOCKET = $ENV{DEBCONF_PIPE}; -} elsif (defined $ENV{DEBCONF_READFD} && defined $ENV{DEBCONF_WRITEFD}) { - $READFD = $ENV{DEBCONF_READFD}; - $WRITEFD = $ENV{DEBCONF_WRITEFD}; -} else { - die "Neither DEBCONF_PIPE nor DEBCONF_READFD and DEBCONF_WRITEFD were set\n"; -} - - -sub init { - my $this=shift; - - if (defined $SOCKET) { - $this->{readfh} = $this->{writefh} = IO::Socket::UNIX->new( - Type => SOCK_STREAM, - Peer => $SOCKET - ) || croak "Cannot connect to $SOCKET: $!"; - } else { - $this->{readfh} = IO::Handle->new_from_fd(int($READFD), "r") || croak "Failed to open fd $READFD: $!"; - $this->{writefh} = IO::Handle->new_from_fd(int($WRITEFD), "w") || croak "Failed to open fd $WRITEFD: $!"; - } - - binmode $this->{readfh}, ":utf8"; - binmode $this->{writefh}, ":utf8"; - - $this->{readfh}->autoflush(1); - $this->{writefh}->autoflush(1); - - $this->elements([]); - $this->interactive(1); - $this->need_tty(0); -} - - -sub talk { - my $this=shift; - my $command=join(' ', map { Debconf::Encoding::to_Unicode($_) } @_); - my $reply; - - my $readfh = $this->{readfh} || croak "Broken pipe"; - my $writefh = $this->{writefh} || croak "Broken pipe"; - - debug developer => "----> $command"; - print $writefh $command."\n"; - $writefh->flush; - $reply = <$readfh>; - chomp($reply); - debug developer => "<---- $reply"; - my ($tag, $val) = split(' ', $reply, 2); - $val = '' unless defined $val; - $val = Debconf::Encoding::convert("UTF-8", $val); - - return ($tag, $val) if wantarray; - return $tag; -} - - -sub makeelement -{ - my $this=shift; - my $question=shift; - - my $type=$question->type; - if ($type eq "select" || $type eq "multiselect") { - $type=ucfirst($type); - return "Debconf::Element::$type"->new(question => $question); - } else { - return Debconf::Element->new(question => $question); - } -} - - -sub capb_backup -{ - my $this=shift; - my $val = shift; - - $this->{capb_backup} = $val; - $this->talk('CAPB', 'backup') if $val; -} - - -sub capb -{ - my $this=shift; - my $ret; - return $this->{capb} if exists $this->{capb}; - - ($ret, $this->{capb}) = $this->talk('CAPB'); - return $this->{capb} if $ret eq '0'; -} - - -sub title -{ - my $this = shift; - return $this->{title} unless @_; - my $title = shift; - - $this->{title} = $title; - $this->talk('TITLE', $title); -} - - -sub settitle -{ - my $this = shift; - my $question = shift; - - $this->{title} = $question->description; - - my $tag = $question->template->template; - my $type = $question->template->type; - my $desc = $question->description; - my $extdesc = $question->extended_description; - - $this->talk('DATA', $tag, 'type', $type); - - if ($desc) { - $desc =~ s/\n/\\n/g; - $this->talk('DATA', $tag, 'description', $desc); - } - - if ($extdesc) { - $extdesc =~ s/\n/\\n/g; - $this->talk('DATA', $tag, 'extended_description', $extdesc); - } - - $this->talk('SETTITLE', $tag); -} - - -sub go { - my $this = shift; - - my @elements=grep $_->visible, @{$this->elements}; - foreach my $element (@elements) { - my $question = $element->question; - my $tag = $question->template->template; - my $type = $question->template->type; - my $desc = $question->description; - my $extdesc = $question->extended_description; - my $default; - if ($type eq 'select') { - $default = $element->translate_default; - } elsif ($type eq 'multiselect') { - $default = join ', ', $element->translate_default; - } else { - $default = $question->value; - } - - $this->talk('DATA', $tag, 'type', $type); - - if ($desc) { - $desc =~ s/\n/\\n/g; - $this->talk('DATA', $tag, 'description', $desc); - } - - if ($extdesc) { - $extdesc =~ s/\n/\\n/g; - $this->talk('DATA', $tag, 'extended_description', - $extdesc); - } - - if ($type eq "select" || $type eq "multiselect") { - my $choices = $question->choices; - $choices =~ s/\n/\\n/g if ($choices); - $this->talk('DATA', $tag, 'choices', $choices); - } - - $this->talk('SET', $tag, $default) if $default ne ''; - - my @vars=$Debconf::Db::config->variables($question->{name}); - for my $var (@vars) { - my $val=$Debconf::Db::config->getvariable($question->{name}, $var); - $val='' unless defined $val; - $this->talk('SUBST', $tag, $var, $val); - } - - $this->talk('INPUT', $question->priority, $tag); - } - - if (@elements && (scalar($this->talk('GO')) eq "30") && $this->{capb_backup}) { - return; - } - - foreach my $element (@{$this->elements}) { - if ($element->visible) { - my $tag = $element->question->template->template; - my $type = $element->question->template->type; - - my ($ret, $val)=$this->talk('GET', $tag); - if ($ret eq "0") { - if ($type eq 'select') { - $element->value($element->translate_to_C($val)); - } elsif ($type eq 'multiselect') { - $element->value(join(', ', map { $element->translate_to_C($_) } split(', ', $val))); - } else { - $element->value($val); - } - debug developer => "Got \"$val\" for $tag"; - } - } else { - $element->show; - } - } - - return 1; -} - - -sub progress_data { - my $this=shift; - my $question=shift; - - my $tag=$question->template->template; - my $type=$question->template->type; - my $desc=$question->description; - my $extdesc=$question->extended_description; - - $this->talk('DATA', $tag, 'type', $type); - - if ($desc) { - $desc =~ s/\n/\\n/g; - $this->talk('DATA', $tag, 'description', $desc); - } - - if ($extdesc) { - $extdesc =~ s/\n/\\n/g; - $this->talk('DATA', $tag, 'extended_description', $extdesc); - } -} - -sub progress_start { - my $this=shift; - - $this->progress_data($_[2]); - return $this->talk('PROGRESS', 'START', $_[0], $_[1], $_[2]->template->template); -} - -sub progress_set { - my $this=shift; - - return (scalar($this->talk('PROGRESS', 'SET', $_[0])) ne "30"); -} - -sub progress_step { - my $this=shift; - - return (scalar($this->talk('PROGRESS', 'STEP', $_[0])) ne "30"); -} - -sub progress_info { - my $this=shift; - - $this->progress_data($_[0]); - return (scalar($this->talk('PROGRESS', 'INFO', $_[0]->template->template)) ne "30"); -} - -sub progress_stop { - my $this=shift; - - return $this->talk('PROGRESS', 'STOP'); -} - - -1 - diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Readline.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Readline.pm deleted file mode 100644 index 44ab74e..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Readline.pm +++ /dev/null @@ -1,164 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::FrontEnd::Readline; -use strict; -use Term::ReadLine; -use Debconf::Gettext; -use base qw(Debconf::FrontEnd::Teletype); - - -sub init { - my $this=shift; - - $this->SUPER::init(@_); - - open(TESTTY, "/dev/tty") || die gettext("This frontend requires a controlling tty.")."\n"; - close TESTTY; - - $Term::ReadLine::termcap_nowarn = 1; # Turn off stupid termcap warning. - $this->readline(Term::ReadLine->new('debconf')); - $this->readline->ornaments(1); - - if (Term::ReadLine->ReadLine =~ /::Gnu$/) { - if (exists $ENV{TERM} && $ENV{TERM} =~ /emacs/i) { - die gettext("Term::ReadLine::GNU is incompatable with emacs shell buffers.")."\n"; - } - - $this->readline->add_defun('previous-question', - sub { - if ($this->capb_backup) { - $this->_skip(1); - $this->_direction(-1); - $this->readline->stuff_char(ord "\n"); - } - else { - $this->readline->ding; - } - }, ord "\cu"); - $this->readline->add_defun('next-question', - sub { - if ($this->capb_backup) { - $this->readline->stuff_char(ord "\n"); - } - }, ord "\cv"); - $this->readline->parse_and_bind('"\e[5~": previous-question'); - $this->readline->parse_and_bind('"\e[6~": next-question'); - $this->capb('backup'); - } - - if (Term::ReadLine->ReadLine =~ /::Stub$/) { - $this->promptdefault(1); - } -} - - -sub elementtype { - return 'Teletype'; -} - - -sub go { - my $this=shift; - - foreach my $element (grep ! $_->visible, @{$this->elements}) { - my $value=$element->show; - return if $this->backup && $this->capb_backup; - $element->question->value($value); - } - - my @elements=grep $_->visible, @{$this->elements}; - unless (@elements) { - $this->_didbackup(''); - return 1; - } - - my $current=$this->_didbackup ? $#elements : 0; - - $this->_direction(1); - for (; $current > -1 && $current < @elements; $current += $this->_direction) { - my $value=$elements[$current]->show; - } - - if ($current < 0) { - $this->_didbackup(1); - return; - } - else { - $this->_didbackup(''); - return 1; - } -} - - -sub prompt { - my $this=shift; - my %params=@_; - my $prompt=$params{prompt}." "; - my $default=$params{default}; - my $noshowdefault=$params{noshowdefault}; - my $completions=$params{completions}; - - if ($completions) { - my @matches; - $this->readline->Attribs->{completion_entry_function} = sub { - my $text=shift; - my $state=shift; - - if ($state == 0) { - @matches=(); - foreach (@{$completions}) { - push @matches, $_ if /^\Q$text\E/i; - } - } - - return pop @matches; - }; - } - else { - $this->readline->Attribs->{completion_entry_function} = undef; - } - - if (exists $params{completion_append_character}) { - $this->readline->Attribs->{completion_append_character}=$params{completion_append_character}; - } - else { - $this->readline->Attribs->{completion_append_character}=''; - } - - $this->linecount(0); - my $ret; - $this->_skip(0); - if (! $noshowdefault) { - $ret=$this->readline->readline($prompt, $default); - } - else { - $ret=$this->readline->readline($prompt); - } - $this->display_nowrap("\n"); - return if $this->_skip; - $this->_direction(1); - $this->readline->addhistory($ret); - return $ret; -} - - -sub prompt_password { - my $this=shift; - my %params=@_; - - if (Term::ReadLine->ReadLine =~ /::Perl$/) { - return $this->SUPER::prompt_password(%params); - } - - delete $params{default}; - system('stty -echo 2>/dev/null'); - my $ret=$this->prompt(@_, noshowdefault => 1, completions => []); - system('stty sane 2>/dev/null'); - print "\n"; - return $ret; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/ScreenSize.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/ScreenSize.pm deleted file mode 100644 index 4bef3a7..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/ScreenSize.pm +++ /dev/null @@ -1,54 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::FrontEnd::ScreenSize; -use strict; -use Debconf::Gettext; -use base qw(Debconf::FrontEnd); - - -sub init { - my $this=shift; - - $this->SUPER::init(@_); - - $this->resize; # Get current screen size. - $SIG{WINCH}=sub { - if (defined $this) { - $this->resize; - } - }; -} - - -sub resize { - my $this=shift; - - if (exists $ENV{LINES}) { - $this->screenheight($ENV{'LINES'}); - $this->screenheight_guessed(0); - } - else { - my ($rows)=`stty -a 2>/dev/null` =~ m/rows (\d+)/s; - if ($rows) { - $this->screenheight($rows); - $this->screenheight_guessed(0); - } - else { - $this->screenheight(25); - $this->screenheight_guessed(1); - } - } - - if (exists $ENV{COLUMNS}) { - $this->screenwidth($ENV{'COLUMNS'}); - } - else { - my ($cols)=`stty -a 2>/dev/null` =~ m/columns (\d+)/s; - $this->screenwidth($cols || 80); - } -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Teletype.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Teletype.pm deleted file mode 100644 index 9684411..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Teletype.pm +++ /dev/null @@ -1,89 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::FrontEnd::Teletype; -use strict; -use Debconf::Encoding qw(width wrap); -use Debconf::Gettext; -use Debconf::Config; -use base qw(Debconf::FrontEnd::ScreenSize); - - -sub init { - my $this=shift; - - $this->SUPER::init(@_); - $this->interactive(1); - $this->linecount(0); -} - - -sub display { - my $this=shift; - my $text=shift; - - $Debconf::Encoding::columns=$this->screenwidth; - $this->display_nowrap(wrap('','',$text)); -} - - -sub display_nowrap { - my $this=shift; - my $text=shift; - - return if Debconf::Config->terse eq 'true'; - - my @lines=split(/\n/, $text); - push @lines, "" if $text=~/\n$/; - - my $title=$this->title; - if (length $title) { - unshift @lines, $title, ('-' x width $title), ''; - $this->title(''); - } - - foreach (@lines) { - if (! $this->screenheight_guessed && - $this->linecount($this->linecount+1) > $this->screenheight - 2) { - my $resp=$this->prompt( - prompt => '['.gettext("More").']', - default => '', - completions => [], - ); - if (defined $resp && $resp eq 'q') { - last; - } - } - print "$_\n"; - } -} - - -sub prompt { - my $this=shift; - my %params=@_; - - $this->linecount(0); - local $|=1; - print "$params{prompt} "; - my $ret=<STDIN>; - chomp $ret if defined $ret; - $this->display_nowrap("\n"); - return $ret; -} - - -sub prompt_password { - my $this=shift; - my %params=@_; - - delete $params{default}; - system('stty -echo 2>/dev/null'); - my $ret=$this->Debconf::FrontEnd::Teletype::prompt(%params); - system('stty sane 2>/dev/null'); - return $ret; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Text.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Text.pm deleted file mode 100644 index fe25981..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Text.pm +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::FrontEnd::Text; -use strict; -use base qw(Debconf::FrontEnd::Readline); - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Web.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Web.pm deleted file mode 100644 index bb2caff..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Web.pm +++ /dev/null @@ -1,137 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::FrontEnd::Web; -use IO::Socket; -use IO::Select; -use CGI; -use strict; -use Debconf::Gettext; -use base qw(Debconf::FrontEnd); - - - -sub init { - my $this=shift; - - $this->SUPER::init(@_); - - $this->port(8001) unless defined $this->port; - $this->formid(0); - $this->interactive(1); - $this->capb('backup'); - $this->need_tty(0); - - $this->server(IO::Socket::INET->new( - LocalPort => $this->port, - Proto => 'tcp', - Listen => 1, - Reuse => 1, - LocalAddr => '127.0.0.1', - )) || die "Can't bind to ".$this->port.": $!"; - - print STDERR sprintf(gettext("Note: Debconf is running in web mode. Go to http://localhost:%i/"),$this->port)."\n"; -} - - -sub client { - my $this=shift; - - $this->{client}=shift if @_; - return $this->{client} if $this->{client}; - - my $select=IO::Select->new($this->server); - 1 while ! $select->can_read(1); - my $client=$this->server->accept; - my $commands=''; - while (<$client>) { - last if $_ eq "\r\n"; - $commands.=$_; - } - $this->commands($commands); - $this->{client}=$client; -} - - -sub closeclient { - my $this=shift; - - close $this->client; - $this->client(''); -} - - -sub showclient { - my $this=shift; - my $page=shift; - - my $client=$this->client; - print $client $page; -} - - -sub go { - my $this=shift; - - $this->backup(''); - - my $httpheader="HTTP/1.0 200 Ok\nContent-type: text/html\n\n"; - my $form=''; - my $id=0; - my %idtoelt; - foreach my $elt (@{$this->elements}) { - $idtoelt{$id}=$elt; - $elt->id($id++); - my $html=$elt->show; - if ($html ne '') { - $form.=$html."<hr>\n"; - } - } - return 1 if $form eq ''; - - my $formid=$this->formid(1 + $this->formid); - - $form="<html>\n<title>".$this->title."</title>\n<body>\n". - "<form><input type=hidden name=formid value=$formid>\n". - $form."<p>\n"; - - if ($this->capb_backup) { - $form.="<input type=submit value=".gettext("Back")." name=back>\n"; - } - $form.="<input type=submit value=".gettext("Next").">\n"; - $form.="</form>\n</body>\n</html>\n"; - - my $query; - do { - $this->showclient($httpheader . $form); - - $this->closeclient; - $this->client; - - my @get=grep { /^GET / } split(/\r\n/, $this->commands); - my $get=shift @get; - my ($qs)=$get=~m/^GET\s+.*?\?(.*?)(?:\s+.*)?$/; - - $query=CGI->new($qs); - } until ($query->param('formid') eq $formid); - - if ($this->capb_backup && $query->param('back') ne '') { - return ''; - } - - foreach my $id ($query->param) { - next unless $idtoelt{$id}; - - $idtoelt{$id}->value($query->param($id)); - delete $idtoelt{$id}; - } - foreach my $elt (values %idtoelt) { - $elt->value(''); - } - - return 1; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Gettext.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Gettext.pm deleted file mode 100644 index 1ab2e97..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Gettext.pm +++ /dev/null @@ -1,27 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Gettext; -use strict; - - -BEGIN { - eval 'use Locale::gettext'; - if ($@) { - eval q{ - sub gettext { - return shift; - } - }; - } - else { - textdomain('debconf'); - } -} - -use base qw(Exporter); -our @EXPORT=qw(gettext); - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Iterator.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Iterator.pm deleted file mode 100644 index f43b6ab..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Iterator.pm +++ /dev/null @@ -1,17 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Iterator; -use strict; -use base qw(Debconf::Base); - - -sub iterate { - my $this=shift; - - $this->callback->($this); -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Log.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Log.pm deleted file mode 100644 index 869a65d..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Log.pm +++ /dev/null @@ -1,44 +0,0 @@ -#!/usr/bin/perl -# This file was preprocessed, do not edit! - - -package Debconf::Log; -use strict; -use base qw(Exporter); -our @EXPORT_OK=qw(debug warn); -our %EXPORT_TAGS = (all => [@EXPORT_OK]); # Import :all to get everything. -require Debconf::Config; # not use; there are recursive use loops - - -my $log_open=0; -sub debug { - my $type=shift; - - my $debug=Debconf::Config->debug; - if ($debug && $type =~ /$debug/) { - print STDERR "debconf ($type): ".join(" ", @_)."\n"; - } - - my $log=Debconf::Config->log; - if ($log && $type =~ /$log/) { - require Sys::Syslog; - unless ($log_open) { - Sys::Syslog::setlogsock('unix'); - Sys::Syslog::openlog('debconf', '', 'user'); - $log_open=1; - } - eval { # ignore all exceptions this throws - Sys::Syslog::syslog('debug', "($type): ". - join(" ", @_)); - }; - } -} - - -sub warn { - print STDERR "debconf: ".join(" ", @_)."\n" - unless Debconf::Config->nowarnings eq 'yes'; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Priority.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Priority.pm deleted file mode 100644 index d937626..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Priority.pm +++ /dev/null @@ -1,40 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Priority; -use strict; -use Debconf::Config; -use base qw(Exporter); -our @EXPORT_OK = qw(high_enough priority_valid priority_list); - - -my %priorities=( - 'low' => 0, - 'medium' => 1, - 'high' => 2, - 'critical' => 3, -); - - -sub high_enough { - my $priority=shift; - - return 1 if ! exists $priorities{$priority}; - return $priorities{$priority} >= $priorities{Debconf::Config->priority}; -} - - -sub priority_valid { - my $priority=shift; - - return exists $priorities{$priority}; -} - - -sub priority_list { - return sort { $priorities{$a} <=> $priorities{$b} } keys %priorities; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Question.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Question.pm deleted file mode 100644 index 10a86b9..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Question.pm +++ /dev/null @@ -1,292 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Question; -use strict; -use Debconf::Db; -use Debconf::Template; -use Debconf::Iterator; -use Debconf::Log qw(:all); - - -use fields qw(name priority); - -our %question; - - -sub new { - my Debconf::Question $this=shift; - my $name=shift; - my $owner=shift; - my $type=shift || die "no type given for question"; - die "A question called \"$name\" already exists" - if exists $question{$name}; - unless (ref $this) { - $this = fields::new($this); - } - $this->{name}=$name; - return unless defined $this->addowner($owner, $type); - $this->flag('seen', 'false'); - return $question{$name}=$this; -} - - -sub get { - my Debconf::Question $this=shift; - my $name=shift; - return $question{$name} if exists $question{$name}; - if ($Debconf::Db::config->exists($name)) { - $this = fields::new($this); - $this->{name}=$name; - return $question{$name}=$this; - } - return undef; -} - - -sub iterator { - my $this=shift; - - my $real_iterator=$Debconf::Db::config->iterator; - return Debconf::Iterator->new(callback => sub { - return unless my $name=$real_iterator->iterate; - return $this->get($name); - }); -} - - -sub _expand_vars { - my $this=shift; - my $text=shift; - - return '' unless defined $text; - - my @vars=$Debconf::Db::config->variables($this->{name}); - - my $rest=$text; - my $result=''; - my $variable; - my $varval; - my $escape; - while ($rest =~ m/^(.*?)(\\)?\${([^{}]+)}(.*)$/sg) { - $result.=$1; # copy anything before the variable - $escape=$2; - $variable=$3; - $rest=$4; # continue trying to expand rest of text - if (defined $escape && length $escape) { - $result.="\${$variable}"; - } - else { - $varval=$Debconf::Db::config->getvariable($this->{name}, $variable); - $result.=$varval if defined($varval); # expand the variable - } - } - $result.=$rest; # add on anything that's left. - - return $result; -} - - -sub description { - my $this=shift; - return $this->_expand_vars($this->template->description); -} - - -sub extended_description { - my $this=shift; - return $this->_expand_vars($this->template->extended_description); -} - - -sub choices { - my $this=shift; - - return $this->_expand_vars($this->template->choices); -} - - -sub choices_split { - my $this=shift; - - my @items; - my $item=''; - for my $chunk (split /(\\[, ]|,\s+)/, $this->choices) { - if ($chunk=~/^\\([, ])$/) { - $item.=$1; - } elsif ($chunk=~/^,\s+$/) { - push @items, $item; - $item=''; - } else { - $item.=$chunk; - } - } - push @items, $item if $item ne ''; - return @items; -} - - -sub variable { - my $this=shift; - my $var=shift; - - if (@_) { - return $Debconf::Db::config->setvariable($this->{name}, $var, shift); - } - else { - return $Debconf::Db::config->getvariable($this->{name}, $var); - } -} - - -sub flag { - my $this=shift; - my $flag=shift; - - if ($flag eq 'isdefault') { - debug developer => "The isdefault flag is deprecated, use the seen flag instead"; - if (@_) { - my $value=(shift eq 'true') ? 'false' : 'true'; - $Debconf::Db::config->setflag($this->{name}, 'seen', $value); - } - return ($Debconf::Db::config->getflag($this->{name}, 'seen') eq 'true') ? 'false' : 'true'; - } - - if (@_) { - return $Debconf::Db::config->setflag($this->{name}, $flag, shift); - } - else { - return $Debconf::Db::config->getflag($this->{name}, $flag); - } -} - - -sub value { - my $this = shift; - - unless (@_) { - my $ret=$Debconf::Db::config->getfield($this->{name}, 'value'); - return $ret if defined $ret; - return $this->template->default if ref $this->template; - } else { - return $Debconf::Db::config->setfield($this->{name}, 'value', shift); - } -} - - -sub value_split { - my $this=shift; - - my $value=$this->value; - $value='' if ! defined $value; - my @items; - my $item=''; - for my $chunk (split /(\\[, ]|,\s+)/, $value) { - if ($chunk=~/^\\([, ])$/) { - $item.=$1; - } elsif ($chunk=~/^,\s+$/) { - push @items, $item; - $item=''; - } else { - $item.=$chunk; - } - } - push @items, $item if $item ne ''; - return @items; -} - - -sub addowner { - my $this=shift; - - return $Debconf::Db::config->addowner($this->{name}, shift, shift); -} - - -sub removeowner { - my $this=shift; - - my $template=$Debconf::Db::config->getfield($this->{name}, 'template'); - return unless $Debconf::Db::config->removeowner($this->{name}, shift); - if (length $template and - not $Debconf::Db::config->exists($this->{name})) { - $Debconf::Db::templates->removeowner($template, $this->{name}); - delete $question{$this->{name}}; - } -} - - -sub owners { - my $this=shift; - - return join(", ", sort($Debconf::Db::config->owners($this->{name}))); -} - - -sub template { - my $this=shift; - if (@_) { - my $oldtemplate=$Debconf::Db::config->getfield($this->{name}, 'template'); - my $newtemplate=shift; - if (not defined $oldtemplate or $oldtemplate ne $newtemplate) { - $Debconf::Db::templates->removeowner($oldtemplate, $this->{name}) - if defined $oldtemplate and length $oldtemplate; - - $Debconf::Db::config->setfield($this->{name}, 'template', $newtemplate); - - $Debconf::Db::templates->addowner($newtemplate, $this->{name}, - $Debconf::Db::templates->getfield($newtemplate, "type")); - } - } - return Debconf::Template->get( - $Debconf::Db::config->getfield($this->{name}, 'template')); -} - - -sub name { - my $this=shift; - - return $this->{name}; -} - - -sub priority { - my $this=shift; - - $this->{priority}=shift if @_; - - return $this->{priority}; -} - - -sub AUTOLOAD { - (my $field = our $AUTOLOAD) =~ s/.*://; - - no strict 'refs'; - *$AUTOLOAD = sub { - my $this=shift; - - if (@_) { - return $Debconf::Db::config->setfield($this->{name}, $field, shift); - } - my $ret=$Debconf::Db::config->getfield($this->{name}, $field); - unless (defined $ret) { - $ret = $this->template->$field() if ref $this->template; - } - if (defined $ret) { - if ($field =~ /^(?:description|extended_description|choices)-/i) { - return $this->_expand_vars($ret); - } else { - return $ret; - } - } - }; - goto &$AUTOLOAD; -} - -sub DESTROY { -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Template.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Template.pm deleted file mode 100644 index 5cadf06..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Template.pm +++ /dev/null @@ -1,344 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Template; -use strict; -use POSIX; -use FileHandle; -use Debconf::Gettext; -use Text::Wrap; -use Text::Tabs; -use Debconf::Db; -use Debconf::Iterator; -use Debconf::Question; -use fields qw(template); -use Debconf::Log q{:all}; -use Debconf::Encoding; -use Debconf::Config; - -our %template; -$Debconf::Template::i18n=1; - -our %known_field = map { $_ => 1 } - qw{template description choices default type}; - -binmode(STDOUT); -binmode(STDERR); - - - -sub new { - my Debconf::Template $this=shift; - my $template=shift || die "no template name specified"; - my $owner=shift || 'unknown'; - my $type=shift || die "no template type specified"; - - if ($Debconf::Db::templates->exists($template) and - $Debconf::Db::templates->owners($template)) { - my $q=Debconf::Question->get($template); - $q->addowner($owner, $type) if $q; - - my @owners=$Debconf::Db::templates->owners($template); - foreach my $question (@owners) { - my $q=Debconf::Question->get($question); - if (! $q) { - warn sprintf(gettext("warning: possible database corruption. Will attempt to repair by adding back missing question %s."), $question); - my $newq=Debconf::Question->new($question, $owner, $type); - $newq->template($template); - } - } - - $this = fields::new($this); - $this->{template}=$template; - return $template{$template}=$this; - } - - unless (ref $this) { - $this = fields::new($this); - } - $this->{template}=$template; - - if ($Debconf::Db::config->exists($template)) { - my $q=Debconf::Question->get($template); - $q->addowner($owner, $type) if $q; - } - else { - my $q=Debconf::Question->new($template, $owner, $type); - $q->template($template); - } - - return unless $Debconf::Db::templates->addowner($template, $template, $type); - - $Debconf::Db::templates->setfield($template, 'type', $type); - return $template{$template}=$this; -} - - -sub get { - my Debconf::Template $this=shift; - my $template=shift; - return $template{$template} if exists $template{$template}; - if ($Debconf::Db::templates->exists($template)) { - $this = fields::new($this); - $this->{template}=$template; - return $template{$template}=$this; - } - return undef; -} - - -sub i18n { - my $class=shift; - $Debconf::Template::i18n=shift; -} - - -sub load { - my $this=shift; - my $file=shift; - - my @ret; - my $fh; - - if (ref $file) { - $fh=$file; - } - else { - $fh=FileHandle->new($file) || die "$file: $!"; - } - local $/="\n\n"; # read a template at a time. - while (<$fh>) { - my %data; - - my $save = sub { - my $field=shift; - my $value=shift; - my $extended=shift; - my $file=shift; - - $extended=~s/\n+$//; - - if ($field ne '') { - if (exists $data{$field}) { - die sprintf(gettext("Template #%s in %s has a duplicate field \"%s\" with new value \"%s\". Probably two templates are not properly separated by a lone newline.\n"), $., $file, $field, $value); - } - $data{$field}=$value; - $data{"extended_$field"}=$extended - if length $extended; - } - }; - - s/^\n+//; - s/\n+$//; - my ($field, $value, $extended)=('', '', ''); - foreach my $line (split "\n", $_) { - chomp $line; - if ($line=~/^([-_@.A-Za-z0-9]*):\s?(.*)/) { - $save->($field, $value, $extended, $file); - $field=lc $1; - $value=$2; - $value=~s/\s*$//; - $extended=''; - my $basefield=$field; - $basefield=~s/-.+$//; - if (! $known_field{$basefield}) { - warn sprintf(gettext("Unknown template field '%s', in stanza #%s of %s\n"), $field, $., $file); - } - } - elsif ($line=~/^\s\.$/) { - $extended.="\n\n"; - } - elsif ($line=~/^\s(\s+.*)/) { - my $bit=$1; - $bit=~s/\s*$//; - $extended.="\n" if length $extended && - $extended !~ /[\n ]$/; - $extended.=$bit."\n"; - } - elsif ($line=~/^\s(.*)/) { - my $bit=$1; - $bit=~s/\s*$//; - $extended.=' ' if length $extended && - $extended !~ /[\n ]$/; - $extended.=$bit; - } - else { - die sprintf(gettext("Template parse error near `%s', in stanza #%s of %s\n"), $line, $., $file); - } - } - $save->($field, $value, $extended, $file); - - die sprintf(gettext("Template #%s in %s does not contain a 'Template:' line\n"), $., $file) - unless $data{template}; - - my $template=$this->new($data{template}, @_, $data{type}); - $template->clearall; - foreach my $key (keys %data) { - next if $key eq 'template'; - $template->$key($data{$key}); - } - push @ret, $template; - } - - return @ret; -} - - -sub template { - my $this=shift; - - return $this->{template}; -} - - -sub fields { - my $this=shift; - - return $Debconf::Db::templates->fields($this->{template}); -} - - -sub clearall { - my $this=shift; - - foreach my $field ($this->fields) { - $Debconf::Db::templates->removefield($this->{template}, $field); - } -} - - -sub stringify { - my $this=shift; - - my @templatestrings; - foreach (ref $this ? $this : @_) { - my $data=''; - foreach my $key ('template', 'type', - (grep { $_ ne 'template' && $_ ne 'type'} sort $_->fields)) { - next if $key=~/^extended_/; - if ($key =~ m/-[a-z]{2}_[a-z]{2}(@[^_@.])?(-fuzzy)?$/) { - my $casekey=$key; - $casekey=~s/([a-z]{2})(@[^_@.]|)(-fuzzy|)$/uc($1).$2.$3/eg; - $data.=ucfirst($casekey).": ".$_->$key."\n"; - } - else { - $data.=ucfirst($key).": ".$_->$key."\n"; - } - my $e="extended_$key"; - my $ext=$_->$e; - if (defined $ext) { - $Text::Wrap::break = qr/\n|\s(?=\S)/; - my $extended=expand(wrap(' ', ' ', $ext)); - $extended=~s/(\n )+\n/\n .\n/g; - $data.=$extended."\n" if length $extended; - } - } - push @templatestrings, $data; - } - return join("\n", @templatestrings); -} - - -sub _addterritory { - my $locale=shift; - my $territory=shift; - $locale=~s/^([^_@.]+)/$1$territory/; - return $locale; -} -sub _addcharset { - my $locale=shift; - my $charset=shift; - $locale=~s/^([^@.]+)/$1$charset/; - return $locale; -} -sub _getlocalelist { - my $locale=shift; - $locale=~s/(@[^.]+)//; - my $modifier=$1; - my ($lang, $territory, $charset)=($locale=~m/^ - ([^_@.]+) # Language - (_[^_@.]+)? # Territory - (\..+)? # Charset - /x); - my (@ret) = ($lang); - @ret = map { $_.$modifier, $_} @ret if defined $modifier; - @ret = map { _addterritory($_,$territory), $_} @ret if defined $territory; - @ret = map { _addcharset($_,$charset), $_} @ret if defined $charset; - return @ret; -} - -sub _getlangs { - my $language=setlocale(LC_MESSAGES); - my @langs = (); - if (exists $ENV{LANGUAGE} && $ENV{LANGUAGE} ne '') { - foreach (split(/:/, $ENV{LANGUAGE})) { - push (@langs, _getlocalelist($_)); - } - } - return @langs, _getlocalelist($language); -} - -my @langs=map { lc $_ } _getlangs(); - -sub AUTOLOAD { - (my $field = our $AUTOLOAD) =~ s/.*://; - no strict 'refs'; - *$AUTOLOAD = sub { - my $this=shift; - if (@_) { - return $Debconf::Db::templates->setfield($this->{template}, $field, shift); - } - - my $ret; - my $want_i18n = $Debconf::Template::i18n && Debconf::Config->c_values ne 'true'; - - if ($want_i18n && @langs) { - foreach my $lang (@langs) { - $lang = 'en' if $lang eq 'c'; - - $ret=$Debconf::Db::templates->getfield($this->{template}, $field.'-'.$lang); - return $ret if defined $ret; - - if ($Debconf::Encoding::charmap) { - foreach my $f ($Debconf::Db::templates->fields($this->{template})) { - if ($f =~ /^\Q$field-$lang\E\.(.+)/) { - my $encoding = $1; - $ret = Debconf::Encoding::convert($encoding, $Debconf::Db::templates->getfield($this->{template}, lc($f))); - return $ret if defined $ret; - } - } - } - - last if $lang eq 'en'; - } - } elsif (not $want_i18n && $field !~ /-c$/i) { - $ret=$Debconf::Db::templates->getfield($this->{template}, $field.'-c'); - return $ret if defined $ret; - } - - $ret=$Debconf::Db::templates->getfield($this->{template}, $field); - return $ret if defined $ret; - - if ($field =~ /-/) { - (my $plainfield = $field) =~ s/-.*//; - $ret=$Debconf::Db::templates->getfield($this->{template}, $plainfield); - return $ret if defined $ret; - return ''; - } - - return ''; - }; - goto &$AUTOLOAD; -} - -sub DESTROY {} - -use overload - '""' => sub { - my $template=shift; - $template->template; - }; - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/Template/Transient.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/Template/Transient.pm deleted file mode 100644 index beb7865..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/Template/Transient.pm +++ /dev/null @@ -1,70 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::Template::Transient; -use strict; -use base 'Debconf::Template'; -use fields qw(_fields); - - - -sub new { - my $this=shift; - my $template=shift; - - unless (ref $this) { - $this = fields::new($this); - } - $this->{template}=$template; - $this->{_fields}={}; - return $this; -} - - -sub get { - die "get not supported on transient templates"; -} - - -sub fields { - my $this=shift; - - return keys %{$this->{_fields}}; -} - - -sub clearall { - my $this=shift; - - foreach my $field (keys %{$this->{_fields}}) { - delete $this->{_fields}->{$field}; - } -} - - -{ - my @langs=Debconf::Template::_getlangs(); - - sub AUTOLOAD { - (my $field = our $AUTOLOAD) =~ s/.*://; - no strict 'refs'; - *$AUTOLOAD = sub { - my $this=shift; - - return $this->{_fields}->{$field}=shift if @_; - - if ($Debconf::Template::i18n && @langs) { - foreach my $lang (@langs) { - return $this->{_fields}->{$field.'-'.lc($lang)} - if exists $this->{_fields}->{$field.'-'.lc($lang)}; - } - } - return $this->{_fields}->{$field}; - }; - goto &$AUTOLOAD; - } -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/TmpFile.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/TmpFile.pm deleted file mode 100644 index 2e7cead..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/TmpFile.pm +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/perl -# This file was preprocessed, do not edit! - - -package Debconf::TmpFile; -use strict; -use IO::File; -use Fcntl; - - -my $filename; - -sub open { - my $fh; # will be autovivified - my $ext=shift || ''; - do { $filename=POSIX::tmpnam().$ext } - until sysopen($fh, $filename, O_WRONLY|O_TRUNC|O_CREAT|O_EXCL, 0600); - return $fh; -} - - -sub filename { - return $filename; -} - - -sub cleanup { - unlink $filename; -} - - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debian/DebConf/Client/ConfModule.pm b/beagle/debian-rfs/usr/share/perl5/Debian/DebConf/Client/ConfModule.pm deleted file mode 100644 index 1516e40..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debian/DebConf/Client/ConfModule.pm +++ /dev/null @@ -1,20 +0,0 @@ -#!/usr/bin/perl -# This is a stub module that just uses the new module, and is here for -# backwards-compatability with pograms that use the old name. -package Debian::DebConf::Client::ConfModule; -use Debconf::Client::ConfModule; -use Debconf::Log qw{debug}; -print STDERR "Debian::DebConf::Client::ConfModule is deprecated, please use Debconf::Client::ConfModule instead.\n"; - -sub import { - splice @_, 0, 1 => Debconf::Client::ConfModule; - goto &{Debconf::Client::ConfModule->can('import')}; -} - -sub AUTOLOAD { - (my $sub = $AUTOLOAD) =~ s/.*:://; - *$sub = \&{"Debconf::Client::ConfModule::$sub"}; - goto &$sub; -} - -1 diff --git a/beagle/debian-rfs/usr/share/perl5/Text/WrapI18N.pm b/beagle/debian-rfs/usr/share/perl5/Text/WrapI18N.pm deleted file mode 100644 index 4d9d73c..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Text/WrapI18N.pm +++ /dev/null @@ -1,239 +0,0 @@ -package Text::WrapI18N; - -require Exporter; -use strict; -use warnings; - -our @ISA = qw(Exporter); -our @EXPORT = qw(wrap); -our @EXPORT_OK = qw($columns $separator); -our %EXPORT_TAGS = ('all' => [ @EXPORT, @EXPORT_OK ]); - -our $VERSION = '0.06'; - -use vars qw($columns $break $tabstop $separator $huge $unexpand $charmap); -use Text::CharWidth qw(mbswidth mblen); - -BEGIN { - $columns = 76; - # $break, $separator, $huge, and $unexpand are not supported yet. - $break = '\s'; - $tabstop = 8; - $separator = "\n"; - $huge = 'wrap'; - $unexpand = 1; - undef $charmap; -} - -sub wrap { - my $top1=shift; - my $top2=shift; - my $text=shift; - - $text = $top1 . $text; - - # $out already-formatted text for output including current line - # $len visible width of the current line without the current word - # $word the current word which might be sent to the next line - # $wlen visible width of the current word - # $c the current character - # $b whether to allow line-breaking after the current character - # $cont_lf true when LF (line feed) characters appear continuously - # $w visible width of the current character - - my $out = ''; - my $len = 0; - my $word = ''; - my $wlen = 0; - my $cont_lf = 0; - my ($c, $w, $b); - $text =~ s/\n+$/\n/; - while(1) { - if (length($text) == 0) { - return $out . $word; - } - ($c, $text, $w, $b) = _extract($text); - if ($c eq "\n") { - $out .= $word . $separator; - if (length($text) == 0) {return $out;} - $len = 0; - $text = $top2 . $text; - $word = '' ; $wlen = 0; - next; - } elsif ($w == -1) { - # all control characters other than LF are ignored - next; - } - - # when the current line have enough room - # for the curren character - - if ($len + $wlen + $w <= $columns) { - if ($c eq ' ' || $b) { - $out .= $word . $c; - $len += $wlen + $w; - $word = ''; $wlen = 0; - } else { - $word .= $c; $wlen += $w; - } - next; - } - - # when the current line overflows with the - # current character - - if ($c eq ' ') { - # the line ends by space - $out .= $word . $separator; - $len = 0; - $text = $top2 . $text; - $word = ''; $wlen = 0; - } elsif ($wlen + $w <= $columns - length ($top2)) { - # the current word is sent to next line - $out .= $separator; - $len = 0; - $text = $top2 . $word . $c . $text; - $word = ''; $wlen = 0; - } else { - # the current word is too long to fit a line - $out .= $word . $separator; - $len = 0; - $text = $top2 . $c . $text; - $word = ''; $wlen = 0; - } - } -} - - -# Extract one character from the beginning from the given string. -# Supports multibyte encodings such as UTF-8, EUC-JP, EUC-KR, -# GB2312, and Big5. -# -# return value: (character, rest string, width, line breakable) -# character: a character. This may consist from multiple bytes. -# rest string: given string without the extracted character. -# width: number of columns which the character occupies on screen. -# line breakable: true if the character allows line break after it. - -sub _extract { - my $string=shift; - my ($l, $c, $r, $w, $b, $u); - - if (length($string) == 0) { - return ('', '', 0, 0); - } - $l = mblen($string); - if ($l == 0 || $l == -1) { - return ('?', substr($string,1), 1, 0); - } - $c = substr($string, 0, $l); - $r = substr($string, $l); - $w = mbswidth($c); - - if (!defined($charmap)) { - $charmap = `/usr/bin/locale charmap`; - } - - if ($charmap =~ /UTF.8/i) { - # UTF-8 - if ($l == 3) { - # U+0800 - U+FFFF - $u = (ord(substr($c,0,1))&0x0f) * 0x1000 - + (ord(substr($c,1,1))&0x3f) * 0x40 - + (ord(substr($c,2,1))&0x3f); - $b = _isCJ($u); - } elsif ($l == 4) { - # U+10000 - U+10FFFF - $u = (ord(substr($c,0,1))&7) * 0x40000 - + (ord(substr($c,1,1))&0x3f) * 0x1000 - + (ord(substr($c,2,1))&0x3f) * 0x40 - + (ord(substr($c,3,1))&0x3f); - $b = _isCJ($u); - } else { - $b = 0; - } - } elsif ($charmap =~ /(^EUC)|(^GB)|(^BIG)/i) { - # East Asian legacy encodings - # (EUC-JP, EUC-KR, GB2312, Big5, Big5HKSCS, and so on) - - if (ord(substr($c,0,1)) >= 0x80) {$b = 1;} else {$b = 0;} - } else { - $b = 0; - } - return ($c, $r, $w, $b); -} - -# Returns 1 for Chinese and Japanese characters. This means that -# these characters allow line wrapping after this character even -# without whitespaces because these languages don't use whitespaces -# between words. -# -# Character must be given in UCS-4 codepoint value. - -sub _isCJ { - my $u=shift; - - if ($u >= 0x3000 && $u <= 0x312f) { - if ($u == 0x300a || $u == 0x300c || $u == 0x300e || - $u == 0x3010 || $u == 0x3014 || $u == 0x3016 || - $u == 0x3018 || $u == 0x301a) {return 0;} - return 1; - } # CJK punctuations, Hiragana, Katakana, Bopomofo - if ($u >= 0x31a0 && $u <= 0x31bf) {return 1;} # Bopomofo - if ($u >= 0x31f0 && $u <= 0x31ff) {return 1;} # Katakana extension - if ($u >= 0x3400 && $u <= 0x9fff) {return 1;} # Han Ideogram - if ($u >= 0xf900 && $u <= 0xfaff) {return 1;} # Han Ideogram - if ($u >= 0x20000 && $u <= 0x2ffff) {return 1;} # Han Ideogram - - return 0; -} - -1; -__END__ - -=head1 NAME - -Text::WrapI18N - Line wrapping module with support for multibyte, fullwidth, -and combining characters and languages without whitespaces between words - -=head1 SYNOPSIS - - use Text::WrapI18N qw(wrap $columns); - wrap(firstheader, nextheader, texts); - -=head1 DESCRIPTION - -This module intends to be a better Text::Wrap module. -This module is needed to support multibyte character encodings such -as UTF-8, EUC-JP, EUC-KR, GB2312, and Big5. This module also supports -characters with irregular widths, such as combining characters (which -occupy zero columns on terminal, like diacritical marks in UTF-8) and -fullwidth characters (which occupy two columns on terminal, like most -of east Asian characters). Also, minimal handling of languages which -doesn't use whitespaces between words (like Chinese and Japanese) is -supported. - -Like Text::Wrap, hyphenation and "kinsoku" processing are not supported, -to keep simplicity. - -I<wrap(firstheader, nextheader, texts)> is the main subroutine of -Text::WrapI18N module to execute the line wrapping. Input parameters -and output data emulate Text::Wrap. The texts have to be written in -locale encoding. - -=head1 SEE ALSO - -locale(5), utf-8(7), charsets(7) - -=head1 AUTHOR - -Tomohiro KUBOTA, E<lt>kubota@debian.orgE<gt> - -=head1 COPYRIGHT AND LICENSE - -Copyright 2003 by Tomohiro KUBOTA - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut |
