summaryrefslogtreecommitdiff
path: root/Master/setuptl/TLPM/common.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/setuptl/TLPM/common.pm')
-rw-r--r--Master/setuptl/TLPM/common.pm253
1 files changed, 0 insertions, 253 deletions
diff --git a/Master/setuptl/TLPM/common.pm b/Master/setuptl/TLPM/common.pm
deleted file mode 100644
index 02b871ff891..00000000000
--- a/Master/setuptl/TLPM/common.pm
+++ /dev/null
@@ -1,253 +0,0 @@
-# This file belongs to TLPM v2.21, TeX Live Package Manager
-# Public Domain, P.Jackowski@gust.org.pl
-
-# common procedures;
-# to avoid any stdlib dependencies, we implement a couple of trivial procedures here
-
-# operations on paths
-
-sub dirsep2dirsep
-{
- my $path = shift;
- $path =~ s/$reg_dirsep/$chr_dirsep/g;
- return $path;
-}
-
-sub split_path
-{
- return split(/$reg_dirsep/,$_[0]);
-}
-
-sub join_path
-{
- return join($chr_dirsep,@_);
-}
-
-sub join_list
-{
- return join(" ",@_);
-}
-
-sub norm_path
-{
- map
- {
- chomp;s/\A\s+//;
- #s/$reg_dirsep+/$chr_dirsep/g;
- s/$reg_dirsep\z//g;
- s/\"//g;
- # s/\A\'(.*?)\'\z/$1/;
- } @_;
-}
-
-sub make_tree
-{
- my $path = shift;
- &norm_path($path);
- $path = &rel2abs($path,$curr_dir);
- return(0) if -d $path;
- my @dirs = &split_path($path);
- $path = '';
- foreach(@dirs)
- {
- $path .= "$_$chr_dirsep";
- unless(-d $path)
- {
- mkdir($path,0777) or return $error{'cant_mdir'} -> ($path);
- }
- }
- chop $path;
- $message ->("Directory '$path' has been created");
- return(0);
-}
-
-sub rel2abs
-{
- return $_[0] if $_[0] =~ /$reg_abs/; # is absolute
- my @rel = &split_path($_[0]);
- my @abs = &split_path($_[1]);
- foreach(@rel)
- {
- next if /\A\.\z/;
- if(/\A\.\.\z/)
- {
- pop(@abs);
- next;
- }
- push(@abs, $_);
- }
- if(@abs)
- {
- return &join_path(@abs);
- }
- else
- {
- @abs = &split_path($_[1]); # just drive
- return $abs[0];
- }
-}
-
-# system command
-
-sub sys
-{
- system(&join_list(@_));
- return $?;
-}
-
-sub set
-{
- my ($key, $val);
- while($key = shift @_)
- {
- if($key =~ /=/)
- {
- ($key, $val) = split("=",$key);
- }
- else
- {
- $val = shift(@_);
- }
- unless($key eq '')
- {
- $ENV{$key} = $val;
- }
- }
-}
-
-# messaging
-
-$message_prefix = '% ';
-$warning_prefix = '! ';
-$messdbg_prefix = '? ';
-
-$_message = sub {return "$message_prefix$_[0]\n"};
-$_warning = sub {return "$warning_prefix$_[0]\n"};
-$_messdbg = sub {return "$messdbg_prefix$_[0]\n"};
-
-# printing to non-existing handle produce 'Bad file descriptor' error;
-# we don't have fork so printing to log and terminal needs to be parallel;
-# because of somewhat weird STRERR behaviour under windows, everything is
-# printed to STDOUT (for tlpmgui) or to file;
-# later we throw progress information to STRERR while installing from DVD
-
-sub _mess {print @_}
-sub _logmess {print @_;print LOG @_}
-
-sub _messf{printf @_}
-sub _logmessf {printf @_;printf LOG @_}
-
-sub _message
-{
- print STDOUT $_message -> (@_);
-}
-
-sub _logmessage
-{
- print STDOUT $_message -> (@_);
- print LOG $_message -> (@_);
-}
-
-sub _warning
-{
- print STDOUT $_warning -> (@_);
-}
-
-sub _logwarning
-{
- print STDOUT $_warning -> (@_);
- print LOG $_warning -> (@_);
-};
-
-sub talk2log
-{
- $mess = \&_logmess;
- $messf = \&_logmessf;
- $message = \&_logmessage;
- $warning = \&_logwarning;
-}
-
-sub not2log
-{
- $mess = \&_mess;
- $messf = \&_messf;
- $message = \&_message;
- $warning = \&_warning;
-}
-
-sub enable_dbg
-{
- $debug_mode = 1;
- $messdbg = sub {print STDOUT $_messdbg -> (@_)}
-}
-
-sub disable_dbg
-{
- $debug_mode = 0;
- $messdbg = \&relax
-}
-
-# -)
-
-sub relax
-{
- return; # not zero!
-}
-
-# singular vs plural
-
-sub one_or_more
-{
- return $_[0] . ' ' . ($_[0] == 1 ? $_[1] : $_[2]);
-}
-
-# ...meybe someday we will use returned error codes
-# errcode 0 is ok, 1 is help, negative means something went wrong
-
-%error =
-(
- 'tl_not_found' => sub {$warning -> ("TeX Live CD/DVD not found"); -1},
- 'not_tl_source' => sub {$warning -> ("TeX Live source not found at '$_[0]'"); -1},
- 'cant_odir' => sub {$warning -> ("Can't open directory '$_[0]'"); -2},
- 'cant_mdir' => sub {$warning -> ("Can't create directory '$_[0]'"); -3},
-# 'cant_wdir' => sub {$warning -> ("Directory '$_[0]' is not writable"); ?},
-# 'dir_unspec' => sub {$warning -> ("Target directory unspecified"); ?},
-# 'file_not_found' => sub {$warning -> ("Can't find file '$_[0]'"); ?},
- 'miss_dir' => sub {$warning -> ("Directory '$_[0]' does not exist"); -4},
- 'empty_dir' => sub {$warning -> ("Directory '$_[0]' contains no packages"); -5},
- 'wrong_out' => sub {$warning -> ("Can't write to '$_[0]'"); -6},
- 'wrong_inp' => sub {$warning -> ("Can't read from '$_[0]'"); -7},
- 'pkg_unspec' => sub {$warning -> ("Package unspecified"); -8},
- 'pkg_not_inst' => sub {$warning -> ("Package '$_[0]' is not installed"); -9},
- 'pkg_not_found' => sub {$warning -> ("Can't find package '$_[0]'"); -10},
- 'not_found' => sub {$warning -> ("Can't find '$_[0]'"); -11},
- 'wrong_opt' => sub {$warning -> ("Unknown option '$_[0]'. Type '$_[1]'"); -12},
- 'wrong_cmd' => sub {$warning -> ("Unknown command '$_[0]'. Type '$_[1]'"); -13},
- 'wrong_syn' => sub {$warning -> ("Incorrect phrase '$_[0]'"); -14},
- 'wrong_reg' => sub {$warning -> ("Incorrect expression '$_[0]'"); -15},
-# 'not_supp' => sub {$warning -> ("Sorry, $_[0] not yet supported"); -16}
-);
-
-# date handling
-
-sub date
-{
- my ($min,$hr,$day,$mon,$year) = (localtime)[1,2,3,4,5];
- $year += 1900;
- ($min,$hr,$day,$mon) = map {sprintf "%02d",$_} ($min,$hr,$day,$mon + 1);
- return "$day.$mon.$year, $hr:$min";
-}
-
-# quoting
-
-sub doubleq {return '"' . $_[0] . '"'}
-sub singleq {return "'" . $_[0] . "'"}
-
-# progress
-
-sub percent
-{
- return sprintf("%d%%",$_[0]*100/$_[1]);
-}
-
-1;