From 7a2f5672f7bd79f52a33a17bb530aa4555698b16 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Thu, 23 Jul 2009 17:53:58 +0000 Subject: (init_tlmedia): reformat to avoid main code in big else clause. git-svn-id: svn://tug.org/texlive/trunk@14406 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf/scripts/texlive/tlmgr.pl | 183 +++++++++++++++++----------------- 1 file changed, 94 insertions(+), 89 deletions(-) (limited to 'Master') diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl index 74424c0974f..e13c9da496d 100755 --- a/Master/texmf/scripts/texlive/tlmgr.pl +++ b/Master/texmf/scripts/texlive/tlmgr.pl @@ -57,12 +57,11 @@ BEGIN { } use Cwd qw/abs_path/; +use Digest::MD5; use Pod::Usage; use Getopt::Long qw(:config no_autoabbrev permute); use strict; -use Digest::MD5; - use TeXLive::TLConfig; use TeXLive::TLMedia; use TeXLive::TLPDB; @@ -71,7 +70,6 @@ use TeXLive::TLUtils; use TeXLive::TLWinGoo; TeXLive::TLUtils->import(qw(member info give_ctan_mirror win32 dirname mkdirhier copy log debug tlcmp)); - use TeXLive::TLPaper; binmode(STDOUT, ":utf8"); @@ -3067,108 +3065,114 @@ sub init_local_db { # initialize the global $tlmediasrc object, or die. # uses the global $location. # -sub init_tlmedia { +sub init_tlmedia +{ if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $location)) { # nothing to be done - } else { - if ($location =~ m/^($TeXLiveServerURL|ctan$)/) { - $location = give_ctan_mirror(); - } - # that "location-url" line should not be changed since GUI programs - # depend on it. - print "location-url\t$location\n" if $::machinereadable; - info("tlmgr: installation location $location\n"); + return; + } - # - # if we talk about a net location try to download the hash of the tlpdb - # - if that is possible, check for the locally saved file and if the hash - # agrees load the local copy if present instead of the remote one, - # if the hashes disagree, load the remote tlpdb - # - if that does not work assume we are offline or target not reachable, - # so warn the user and use saved, but note that installation will - # not work - - my $local_copy_tlpdb_used = 0; - if ($location =~ m;^(http|ftp)://;) { - # first check that the saved tlpdb is present at all - my $loc_digest = Digest::MD5::md5_hex($location); - my $loc_copy_of_remote_tlpdb = - "$Master/$InfraLocation/texlive.tlpdb.$loc_digest"; - ddebug("loc_digest = $loc_digest\n"); - ddebug("loc_copy = $loc_copy_of_remote_tlpdb\n"); - if (-r $loc_copy_of_remote_tlpdb) { - ddebug("loc copy found!\n"); - # we found the tlpdb matching the current location - # check for the remote hash - my $path = "$location/$InfraLocation/$DatabaseName.md5"; - ddebug("remote path of digest = $path\n"); - my $fh = TeXLive::TLUtils::download_file($path, "|"); - my $rem_digest; - if (read ($fh, $rem_digest, 32) != 32) { - info("No internet access detected, but a local copy of the remote\n"); - info("texlive database has been found. Using this copy.\n"); + # choose a mirror if we are asked. + if ($location =~ m,^($TeXLiveServerURL|ctan$),) { + $location = give_ctan_mirror(); + } + + # this "location-url" line should not be changed since GUI programs + # depend on it: + print "location-url\t$location\n" if $::machinereadable; + info("tlmgr: installation location $location\n"); + + # if we talk about a net location try to download the hash of the tlpdb + # - if that is possible, check for the locally saved file and if the hash + # agrees load the local copy if present instead of the remote one, + # if the hashes disagree, load the remote tlpdb + # - if that does not work assume we are offline or target not reachable, + # so warn the user and use saved, but note that installation will + # not work + + my $local_copy_tlpdb_used = 0; + if ($location =~ m;^(http|ftp)://;) { + # first check that the saved tlpdb is present at all + my $loc_digest = Digest::MD5::md5_hex($location); + my $loc_copy_of_remote_tlpdb = + "$Master/$InfraLocation/texlive.tlpdb.$loc_digest"; + ddebug("loc_digest = $loc_digest\n"); + ddebug("loc_copy = $loc_copy_of_remote_tlpdb\n"); + if (-r $loc_copy_of_remote_tlpdb) { + ddebug("loc copy found!\n"); + # we found the tlpdb matching the current location + # check for the remote hash + my $path = "$location/$InfraLocation/$DatabaseName.md5"; + ddebug("remote path of digest = $path\n"); + my $fh = TeXLive::TLUtils::download_file($path, "|"); + my $rem_digest; + if (read ($fh, $rem_digest, 32) != 32) { + info("No internet access detected, but a local copy of the remote\n"); + info("texlive database has been found. Using this copy.\n"); + $tlmediasrc = TeXLive::TLMedia->new(-location => $location, + -tlpdbfile => $loc_copy_of_remote_tlpdb); + $local_copy_tlpdb_used = 1; + } else { + ddebug("found remote digest: $rem_digest\n"); + my $rem_copy_digest = TeXLive::TLUtils::tlmd5($loc_copy_of_remote_tlpdb); + ddebug("rem_copy_digest = $rem_copy_digest\n"); + if ($rem_copy_digest eq $rem_digest) { + debug("md5 of local copy identical with remote hash\n"); $tlmediasrc = TeXLive::TLMedia->new(-location => $location, -tlpdbfile => $loc_copy_of_remote_tlpdb); $local_copy_tlpdb_used = 1; - } else { - ddebug("found remote digest: $rem_digest\n"); - my $rem_copy_digest = TeXLive::TLUtils::tlmd5($loc_copy_of_remote_tlpdb); - ddebug("rem_copy_digest = $rem_copy_digest\n"); - if ($rem_copy_digest eq $rem_digest) { - debug("md5 of local copy identical with remote hash\n"); - $tlmediasrc = TeXLive::TLMedia->new(-location => $location, - -tlpdbfile => $loc_copy_of_remote_tlpdb); - $local_copy_tlpdb_used = 1; - } } } } - if (!$local_copy_tlpdb_used) { - # $tlmediasrc is a global variable - $tlmediasrc = TeXLive::TLMedia->new(-location => $location); - } - die($loadmediasrcerror . $location) unless defined($tlmediasrc); - $tlmediatlpdb = $tlmediasrc->tlpdb; - # if the release from the remote TLPDB does not agree with the - # TLConfig::ReleaseYear in the first 4 places break out here. - # Why only the first four places: some optional network distributions - # might use - # release/2009-foobar - my $texlive_release = $tlmediatlpdb->config_release; - if (!defined($texlive_release) || - $texlive_release !~ m/^$TeXLive::TLConfig::ReleaseYear/) { - die "The release version of the installation source and the installation media\ndo not agree: source: $texlive_release, media: $TeXLive::TLConfig::ReleaseYear\nPlease fix your location $location"; - } - # - # check for being frozen - if ($tlmediatlpdb->option("frozen")) { - tlwarn("TeX Live $TeXLive::TLConfig::ReleaseYear is frozen and will not be updated anymore.\nPlease consider updating to the next release.\n"); - exit(1); - } - # save remote database if it is a net location - # make sure that the writeout of the tlpdb is done in UNIX mode - # since otherwise the sha256 will change. - if (!$local_copy_tlpdb_used && $location =~ m;^(http|ftp)://;) { - my $loc_digest = Digest::MD5::md5_hex($location); - my $loc_copy_of_remote_tlpdb = - "$Master/$InfraLocation/texlive.tlpdb.$loc_digest"; - my $tlfh; - if (!open($tlfh, ">:unix", $loc_copy_of_remote_tlpdb)) { - tlwarn("Cannot save remote TeX Live database to $loc_copy_of_remote_tlpdb: $!\n"); - } else { - &debug("writing out tlpdb to $loc_copy_of_remote_tlpdb\n"); - $tlmediatlpdb->writeout($tlfh); - close($tlfh); - } + } + if (!$local_copy_tlpdb_used) { + # $tlmediasrc is a global variable + $tlmediasrc = TeXLive::TLMedia->new(-location => $location); + } + die($loadmediasrcerror . $location) unless defined($tlmediasrc); + $tlmediatlpdb = $tlmediasrc->tlpdb; + # if the release from the remote TLPDB does not agree with the + # TLConfig::ReleaseYear in the first 4 places break out here. + # Why only the first four places: some optional network distributions + # might use + # release/2009-foobar + my $texlive_release = $tlmediatlpdb->config_release; + if (!defined($texlive_release) || + $texlive_release !~ m/^$TeXLive::TLConfig::ReleaseYear/) { + die "The release version of the installation source and the installation media\ndo not agree: source: $texlive_release, media: $TeXLive::TLConfig::ReleaseYear\nPlease fix your location $location"; + } + # + # check for being frozen + if ($tlmediatlpdb->option("frozen")) { + tlwarn("TeX Live $TeXLive::TLConfig::ReleaseYear is frozen and will not be updated anymore.\nPlease consider updating to the next release.\n"); + exit(1); + } + # save remote database if it is a net location + # make sure that the writeout of the tlpdb is done in UNIX mode + # since otherwise the sha256 will change. + if (!$local_copy_tlpdb_used && $location =~ m;^(http|ftp)://;) { + my $loc_digest = Digest::MD5::md5_hex($location); + my $loc_copy_of_remote_tlpdb = + "$Master/$InfraLocation/texlive.tlpdb.$loc_digest"; + my $tlfh; + if (!open($tlfh, ">:unix", $loc_copy_of_remote_tlpdb)) { + tlwarn("Cannot save remote TeX Live database to $loc_copy_of_remote_tlpdb: $!\n"); + } else { + &debug("writing out tlpdb to $loc_copy_of_remote_tlpdb\n"); + $tlmediatlpdb->writeout($tlfh); + close($tlfh); } } } + + # finish handles the -pause option (wait for input from stdin), # and then exits unless the global $::gui_mode is set, in which case we # merely return. # -sub finish { +sub finish +{ my ($ret) = @_; if ($ret > 0) { @@ -3189,7 +3193,8 @@ sub finish { # if the packagelog variable is set then write to PACKAGELOG filehandle # -sub logpackage { +sub logpackage +{ if ($packagelogfile) { $packagelogged++; my $tim = localtime(); -- cgit v1.2.3