1f219747dSAndre Fischer#!/usr/bin/perl 2f219747dSAndre Fischer#************************************************************** 3f219747dSAndre Fischer# 4f219747dSAndre Fischer# Licensed to the Apache Software Foundation (ASF) under one 5f219747dSAndre Fischer# or more contributor license agreements. See the NOTICE file 6f219747dSAndre Fischer# distributed with this work for additional information 7f219747dSAndre Fischer# regarding copyright ownership. The ASF licenses this file 8f219747dSAndre Fischer# to you under the Apache License, Version 2.0 (the 9f219747dSAndre Fischer# "License"); you may not use this file except in compliance 10f219747dSAndre Fischer# with the License. You may obtain a copy of the License at 11f219747dSAndre Fischer# 12f219747dSAndre Fischer# http://www.apache.org/licenses/LICENSE-2.0 13f219747dSAndre Fischer# 14f219747dSAndre Fischer# Unless required by applicable law or agreed to in writing, 15f219747dSAndre Fischer# software distributed under the License is distributed on an 16f219747dSAndre Fischer# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 17f219747dSAndre Fischer# KIND, either express or implied. See the License for the 18f219747dSAndre Fischer# specific language governing permissions and limitations 19f219747dSAndre Fischer# under the License. 20f219747dSAndre Fischer# 21f219747dSAndre Fischer#************************************************************** 22f219747dSAndre Fischer 23f219747dSAndre Fischeruse strict; 24f219747dSAndre Fischeruse XML::LibXML; 25f219747dSAndre Fischeruse open OUT => ":utf8"; 26f219747dSAndre Fischeruse LWP::Simple; 27f219747dSAndre Fischeruse Digest; 28f219747dSAndre Fischeruse Digest::MD5; 29f219747dSAndre Fischeruse Digest::SHA; 30*9dd622cdSAndre Fischeruse File::Temp; 31*9dd622cdSAndre Fischeruse File::Path; 32f219747dSAndre Fischer 33f219747dSAndre Fischeruse Carp::always; 34f219747dSAndre Fischer 35f219747dSAndre Fischer=head1 NAME 36f219747dSAndre Fischer 37f219747dSAndre Fischer build_release.pl - Tool for batch release builds and uploads and the creation of wiki pages that list install sets. 38f219747dSAndre Fischer 39f219747dSAndre Fischer=head1 SYNOPSIS 40f219747dSAndre Fischer 41f219747dSAndre Fischer build_release.pl <command> {option} <release-description.xml> 42f219747dSAndre Fischer 43f219747dSAndre Fischer comands: 44f219747dSAndre Fischer build builds all install sets as requested by the XML file and supported by the platform. 45*9dd622cdSAndre Fischer build-missing 46*9dd622cdSAndre Fischer build only those install sets that have not been built earlier. 47f219747dSAndre Fischer upload upload install sets to a local or remote (via ssh with public/private key) 48f219747dSAndre Fischer directory structure. Uploads install sets that where build on other platforms. 49f219747dSAndre Fischer wiki create a wiki (MediaWiki syntax) snippet that references all install sets at the upload 50f219747dSAndre Fischer location. Includes install sets that where built and/or uploaded from other 51f219747dSAndre Fischer platforms and machines. 52f219747dSAndre Fischer options: 53f219747dSAndre Fischer -j <count> maximum number of build processes 54f219747dSAndre Fischer -k keep going if there are recoverable errors 55f219747dSAndre Fischer -u <path> upload destination 56f219747dSAndre Fischer -l check links on wiki page, write broken links as plain text 57f219747dSAndre Fischer -ld check links on wiki page, mark broken links 58f219747dSAndre Fischer -o <filename> filename of the output (wiki: wiki page, build: makefile) 59*9dd622cdSAndre Fischer -n <number> maximal number of upload tries, defaults to 5. 60*9dd622cdSAndre Fischer -d dry-run 61f219747dSAndre Fischer 62*9dd622cdSAndre Fischer Typical calls are: 63*9dd622cdSAndre Fischer build_release.pl build -j4 instsetoo_native/util/aoo-410-release.xml 64*9dd622cdSAndre Fischer for building the installation sets, language packs and patches for the 4.1 release. 65*9dd622cdSAndre Fischer 66*9dd622cdSAndre Fischer build_release.pl upload -u me@server:path -n 3 instsetoo_native/util/aoo-410-release.xml 67*9dd622cdSAndre Fischer to upload the previously built installation sets etc. 68*9dd622cdSAndre Fischer 69*9dd622cdSAndre Fischer build_release.pl wiki -o /tmp/wiki.txt instsetoo_native/util/aoo-410-release.xml 70*9dd622cdSAndre Fischer to create an updated wiki page with installation sets etc built at several 71*9dd622cdSAndre Fischer places and uploaded to several locations. 72*9dd622cdSAndre Fischer 73*9dd622cdSAndre Fischer 74f219747dSAndre Fischer=head1 XML file format 75f219747dSAndre Fischer 76*9dd622cdSAndre FischerThe release description could look like this: 77*9dd622cdSAndre Fischer 78f219747dSAndre Fischer<release 79f219747dSAndre Fischer name="snapshot" 80f219747dSAndre Fischer version="4.1.0"> 81f219747dSAndre Fischer 82f219747dSAndre Fischer <language 83f219747dSAndre Fischer id="ast" # As specified by 'configure --with-lang' 84f219747dSAndre Fischer english-name="Asturian" 85f219747dSAndre Fischer local-name="Asturianu" 86f219747dSAndre Fischer /> 87f219747dSAndre Fischer ... more languages 88f219747dSAndre Fischer 89f219747dSAndre Fischer <platform 90f219747dSAndre Fischer id="wntmsci12.pro" 91f219747dSAndre Fischer display-name="Windows" 92f219747dSAndre Fischer archive-platform="Win_x86" 93f219747dSAndre Fischer word-size="32" 94*9dd622cdSAndre Fischer package-types="msi" 95*9dd622cdSAndre Fischer extension="exe" 96f219747dSAndre Fischer /> 97f219747dSAndre Fischer ... more platforms 98f219747dSAndre Fischer 99*9dd622cdSAndre Fischer <download 100*9dd622cdSAndre Fischer platform-id="wntmsci12.pro" 101*9dd622cdSAndre Fischer base-url="http://people.apache.org/~somebody/developer-snapshots/snapshot/win32" 102*9dd622cdSAndre Fischer /> 103f219747dSAndre Fischer 104f219747dSAndre Fischer <package 105*9dd622cdSAndre Fischer id="openoffice" 106*9dd622cdSAndre Fischer target="openoffice" 107f219747dSAndre Fischer display-name="Full Install" 108*9dd622cdSAndre Fischer archive-name="Apache_OpenOffice_%V_%P_install%T_%L.%E" 109*9dd622cdSAndre Fischer /> 110*9dd622cdSAndre Fischer 111*9dd622cdSAndre Fischer <build 112*9dd622cdSAndre Fischer package-id="openoffice" 113*9dd622cdSAndre Fischer platform-list="all" 114*9dd622cdSAndre Fischer language-list="all" 115*9dd622cdSAndre Fischer /> 116*9dd622cdSAndre Fischer ... more build entries 117*9dd622cdSAndre Fischer 118*9dd622cdSAndre Fischer <wiki> 119*9dd622cdSAndre Fischer <package-ref 120*9dd622cdSAndre Fischer package-id="openoffice" 121f219747dSAndre Fischer language-list="all" 122f219747dSAndre Fischer platform-list="all" 123f219747dSAndre Fischer table="main" 124f219747dSAndre Fischer /> 125f219747dSAndre Fischer ... more packages 126f219747dSAndre Fischer </wiki> 127f219747dSAndre Fischer 128f219747dSAndre Fischer</release> 129*9dd622cdSAndre Fischer 130*9dd622cdSAndre FischerA single <release> tag contains any number of 131*9dd622cdSAndre Fischer 132*9dd622cdSAndre Fischer<language> id 133*9dd622cdSAndre Fischer The language id used internally by the build process, eg de, en-US 134*9dd622cdSAndre Fischer english-name 135*9dd622cdSAndre Fischer The english name of the language, eg german 136*9dd622cdSAndre Fischer local-name 137*9dd622cdSAndre Fischer The language name in that language, eg Deutsch 138*9dd622cdSAndre Fischer 139*9dd622cdSAndre Fischer Each listed language is expected to have been passed to configure via --with-lang 140*9dd622cdSAndre Fischer The set of languages defines for which languages to 141*9dd622cdSAndre Fischer build installation sets, language packs etc. (build command) 142*9dd622cdSAndre Fischer upload installation sets, etc (upload command) 143*9dd622cdSAndre Fischer add rows in the wiki page (wiki command) 144*9dd622cdSAndre Fischer 145*9dd622cdSAndre Fischer<platform> id 146*9dd622cdSAndre Fischer The platform id that is used internally by the build process, eg wntmsci12.pro 147*9dd622cdSAndre Fischer Note that <p>.pro and <p> are treated as two different platforms. 148*9dd622cdSAndre Fischer display-name 149*9dd622cdSAndre Fischer Name which is printed in the wiki table. 150*9dd622cdSAndre Fischer archive-platform 151*9dd622cdSAndre Fischer Platform name as used in the name of the installation set, eg Win_x86 152*9dd622cdSAndre Fischer word-size 153*9dd622cdSAndre Fischer Bit size of the installation sets, etc, typically either 32 or 64 154*9dd622cdSAndre Fischer package-types 155*9dd622cdSAndre Fischer Semicolon separated list of package types, eg "msi" or "deb;rpm" 156*9dd622cdSAndre Fischer add-package-type-to-archive-name 157*9dd622cdSAndre Fischer For deb and rpm archives it is necessary to add the package type to the archive name. 158*9dd622cdSAndre Fischer extension 159*9dd622cdSAndre Fischer Extension of the archive name, eg "exe" or "tar.gz" 160*9dd622cdSAndre Fischer 161*9dd622cdSAndre Fischer For the build command only those <platform> elements are used that match the platform on which this 162*9dd622cdSAndre Fischer script is run. 163*9dd622cdSAndre Fischer 164*9dd622cdSAndre Fischer<download> 165*9dd622cdSAndre Fischer platform-id 166*9dd622cdSAndre Fischer Reference to one of the <platform> elements and has to match the id attribute of that platform. 167*9dd622cdSAndre Fischer base-url 168*9dd622cdSAndre Fischer URL head to which the name of the downloadable installation set etc. is appended. 169*9dd622cdSAndre Fischer Eg. http://people.apache.org/~somebody/developer-snapshots/snapshot/win32 170*9dd622cdSAndre Fischer 171*9dd622cdSAndre Fischer Defines one download source that is referenced in the wiki page. Multiple <download> elements 172*9dd622cdSAndre Fischer per platform are possible. Earlier entires are preferred over later ones. 173*9dd622cdSAndre Fischer 174*9dd622cdSAndre Fischer<package> 175*9dd622cdSAndre Fischer id 176*9dd622cdSAndre Fischer Internal name that is used to reference the package. 177*9dd622cdSAndre Fischer target 178*9dd622cdSAndre Fischer Target name recognized by instsetoo_native/util/makefile.mk, eg openoffice or oolanguagepack. 179*9dd622cdSAndre Fischer display-name 180*9dd622cdSAndre Fischer Name of the package that is shown in the wiki page, eg "Full Install" or "Langpack". 181*9dd622cdSAndre Fischer archive-name 182*9dd622cdSAndre Fischer Template of the archive name. 183*9dd622cdSAndre Fischer %V version 184*9dd622cdSAndre Fischer %P archive package name 185*9dd622cdSAndre Fischer %T package type 186*9dd622cdSAndre Fischer %L language 187*9dd622cdSAndre Fischer %E extension. 188*9dd622cdSAndre Fischer 189*9dd622cdSAndre Fischer Defines a downloadable and distributable package, eg openoffice for the binary OpenOffice installation set. 190f219747dSAndre Fischer 191*9dd622cdSAndre Fischer<build> target 192*9dd622cdSAndre Fischer platform-list 193*9dd622cdSAndre Fischer Semicolon separated list of platforms for which to build the target. 194*9dd622cdSAndre Fischer Ignores all platforms that don't match the platform on which this script is executed. 195*9dd622cdSAndre Fischer The special value 'all' is a shortcut for all platforms listed by <platform> elements. 196*9dd622cdSAndre Fischer language-list 197*9dd622cdSAndre Fischer Semicolon separated list of languages for which the build the target. 198*9dd622cdSAndre Fischer The special value 'all' is a shortcut for all languages listed by <language> elements. 199*9dd622cdSAndre Fischer 200*9dd622cdSAndre Fischer Defines the sets of targets, plaforms and languages which are to be built. 201*9dd622cdSAndre Fischer 202*9dd622cdSAndre Fischer<wiki> 203*9dd622cdSAndre Fischer <package-ref> 204*9dd622cdSAndre Fischer package-id 205*9dd622cdSAndre Fischer The id of the referenced package. 206*9dd622cdSAndre Fischer platform-list 207*9dd622cdSAndre Fischer See <build> tag for explanation. 208*9dd622cdSAndre Fischer language-list 209*9dd622cdSAndre Fischer See <build> tag for explanation. 210*9dd622cdSAndre Fischer table 211*9dd622cdSAndre Fischer Specifies the wiki table into which to add the package lines. Can be "main" or "secondary". 212*9dd622cdSAndre Fischer 213f219747dSAndre Fischer=cut 214f219747dSAndre Fischer 215f219747dSAndre Fischer 216f219747dSAndre Fischer 217f219747dSAndre Fischermy %EnUSBasedLanguages = ( 218f219747dSAndre Fischer 'ast' => 1 219f219747dSAndre Fischer ); 220f219747dSAndre Fischer 221f219747dSAndre Fischer 222*9dd622cdSAndre Fischersub GetInstallationPackageName ($$$$$); 223f219747dSAndre Fischer 224f219747dSAndre Fischersub ProcessCommandline (@) 225f219747dSAndre Fischer{ 226f219747dSAndre Fischer my @arguments = @_; 227f219747dSAndre Fischer 228f219747dSAndre Fischer my $command = undef; 229f219747dSAndre Fischer my $description_filename = undef; 230f219747dSAndre Fischer my $max_process_count = 1; 231f219747dSAndre Fischer my $keep_going = 0; 232f219747dSAndre Fischer my $upload_destination = undef; 233f219747dSAndre Fischer my $check_links = 0; 234f219747dSAndre Fischer my $mark_broken_links = 0; 235f219747dSAndre Fischer my $output_filename = undef; 236*9dd622cdSAndre Fischer my $max_upload_count = 5; 237*9dd622cdSAndre Fischer my $build_only_missing = 0; 238*9dd622cdSAndre Fischer my $dry_run = 0; 239f219747dSAndre Fischer 240f219747dSAndre Fischer my $error = 0; 241f219747dSAndre Fischer while (scalar @arguments > 0) 242f219747dSAndre Fischer { 243f219747dSAndre Fischer my $argument = shift @arguments; 244f219747dSAndre Fischer if ($argument =~ /^-/) 245f219747dSAndre Fischer { 246f219747dSAndre Fischer if ($argument eq "-j") 247f219747dSAndre Fischer { 248f219747dSAndre Fischer $max_process_count = shift @arguments; 249f219747dSAndre Fischer } 250f219747dSAndre Fischer elsif ($argument eq "-u") 251f219747dSAndre Fischer { 252f219747dSAndre Fischer $upload_destination = shift @arguments; 253f219747dSAndre Fischer $upload_destination =~ s/(\\|\/)$//; 254f219747dSAndre Fischer } 255f219747dSAndre Fischer elsif ($argument eq "-k") 256f219747dSAndre Fischer { 257f219747dSAndre Fischer $keep_going = 1; 258f219747dSAndre Fischer } 259f219747dSAndre Fischer elsif ($argument eq "-l") 260f219747dSAndre Fischer { 261f219747dSAndre Fischer $check_links = 1; 262f219747dSAndre Fischer } 263f219747dSAndre Fischer elsif ($argument eq "-ld") 264f219747dSAndre Fischer { 265f219747dSAndre Fischer $check_links = 1; 266f219747dSAndre Fischer $mark_broken_links = 1; 267f219747dSAndre Fischer } 268f219747dSAndre Fischer elsif ($argument eq "-o") 269f219747dSAndre Fischer { 270f219747dSAndre Fischer $output_filename = shift @arguments; 271f219747dSAndre Fischer } 272*9dd622cdSAndre Fischer elsif ($argument eq "-n") 273*9dd622cdSAndre Fischer { 274*9dd622cdSAndre Fischer $max_upload_count = shift @arguments; 275*9dd622cdSAndre Fischer } 276*9dd622cdSAndre Fischer elsif ($argument eq "-d") 277*9dd622cdSAndre Fischer { 278*9dd622cdSAndre Fischer $dry_run = 1; 279*9dd622cdSAndre Fischer } 280f219747dSAndre Fischer else 281f219747dSAndre Fischer { 282f219747dSAndre Fischer printf STDERR "unknown option $argument %s\n", $argument; 283f219747dSAndre Fischer $error = 1; 284f219747dSAndre Fischer } 285f219747dSAndre Fischer } 286f219747dSAndre Fischer elsif ( ! defined $command) 287f219747dSAndre Fischer { 288f219747dSAndre Fischer $command = $argument; 289*9dd622cdSAndre Fischer if ($command eq "build-missing") 290*9dd622cdSAndre Fischer { 291*9dd622cdSAndre Fischer $command = "build"; 292*9dd622cdSAndre Fischer $build_only_missing = 1; 293*9dd622cdSAndre Fischer } 294*9dd622cdSAndre Fischer elsif ($command !~ /^(build|build-missing|upload|wiki)$/) 295f219747dSAndre Fischer { 296f219747dSAndre Fischer printf STDERR "unknown command '%s'\n", $command; 297f219747dSAndre Fischer $error = 1; 298f219747dSAndre Fischer } 299f219747dSAndre Fischer } 300f219747dSAndre Fischer else 301f219747dSAndre Fischer { 302f219747dSAndre Fischer $description_filename = $argument; 303f219747dSAndre Fischer if ( ! -f $description_filename) 304f219747dSAndre Fischer { 305f219747dSAndre Fischer print STDERR "can not open release description '%s'\n", $description_filename; 306f219747dSAndre Fischer $error = 1; 307f219747dSAndre Fischer } 308f219747dSAndre Fischer } 309f219747dSAndre Fischer } 310f219747dSAndre Fischer 311f219747dSAndre Fischer if ( ! defined $description_filename) 312f219747dSAndre Fischer { 313f219747dSAndre Fischer $error = 1; 314f219747dSAndre Fischer } 315*9dd622cdSAndre Fischer if ($command =~ /^(wiki)$/) 316f219747dSAndre Fischer { 317f219747dSAndre Fischer if ( ! defined $output_filename) 318f219747dSAndre Fischer { 319f219747dSAndre Fischer printf STDERR "ERROR: no output filename\n", 320f219747dSAndre Fischer $error = 1; 321f219747dSAndre Fischer } 322f219747dSAndre Fischer } 323f219747dSAndre Fischer 324f219747dSAndre Fischer if ($error) 325f219747dSAndre Fischer { 326f219747dSAndre Fischer PrintUsageAndExit(); 327f219747dSAndre Fischer } 328f219747dSAndre Fischer 329f219747dSAndre Fischer return { 330f219747dSAndre Fischer 'command' => $command, 331f219747dSAndre Fischer 'filename' => $description_filename, 332f219747dSAndre Fischer 'max-process-count' => $max_process_count, 333f219747dSAndre Fischer 'keep-going' => $keep_going, 334f219747dSAndre Fischer 'upload-destination' => $upload_destination, 335f219747dSAndre Fischer 'check-links' => $check_links, 336f219747dSAndre Fischer 'mark-broken-links' => $mark_broken_links, 337*9dd622cdSAndre Fischer 'output-filename' => $output_filename, 338*9dd622cdSAndre Fischer 'max-upload-count' => $max_upload_count, 339*9dd622cdSAndre Fischer 'build-only-missing' => $build_only_missing, 340*9dd622cdSAndre Fischer 'dry-run' => $dry_run 341f219747dSAndre Fischer }; 342f219747dSAndre Fischer} 343f219747dSAndre Fischer 344f219747dSAndre Fischer 345f219747dSAndre Fischer 346f219747dSAndre Fischer 347f219747dSAndre Fischersub PrintUsageAndExit () 348f219747dSAndre Fischer{ 349f219747dSAndre Fischer print STDERR "usage: $0 <command> {option} <release-description.xml>\n"; 350f219747dSAndre Fischer print STDERR " comands:\n"; 351f219747dSAndre Fischer print STDERR " build\n"; 352*9dd622cdSAndre Fischer print STDERR " build-missing\n"; 353f219747dSAndre Fischer print STDERR " upload\n"; 354f219747dSAndre Fischer print STDERR " wiki create a download page in MediaWiki syntax\n"; 355f219747dSAndre Fischer print STDERR " options:\n"; 356f219747dSAndre Fischer print STDERR " -j <count> maximum number of build processes\n"; 357f219747dSAndre Fischer print STDERR " -k keep going if there are recoverable errors\n"; 358f219747dSAndre Fischer print STDERR " -u <path> upload destination\n"; 359f219747dSAndre Fischer print STDERR " -l check links on wiki page, write broken links as plain text\n"; 360f219747dSAndre Fischer print STDERR " -ld check links on wiki page, mark broken links\n"; 361f219747dSAndre Fischer print STDERR " -o <filename> filename of the output (wiki: wiki page, build: makefile)\n"; 362*9dd622cdSAndre Fischer print STDERR " -n <number> maximal number of upload tries, defaults to 5.\n"; 363*9dd622cdSAndre Fischer print STDERR " -d dry run\n"; 364f219747dSAndre Fischer exit(1); 365f219747dSAndre Fischer} 366f219747dSAndre Fischer 367f219747dSAndre Fischer 368f219747dSAndre Fischer 369f219747dSAndre Fischer 370*9dd622cdSAndre Fischer=head2 Trim ($text) 371*9dd622cdSAndre Fischer 372*9dd622cdSAndre Fischer Remove leading and trailing space from the given string. 373*9dd622cdSAndre Fischer 374*9dd622cdSAndre Fischer=cut 375f219747dSAndre Fischersub Trim ($) 376f219747dSAndre Fischer{ 377f219747dSAndre Fischer my ($text) = @_; 378f219747dSAndre Fischer $text =~ s/^\s+|\s+$//g; 379f219747dSAndre Fischer return $text; 380f219747dSAndre Fischer} 381f219747dSAndre Fischer 382f219747dSAndre Fischer 383f219747dSAndre Fischer 384f219747dSAndre Fischer 385*9dd622cdSAndre Fischer=head2 ReadReleaseDescription ($$) 386*9dd622cdSAndre Fischer 387*9dd622cdSAndre Fischer Read the release description from $filename. 388*9dd622cdSAndre Fischer 389*9dd622cdSAndre Fischer=cut 390f219747dSAndre Fischersub ReadReleaseDescription ($$) 391f219747dSAndre Fischer{ 392f219747dSAndre Fischer my ($filename, $context) = @_; 393f219747dSAndre Fischer 394f219747dSAndre Fischer my $document = XML::LibXML->load_xml('location' => $filename); 395f219747dSAndre Fischer my $root = $document->documentElement(); 396f219747dSAndre Fischer 397f219747dSAndre Fischer # Initialize the release description. 398f219747dSAndre Fischer my $release = { 399f219747dSAndre Fischer 'name' => $root->getAttribute("name"), 400f219747dSAndre Fischer 'version' => $root->getAttribute("version"), 401f219747dSAndre Fischer 'builds' => [], 402f219747dSAndre Fischer 'languages' => {}, 403f219747dSAndre Fischer 'language-ids' => [], 404f219747dSAndre Fischer 'platforms' => {}, 405*9dd622cdSAndre Fischer 'downloads' => [], 406*9dd622cdSAndre Fischer 'packages' => {}, 407f219747dSAndre Fischer 'platform-ids' => [], 408*9dd622cdSAndre Fischer 'wiki-packages' => [] 409f219747dSAndre Fischer }; 410f219747dSAndre Fischer 411f219747dSAndre Fischer # Process the language descriptions. 412f219747dSAndre Fischer for my $language_element ($root->getChildrenByTagName("language")) 413f219747dSAndre Fischer { 414f219747dSAndre Fischer my $language_descriptor = ProcessLanguageDescription($language_element, $context); 415f219747dSAndre Fischer $release->{'languages'}->{$language_descriptor->{'id'}} = $language_descriptor; 416f219747dSAndre Fischer push @{$release->{'language-ids'}}, $language_descriptor->{'id'}; 417f219747dSAndre Fischer } 418f219747dSAndre Fischer printf "%d languages\n", scalar keys %{$release->{'languages'}}; 419f219747dSAndre Fischer 420f219747dSAndre Fischer # Process the platform descriptions. 421f219747dSAndre Fischer for my $platform_element ($root->getChildrenByTagName("platform")) 422f219747dSAndre Fischer { 423*9dd622cdSAndre Fischer my $platform_descriptor = ProcessPlatformDescription($platform_element, $context); 424*9dd622cdSAndre Fischer $release->{'platforms'}->{$platform_descriptor->{'id'}} = $platform_descriptor; 425*9dd622cdSAndre Fischer push @{$release->{'platform-ids'}}, $platform_descriptor->{'id'}; 426f219747dSAndre Fischer } 427f219747dSAndre Fischer printf "%d platforms\n", scalar keys %{$release->{'platforms'}}; 428f219747dSAndre Fischer 429*9dd622cdSAndre Fischer # Process the package descriptions. 430*9dd622cdSAndre Fischer for my $package_element ($root->getChildrenByTagName("package")) 431*9dd622cdSAndre Fischer { 432*9dd622cdSAndre Fischer my $package_descriptor = ProcessPackageDescription($package_element, $context); 433*9dd622cdSAndre Fischer $release->{'packages'}->{$package_descriptor->{'id'}} = $package_descriptor; 434*9dd622cdSAndre Fischer } 435*9dd622cdSAndre Fischer printf "%d packages\n", scalar keys %{$release->{'packages'}}; 436*9dd622cdSAndre Fischer 437*9dd622cdSAndre Fischer # Process the download descriptions. 438*9dd622cdSAndre Fischer for my $download_element ($root->getChildrenByTagName("download")) 439*9dd622cdSAndre Fischer { 440*9dd622cdSAndre Fischer my $download_descriptor = ProcessDownloadDescription($download_element, $context); 441*9dd622cdSAndre Fischer push @{$release->{'downloads'}}, $download_descriptor; 442*9dd622cdSAndre Fischer } 443*9dd622cdSAndre Fischer printf "%d downloads\n", scalar @{$release->{'downloads'}}; 444*9dd622cdSAndre Fischer 445f219747dSAndre Fischer if ($context->{'command'} =~ /^(build|upload)$/) 446f219747dSAndre Fischer { 447f219747dSAndre Fischer # Process the build descriptions. 448f219747dSAndre Fischer for my $build_element ($root->getChildrenByTagName("build")) 449f219747dSAndre Fischer { 450f219747dSAndre Fischer push @{$release->{'builds'}}, ProcessBuildDescription($build_element, $context, $release); 451f219747dSAndre Fischer } 452f219747dSAndre Fischer printf "%d build targets\n", scalar @{$release->{'builds'}}; 453f219747dSAndre Fischer } 454f219747dSAndre Fischer 455f219747dSAndre Fischer if ($context->{'command'} eq "wiki") 456f219747dSAndre Fischer { 457f219747dSAndre Fischer for my $wiki_element ($root->getChildrenByTagName("wiki")) 458f219747dSAndre Fischer { 459*9dd622cdSAndre Fischer for my $wiki_package_element ($wiki_element->getChildrenByTagName("package-ref")) 460f219747dSAndre Fischer { 461f219747dSAndre Fischer my $wiki_package = ProcessWikiPackageDescription( 462f219747dSAndre Fischer $wiki_package_element, 463f219747dSAndre Fischer $context, 464f219747dSAndre Fischer $release); 465f219747dSAndre Fischer push @{$release->{'wiki-packages'}}, $wiki_package; 466f219747dSAndre Fischer } 467f219747dSAndre Fischer } 468f219747dSAndre Fischer printf "%d wiki packages\n", scalar @{$release->{'wiki-packages'}}; 469f219747dSAndre Fischer } 470f219747dSAndre Fischer 471f219747dSAndre Fischer return $release; 472f219747dSAndre Fischer} 473f219747dSAndre Fischer 474f219747dSAndre Fischer 475f219747dSAndre Fischer 476f219747dSAndre Fischer 477*9dd622cdSAndre Fischer=head ProcessBuildDescription ($build_element, $context, $release_descriptor) 478*9dd622cdSAndre Fischer 479*9dd622cdSAndre Fischer Process one <build> element. 480*9dd622cdSAndre Fischer 481*9dd622cdSAndre Fischer If its platform-list does not match the current platform then the <build> element is ignored. 482*9dd622cdSAndre Fischer 483*9dd622cdSAndre Fischer=cut 484f219747dSAndre Fischersub ProcessBuildDescription ($$$) 485f219747dSAndre Fischer{ 486f219747dSAndre Fischer my ($build_element, $context, $release_descriptor) = @_; 487f219747dSAndre Fischer 488*9dd622cdSAndre Fischer my $package_id = $build_element->getAttribute("package-id"); 489f219747dSAndre Fischer my $languages = PostprocessLanguageList($build_element->getAttribute("language-list"), $release_descriptor); 490f219747dSAndre Fischer my $platforms = PostprocessPlatformList($build_element->getAttribute("platform-list"), $release_descriptor); 491f219747dSAndre Fischer 492f219747dSAndre Fischer # Check if the platform matches any for which the product shall be built. 493f219747dSAndre Fischer my $current_platform = $ENV{'INPATH'}; 494f219747dSAndre Fischer my $is_platform_match = 0; 495f219747dSAndre Fischer foreach my $platform_id (@$platforms) 496f219747dSAndre Fischer { 497f219747dSAndre Fischer if ($platform_id eq $current_platform) 498f219747dSAndre Fischer { 499f219747dSAndre Fischer $is_platform_match=1; 500f219747dSAndre Fischer last; 501f219747dSAndre Fischer } 502f219747dSAndre Fischer } 503f219747dSAndre Fischer if ($is_platform_match) 504f219747dSAndre Fischer { 505*9dd622cdSAndre Fischer printf "including build %s\n", $package_id; 506f219747dSAndre Fischer } 507f219747dSAndre Fischer else 508f219747dSAndre Fischer { 509*9dd622cdSAndre Fischer printf "skipping build %s: no platform match\n", $package_id; 510f219747dSAndre Fischer printf "none of the platforms %s matches %s\n", 511*9dd622cdSAndre Fischer join(", ", keys %{$release_descriptor->{'platforms'}}), 512*9dd622cdSAndre Fischer $current_platform; 513f219747dSAndre Fischer return; 514f219747dSAndre Fischer } 515f219747dSAndre Fischer 516f219747dSAndre Fischer my @languages = CheckLanguageSet($context, @$languages); 517f219747dSAndre Fischer 518f219747dSAndre Fischer return { 519*9dd622cdSAndre Fischer 'package-id' => $package_id, 520*9dd622cdSAndre Fischer 'platform-list' => $platforms, 521f219747dSAndre Fischer 'language-list' => \@languages 522f219747dSAndre Fischer }; 523f219747dSAndre Fischer} 524f219747dSAndre Fischer 525f219747dSAndre Fischer 526f219747dSAndre Fischer 527f219747dSAndre Fischer 528*9dd622cdSAndre Fischer 529*9dd622cdSAndre Fischer=head2 ProcessPlatformDescription ($element, $context) 530*9dd622cdSAndre Fischer 531*9dd622cdSAndre Fischer Process one <platform> element. 532*9dd622cdSAndre Fischer 533*9dd622cdSAndre Fischer The corresponding platform descriptor is returned as a hash. 534*9dd622cdSAndre Fischer 535*9dd622cdSAndre Fischer=cut 536f219747dSAndre Fischersub ProcessPlatformDescription ($$) 537f219747dSAndre Fischer{ 538f219747dSAndre Fischer my ($element, $context) = @_; 539f219747dSAndre Fischer 540f219747dSAndre Fischer my $descriptor = {}; 541f219747dSAndre Fischer # Mandatory tags. 542*9dd622cdSAndre Fischer foreach my $id ("id", "display-name", "archive-platform", "word-size", "package-types") 543f219747dSAndre Fischer { 544f219747dSAndre Fischer $descriptor->{$id} = $element->getAttribute($id); 545*9dd622cdSAndre Fischer die "release/platform has no attribute $id" unless defined $descriptor->{$id}; 546f219747dSAndre Fischer } 547*9dd622cdSAndre Fischer # Optional tags. 548*9dd622cdSAndre Fischer foreach my $id ("extension", "add-package-type-to-archive-name") 549*9dd622cdSAndre Fischer { 550*9dd622cdSAndre Fischer $descriptor->{$id} = $element->getAttribute($id); 551*9dd622cdSAndre Fischer } 552*9dd622cdSAndre Fischer 553*9dd622cdSAndre Fischer $descriptor->{'package-types'} = [split(/;/, $descriptor->{'package-types'})]; 554*9dd622cdSAndre Fischer 555*9dd622cdSAndre Fischer return $descriptor; 556*9dd622cdSAndre Fischer} 557*9dd622cdSAndre Fischer 558*9dd622cdSAndre Fischer 559*9dd622cdSAndre Fischer 560*9dd622cdSAndre Fischer 561*9dd622cdSAndre Fischer=head2 ProcessDownloadDescription ($element, $context) 562*9dd622cdSAndre Fischer 563*9dd622cdSAndre Fischer Process one <download> element. 564*9dd622cdSAndre Fischer 565*9dd622cdSAndre Fischer The corresponding download descriptor is returned as a hash. 566*9dd622cdSAndre Fischer 567*9dd622cdSAndre Fischer=cut 568*9dd622cdSAndre Fischersub ProcessDownloadDescription ($$) 569*9dd622cdSAndre Fischer{ 570*9dd622cdSAndre Fischer my ($element, $context) = @_; 571f219747dSAndre Fischer 572*9dd622cdSAndre Fischer my $descriptor = {}; 573*9dd622cdSAndre Fischer 574*9dd622cdSAndre Fischer # Mandatory tags. 575*9dd622cdSAndre Fischer foreach my $id ("platform-id", "base-url") 576f219747dSAndre Fischer { 577*9dd622cdSAndre Fischer $descriptor->{$id} = $element->getAttribute($id); 578*9dd622cdSAndre Fischer die "release/download has no attribute $id" unless defined $descriptor->{$id}; 579f219747dSAndre Fischer } 580f219747dSAndre Fischer 581*9dd622cdSAndre Fischer return $descriptor; 582f219747dSAndre Fischer} 583f219747dSAndre Fischer 584f219747dSAndre Fischer 585f219747dSAndre Fischer 586f219747dSAndre Fischer 587*9dd622cdSAndre Fischer=head2 ProcessPackageDescription ($element, $context) 588*9dd622cdSAndre Fischer 589*9dd622cdSAndre Fischer Process one <package> element. 590*9dd622cdSAndre Fischer 591*9dd622cdSAndre Fischer The corresponding package descriptor is returned as a hash. 592*9dd622cdSAndre Fischer 593*9dd622cdSAndre Fischer=cut 594*9dd622cdSAndre Fischersub ProcessPackageDescription ($$$) 595f219747dSAndre Fischer{ 596f219747dSAndre Fischer my ($element, $context, $release_descriptor) = @_; 597f219747dSAndre Fischer 598f219747dSAndre Fischer my $descriptor = {}; 599*9dd622cdSAndre Fischer 600f219747dSAndre Fischer # Mandatory tags. 601*9dd622cdSAndre Fischer foreach my $id ("id", "target", "archive-name", "display-name") 602f219747dSAndre Fischer { 603f219747dSAndre Fischer $descriptor->{$id} = $element->getAttribute($id); 604*9dd622cdSAndre Fischer die "release/package has no attribute $id" unless defined $descriptor->{$id}; 605*9dd622cdSAndre Fischer die "release/package attribute $id is empty" unless $descriptor->{$id} !~ /^\s*$/; 606f219747dSAndre Fischer } 607f219747dSAndre Fischer # Optional tags. 608*9dd622cdSAndre Fischer foreach my $id ("link-tooltip", "link-URL", "download-extension") 609*9dd622cdSAndre Fischer { 610*9dd622cdSAndre Fischer $descriptor->{$id} = $element->getAttribute($id); 611*9dd622cdSAndre Fischer } 612*9dd622cdSAndre Fischer 613*9dd622cdSAndre Fischer return $descriptor; 614*9dd622cdSAndre Fischer} 615*9dd622cdSAndre Fischer 616*9dd622cdSAndre Fischer 617*9dd622cdSAndre Fischer 618*9dd622cdSAndre Fischer 619*9dd622cdSAndre Fischer=head2 ProcessWikiPackageDescription ($element, $context) 620*9dd622cdSAndre Fischer 621*9dd622cdSAndre Fischer Process one <wiki><package-ref> element. 622*9dd622cdSAndre Fischer 623*9dd622cdSAndre Fischer The corresponding descriptor is returned as a hash. 624*9dd622cdSAndre Fischer 625*9dd622cdSAndre Fischer=cut 626*9dd622cdSAndre Fischersub ProcessWikiPackageDescription ($$$) 627*9dd622cdSAndre Fischer{ 628*9dd622cdSAndre Fischer my ($element, $context, $release_descriptor) = @_; 629*9dd622cdSAndre Fischer 630*9dd622cdSAndre Fischer my $descriptor = {}; 631*9dd622cdSAndre Fischer # Mandatory tags. 632*9dd622cdSAndre Fischer foreach my $id ("package-id", "table") 633f219747dSAndre Fischer { 634f219747dSAndre Fischer $descriptor->{$id} = $element->getAttribute($id); 635*9dd622cdSAndre Fischer die "wiki/package-ref has no attribute $id" unless defined $descriptor->{$id}; 636*9dd622cdSAndre Fischer die "wiki/package-ref attribute $id is empty" unless $descriptor->{$id} !~ /^\s*$/; 637f219747dSAndre Fischer } 638f219747dSAndre Fischer 639f219747dSAndre Fischer $descriptor->{'language-list'} = PostprocessLanguageList( 640f219747dSAndre Fischer $element->getAttribute("language-list"), 641f219747dSAndre Fischer $release_descriptor); 642f219747dSAndre Fischer $descriptor->{'platform-list'} = PostprocessPlatformList( 643f219747dSAndre Fischer $element->getAttribute("platform-list"), 644f219747dSAndre Fischer $release_descriptor); 645f219747dSAndre Fischer 646f219747dSAndre Fischer $descriptor->{'languages'} = {map{$_=>1} @{$descriptor->{'language-list'}}}; 647f219747dSAndre Fischer $descriptor->{'platforms'} = {map{$_=>1} @{$descriptor->{'platform-list'}}}; 648f219747dSAndre Fischer 649f219747dSAndre Fischer return $descriptor; 650f219747dSAndre Fischer} 651f219747dSAndre Fischer 652f219747dSAndre Fischer 653f219747dSAndre Fischer 654f219747dSAndre Fischer 655*9dd622cdSAndre Fischer=head2 ProcessLanguageDescription ($element, $context) 656*9dd622cdSAndre Fischer 657*9dd622cdSAndre Fischer Process one <language> element. 658*9dd622cdSAndre Fischer 659*9dd622cdSAndre Fischer The corresponding language descriptor is returned as a hash. 660*9dd622cdSAndre Fischer 661*9dd622cdSAndre Fischer=cut 662f219747dSAndre Fischersub ProcessLanguageDescription ($$) 663f219747dSAndre Fischer{ 664f219747dSAndre Fischer my ($element, $context) = @_; 665f219747dSAndre Fischer 666f219747dSAndre Fischer my $descriptor = {}; 667f219747dSAndre Fischer foreach my $id ("id", "english-name", "local-name") 668f219747dSAndre Fischer { 669f219747dSAndre Fischer $descriptor->{$id} = $element->getAttribute($id); 670f219747dSAndre Fischer die "wiki/language has no attribute $id" unless defined $descriptor->{$id}; 671f219747dSAndre Fischer } 672f219747dSAndre Fischer 673f219747dSAndre Fischer return $descriptor; 674f219747dSAndre Fischer} 675f219747dSAndre Fischer 676f219747dSAndre Fischer 677f219747dSAndre Fischer 678f219747dSAndre Fischer 679*9dd622cdSAndre Fischer=head2 PostprocessLanguageList ($language_list, $release_descriptor) 680*9dd622cdSAndre Fischer 681*9dd622cdSAndre Fischer Process a language list that is given as 'language-list' attribute to some tags. 682*9dd622cdSAndre Fischer 683*9dd622cdSAndre Fischer If the attribute is missing, ie $language_list is undef, or its value is "all", 684*9dd622cdSAndre Fischer then the returned list of languages is set to all languages defined via <language> elements. 685*9dd622cdSAndre Fischer 686*9dd622cdSAndre Fischer=cut 687f219747dSAndre Fischersub PostprocessLanguageList ($$) 688f219747dSAndre Fischer{ 689f219747dSAndre Fischer my ($language_list, $release_descriptor) = @_; 690f219747dSAndre Fischer 691f219747dSAndre Fischer my @matching_languages = (); 692f219747dSAndre Fischer if ( ! defined $language_list 693f219747dSAndre Fischer || $language_list eq "all") 694f219747dSAndre Fischer { 695f219747dSAndre Fischer @matching_languages = sort keys %{$release_descriptor->{'languages'}}; 696f219747dSAndre Fischer } 697f219747dSAndre Fischer else 698f219747dSAndre Fischer { 699f219747dSAndre Fischer @matching_languages = split(/;/, $language_list); 700f219747dSAndre Fischer } 701f219747dSAndre Fischer 702f219747dSAndre Fischer return \@matching_languages; 703f219747dSAndre Fischer} 704f219747dSAndre Fischer 705f219747dSAndre Fischer 706f219747dSAndre Fischer 707f219747dSAndre Fischer 708*9dd622cdSAndre Fischer=head2 PostprocessPlatformList ($platform_list, $release_descriptor) 709*9dd622cdSAndre Fischer 710*9dd622cdSAndre Fischer Process a platform list that is given as 'platform-list' attribute to some tags. 711*9dd622cdSAndre Fischer 712*9dd622cdSAndre Fischer If the attribute is missing, ie $platform_list is undef, or its value is "all", 713*9dd622cdSAndre Fischer then the returned list of platforms is set to all platforms defined via <platform> elements. 714*9dd622cdSAndre Fischer 715*9dd622cdSAndre Fischer=cut 716f219747dSAndre Fischersub PostprocessPlatformList ($$) 717f219747dSAndre Fischer{ 718f219747dSAndre Fischer my ($platform_list, $release_descriptor) = @_; 719f219747dSAndre Fischer 720f219747dSAndre Fischer my @matching_platforms = (); 721f219747dSAndre Fischer if ( ! defined $platform_list 722f219747dSAndre Fischer || $platform_list eq "all") 723f219747dSAndre Fischer { 724f219747dSAndre Fischer @matching_platforms = sort keys %{$release_descriptor->{'platforms'}}; 725f219747dSAndre Fischer } 726f219747dSAndre Fischer else 727f219747dSAndre Fischer { 728f219747dSAndre Fischer @matching_platforms = split(/;/, $platform_list); 729f219747dSAndre Fischer } 730f219747dSAndre Fischer 731f219747dSAndre Fischer return \@matching_platforms; 732f219747dSAndre Fischer} 733f219747dSAndre Fischer 734f219747dSAndre Fischer 735f219747dSAndre Fischer 736f219747dSAndre Fischer 737*9dd622cdSAndre Fischer=head2 CheckLanguageSet ($context, @languages) 738*9dd622cdSAndre Fischer 739*9dd622cdSAndre Fischer Compare the given list of languages with the one defined by the 'WITH_LANG' environment variable. 740*9dd622cdSAndre Fischer 741*9dd622cdSAndre Fischer This is to ensure that configure --with-lang was called with the same set of languages that are 742*9dd622cdSAndre Fischer listed by the <language> elements. 743*9dd622cdSAndre Fischer 744*9dd622cdSAndre Fischer=cut 745f219747dSAndre Fischersub CheckLanguageSet ($@) 746f219747dSAndre Fischer{ 747f219747dSAndre Fischer my ($context, @languages) = @_; 748f219747dSAndre Fischer my %configured_languages = map{$_=>1} split(/\s+/, $ENV{'WITH_LANG'}); 749f219747dSAndre Fischer 750f219747dSAndre Fischer my @missing_languages = (); 751f219747dSAndre Fischer my @present_languages = (); 752f219747dSAndre Fischer for my $language (@languages) 753f219747dSAndre Fischer { 754f219747dSAndre Fischer if (defined $configured_languages{$language}) 755f219747dSAndre Fischer { 756f219747dSAndre Fischer push @present_languages, $language; 757f219747dSAndre Fischer } 758f219747dSAndre Fischer else 759f219747dSAndre Fischer { 760f219747dSAndre Fischer push @missing_languages, $language; 761f219747dSAndre Fischer } 762f219747dSAndre Fischer } 763f219747dSAndre Fischer 764f219747dSAndre Fischer if (scalar @missing_languages > 0) 765f219747dSAndre Fischer { 766*9dd622cdSAndre Fischer my $message_head = $context->{'keep-going'} ? "WARNING" : "ERROR"; 767*9dd622cdSAndre Fischer printf STDERR "%s: there are languages that where not configured via --with-lang:\n", $message_head; 768*9dd622cdSAndre Fischer printf STDERR "%s: %s\n", $message_head, join(", ", @missing_languages); 769f219747dSAndre Fischer if ($context->{'keep-going'}) 770f219747dSAndre Fischer { 771f219747dSAndre Fischer printf " available languages:\n"; 772f219747dSAndre Fischer printf " %s\n", join(", ", @present_languages); 773f219747dSAndre Fischer } 774f219747dSAndre Fischer else 775f219747dSAndre Fischer { 776*9dd622cdSAndre Fischer printf STDERR "ERROR: please rerun configure with --with-lang=\"%s\"\n", join(" ", @languages); 777*9dd622cdSAndre Fischer exit(1); 778f219747dSAndre Fischer } 779f219747dSAndre Fischer } 780f219747dSAndre Fischer 781f219747dSAndre Fischer return @present_languages; 782f219747dSAndre Fischer} 783f219747dSAndre Fischer 784f219747dSAndre Fischer 785f219747dSAndre Fischer 786f219747dSAndre Fischer 787*9dd622cdSAndre Fischer=head2 WriteMakefile ($release_description, $context) 788*9dd622cdSAndre Fischer 789*9dd622cdSAndre Fischer Write a makefile with all targets that match the <build> elements. 790*9dd622cdSAndre Fischer 791*9dd622cdSAndre Fischer The use of a makefile allows us to use make to handle concurrent building. 792*9dd622cdSAndre Fischer 793*9dd622cdSAndre Fischer When an output file was specified on the command line (option -o) then the 794*9dd622cdSAndre Fischer makefile is written to that file but make is not run. 795*9dd622cdSAndre Fischer 796*9dd622cdSAndre Fischer When no output file was specified then the makefile is written to a temporary 797*9dd622cdSAndre Fischer file. Then make is run for this makefile. 798*9dd622cdSAndre Fischer 799*9dd622cdSAndre Fischer=cut 800f219747dSAndre Fischersub WriteMakefile ($$) 801f219747dSAndre Fischer{ 802*9dd622cdSAndre Fischer my ($release_description, $context) = @_; 803f219747dSAndre Fischer 804*9dd622cdSAndre Fischer my $filename = $context->{'output-filename'}; 805*9dd622cdSAndre Fischer if ( ! defined $filename) 806*9dd622cdSAndre Fischer { 807*9dd622cdSAndre Fischer $filename = File::Temp->new(); 808*9dd622cdSAndre Fischer } 809f219747dSAndre Fischer 810*9dd622cdSAndre Fischer # Collect the targets to make. 811*9dd622cdSAndre Fischer my @targets = (); 812*9dd622cdSAndre Fischer foreach my $build (@{$release_description->{'builds'}}) 813f219747dSAndre Fischer { 814*9dd622cdSAndre Fischer my $platform_descriptor = GetCurrentPlatformDescriptor($release_description); 815*9dd622cdSAndre Fischer my $package_descriptor = $release_description->{'packages'}->{$build->{'package-id'}}; 816*9dd622cdSAndre Fischer foreach my $language_id (@{$build->{'language-list'}}) 817f219747dSAndre Fischer { 818*9dd622cdSAndre Fischer foreach my $package_format (@{$platform_descriptor->{'package-types'}}) 819*9dd622cdSAndre Fischer { 820*9dd622cdSAndre Fischer my $full_target = sprintf("%s_%s.%s", 821*9dd622cdSAndre Fischer $package_descriptor->{'target'}, 822*9dd622cdSAndre Fischer $language_id, 823*9dd622cdSAndre Fischer $package_format); 824*9dd622cdSAndre Fischer if ($context->{'build-only-missing'}) 825*9dd622cdSAndre Fischer { 826*9dd622cdSAndre Fischer my $source_path = GetInstallationPackagePath( 827*9dd622cdSAndre Fischer $platform_descriptor, 828*9dd622cdSAndre Fischer $package_format, 829*9dd622cdSAndre Fischer $language_id); 830*9dd622cdSAndre Fischer my $archive_name = GetInstallationPackageName( 831*9dd622cdSAndre Fischer $release_description, 832*9dd622cdSAndre Fischer $package_descriptor, 833*9dd622cdSAndre Fischer $package_format, 834*9dd622cdSAndre Fischer $platform_descriptor, 835*9dd622cdSAndre Fischer $language_id); 836*9dd622cdSAndre Fischer my $candidate = $source_path . "/" . $archive_name; 837*9dd622cdSAndre Fischer if (-f $candidate) 838*9dd622cdSAndre Fischer { 839*9dd622cdSAndre Fischer printf "download set for %s already exists, skipping\n", $full_target; 840*9dd622cdSAndre Fischer next; 841*9dd622cdSAndre Fischer } 842*9dd622cdSAndre Fischer } 843*9dd622cdSAndre Fischer push @targets, $full_target; 844*9dd622cdSAndre Fischer } 845f219747dSAndre Fischer } 846f219747dSAndre Fischer } 847*9dd622cdSAndre Fischer 848*9dd622cdSAndre Fischer # Write the makefile. 849*9dd622cdSAndre Fischer open my $make, ">", $filename; 850*9dd622cdSAndre Fischer 851*9dd622cdSAndre Fischer # Write dependencies of 'all' on the products in all languages. 852*9dd622cdSAndre Fischer print $make "all .PHONY : \\\n "; 853*9dd622cdSAndre Fischer printf $make "%s\n", join(" \\\n ", @targets); 854f219747dSAndre Fischer printf $make "\n\n"; 855f219747dSAndre Fischer 856*9dd622cdSAndre Fischer if ($context->{'dry-run'}) 857*9dd622cdSAndre Fischer { 858*9dd622cdSAndre Fischer printf ("adding make fules for\n %s\n", join("\n ", @targets)); 859*9dd622cdSAndre Fischer } 860*9dd622cdSAndre Fischer 861f219747dSAndre Fischer # Write rules that chain dmake in instsetoo_native/util. 862*9dd622cdSAndre Fischer foreach my $target (@targets) 863*9dd622cdSAndre Fischer { 864*9dd622cdSAndre Fischer printf $make "%s :\n", $target; 865*9dd622cdSAndre Fischer printf $make "\tdmake \$@ release=t\n"; 866*9dd622cdSAndre Fischer } 867*9dd622cdSAndre Fischer close $make; 868*9dd622cdSAndre Fischer 869*9dd622cdSAndre Fischer 870*9dd622cdSAndre Fischer if ( ! defined $context->{'output-filename'}) 871f219747dSAndre Fischer { 872*9dd622cdSAndre Fischer # Caller wants us to run make. 873*9dd622cdSAndre Fischer my $path = $ENV{'SRC_ROOT'} . "/instsetoo_native/util"; 874*9dd622cdSAndre Fischer my $command = sprintf("make -f \"%s\" -C \"%s\" -j%d", 875*9dd622cdSAndre Fischer $filename, 876*9dd622cdSAndre Fischer $path, 877*9dd622cdSAndre Fischer $context->{'max-process-count'}); 878*9dd622cdSAndre Fischer if ($context->{'dry-run'}) 879f219747dSAndre Fischer { 880*9dd622cdSAndre Fischer printf "would run %s\n", $command; 881*9dd622cdSAndre Fischer } 882*9dd622cdSAndre Fischer else 883*9dd622cdSAndre Fischer { 884*9dd622cdSAndre Fischer printf "running %s\n", $command; 885*9dd622cdSAndre Fischer system($command); 886f219747dSAndre Fischer } 887f219747dSAndre Fischer } 888f219747dSAndre Fischer} 889f219747dSAndre Fischer 890f219747dSAndre Fischer 891f219747dSAndre Fischer 892f219747dSAndre Fischer 893f219747dSAndre Fischersub Upload ($$) 894f219747dSAndre Fischer{ 895f219747dSAndre Fischer my ($release_description, $context) = @_; 896f219747dSAndre Fischer 897f219747dSAndre Fischer if ( ! defined $context->{'upload-destination'}) 898f219747dSAndre Fischer { 899f219747dSAndre Fischer printf STDERR "ERROR: upload destination is missing\n"; 900f219747dSAndre Fischer PrintUsageAndExit(); 901f219747dSAndre Fischer } 902f219747dSAndre Fischer 903f219747dSAndre Fischer my @download_sets = CollectDownloadSets($release_description); 904*9dd622cdSAndre Fischer 905*9dd622cdSAndre Fischer ProvideChecksums($context, @download_sets); 906*9dd622cdSAndre Fischer my $source_path = PrepareUploadArea($context, @download_sets); 907*9dd622cdSAndre Fischer if ( ! defined $source_path) 908*9dd622cdSAndre Fischer { 909*9dd622cdSAndre Fischer exit(1); 910*9dd622cdSAndre Fischer } 911*9dd622cdSAndre Fischer if ( ! UploadFilesViaRsync($context, $source_path, @download_sets)) 912*9dd622cdSAndre Fischer { 913*9dd622cdSAndre Fischer exit(1); 914*9dd622cdSAndre Fischer } 915*9dd622cdSAndre Fischer} 916*9dd622cdSAndre Fischer 917*9dd622cdSAndre Fischer 918*9dd622cdSAndre Fischer 919*9dd622cdSAndre Fischer 920*9dd622cdSAndre Fischer=head2 PrepareUploadArea ($context, @download_sets) 921*9dd622cdSAndre Fischer 922*9dd622cdSAndre Fischer Create a temporary directory with the same sub directory strcuture that is requested in the upload location. 923*9dd622cdSAndre Fischer The files that are to be uploaded are not copied but linked into this temporary directory tree. 924*9dd622cdSAndre Fischer 925*9dd622cdSAndre Fischer Returns the name of the temporary directory. 926*9dd622cdSAndre Fischer 927*9dd622cdSAndre Fischer=cut 928*9dd622cdSAndre Fischersub PrepareUploadArea ($@) 929*9dd622cdSAndre Fischer{ 930*9dd622cdSAndre Fischer my ($context, @download_sets) = @_; 931*9dd622cdSAndre Fischer 932*9dd622cdSAndre Fischer my $tmpdir = File::Temp->newdir(); 933*9dd622cdSAndre Fischer foreach my $download_set (@download_sets) 934f219747dSAndre Fischer { 935*9dd622cdSAndre Fischer foreach my $extension ("", ".md5", ".sha256", ".asc") 936f219747dSAndre Fischer { 937*9dd622cdSAndre Fischer my $basename = sprintf("%s%s", $download_set->{'archive-name'}, $extension); 938*9dd622cdSAndre Fischer my $source = sprintf("%s/%s", $download_set->{'source-path'}, $basename); 939*9dd622cdSAndre Fischer my $target_path = sprintf("%s/%s/%s", $tmpdir, $download_set->{'destination-path'}); 940*9dd622cdSAndre Fischer my $target = sprintf("%s/%s", $target_path, $basename); 941*9dd622cdSAndre Fischer if ($context->{'dry-run'}) 942f219747dSAndre Fischer { 943*9dd622cdSAndre Fischer printf "would create link for %s\n", $basename; 944f219747dSAndre Fischer } 945*9dd622cdSAndre Fischer else 946f219747dSAndre Fischer { 947*9dd622cdSAndre Fischer mkpath($target_path); 948*9dd622cdSAndre Fischer unlink $target if ( -f $target); 949*9dd622cdSAndre Fischer my $result = symlink($source, $target); 950*9dd622cdSAndre Fischer if ($result != 1) 951f219747dSAndre Fischer { 952*9dd622cdSAndre Fischer printf "ERROR: can not created symbolic link to %s\n", $basename; 953*9dd622cdSAndre Fischer printf " %s\n", $source; 954*9dd622cdSAndre Fischer printf " -> %s\n", $target; 955*9dd622cdSAndre Fischer return undef; 956f219747dSAndre Fischer } 957f219747dSAndre Fischer } 958*9dd622cdSAndre Fischer } 959*9dd622cdSAndre Fischer } 960f219747dSAndre Fischer 961*9dd622cdSAndre Fischer return $tmpdir; 962*9dd622cdSAndre Fischer} 963f219747dSAndre Fischer 964*9dd622cdSAndre Fischer 965*9dd622cdSAndre Fischer 966*9dd622cdSAndre Fischer 967*9dd622cdSAndre Fischersub UploadFilesViaRsync ($$@) 968*9dd622cdSAndre Fischer{ 969*9dd622cdSAndre Fischer my ($context, $source_path, @download_sets) = @_; 970*9dd622cdSAndre Fischer 971*9dd622cdSAndre Fischer 972*9dd622cdSAndre Fischer # Collect the rsync flags. 973*9dd622cdSAndre Fischer my @rsync_options = ( 974*9dd622cdSAndre Fischer "-L", # Copy linked files 975*9dd622cdSAndre Fischer "-a", # Transfer the local attributes and modification times. 976*9dd622cdSAndre Fischer "-c", # Use checksums to compare source and destination files. 977*9dd622cdSAndre Fischer "--progress", # Show a progress indicator 978*9dd622cdSAndre Fischer "--partial", # Try to resume a previously failed upload 979*9dd622cdSAndre Fischer ); 980*9dd622cdSAndre Fischer 981*9dd622cdSAndre Fischer # (Optional) Add flags for upload to ssh server 982*9dd622cdSAndre Fischer my $upload_destination = $context->{'upload-destination'}; 983*9dd622cdSAndre Fischer if ($upload_destination =~ /@/) 984*9dd622cdSAndre Fischer { 985*9dd622cdSAndre Fischer push @rsync_options, ("-e", "ssh"); 986*9dd622cdSAndre Fischer } 987*9dd622cdSAndre Fischer 988*9dd622cdSAndre Fischer # Set up the rsync command. 989*9dd622cdSAndre Fischer my $command = sprintf("rsync %s \"%s/\" \"%s\"", 990*9dd622cdSAndre Fischer join(" ", @rsync_options), 991*9dd622cdSAndre Fischer $source_path, 992*9dd622cdSAndre Fischer $upload_destination); 993*9dd622cdSAndre Fischer printf "%s\n", $command; 994*9dd622cdSAndre Fischer 995*9dd622cdSAndre Fischer if ($context->{'dry-run'}) 996*9dd622cdSAndre Fischer { 997*9dd622cdSAndre Fischer printf "would run %s up to %d times\n", $command, $context->{'max-upload-count'}; 998*9dd622cdSAndre Fischer } 999*9dd622cdSAndre Fischer else 1000*9dd622cdSAndre Fischer { 1001*9dd622cdSAndre Fischer # Run the command. If it fails, repeat a number of times. 1002*9dd622cdSAndre Fischer my $max_run_count = $context->{'max-upload-count'}; 1003*9dd622cdSAndre Fischer for (my $run_index=1; $run_index<=$max_run_count && scalar @download_sets>0; ++$run_index) 1004*9dd622cdSAndre Fischer { 1005*9dd622cdSAndre Fischer my $result = system($command); 1006*9dd622cdSAndre Fischer printf "%d %d\n", $result, $?; 1007*9dd622cdSAndre Fischer return 1 if $result == 0; 1008f219747dSAndre Fischer } 1009*9dd622cdSAndre Fischer printf "ERROR: could not upload all files without error in %d runs\n", $max_run_count; 1010*9dd622cdSAndre Fischer return 0; 1011f219747dSAndre Fischer } 1012f219747dSAndre Fischer} 1013f219747dSAndre Fischer 1014f219747dSAndre Fischer 1015f219747dSAndre Fischer 1016f219747dSAndre Fischer 1017f219747dSAndre Fischersub CollectDownloadSets ($) 1018f219747dSAndre Fischer{ 1019f219747dSAndre Fischer my ($release_description) = @_; 1020f219747dSAndre Fischer 1021f219747dSAndre Fischer my @download_sets = (); 1022f219747dSAndre Fischer 1023*9dd622cdSAndre Fischer foreach my $platform_descriptor (values %{$release_description->{'platforms'}}) 1024f219747dSAndre Fischer { 1025*9dd622cdSAndre Fischer my $platform_path = sprintf("%s/instsetoo_native/%s", 1026*9dd622cdSAndre Fischer $ENV{'SOLARSRC'}, 1027*9dd622cdSAndre Fischer $platform_descriptor->{'id'}); 1028*9dd622cdSAndre Fischer if ( ! -d $platform_path) 1029*9dd622cdSAndre Fischer { 1030*9dd622cdSAndre Fischer printf "ignoring missing %s\n", $platform_path; 1031*9dd622cdSAndre Fischer next; 1032*9dd622cdSAndre Fischer } 1033*9dd622cdSAndre Fischer for my $package_descriptor (values %{$release_description->{'packages'}}) 1034f219747dSAndre Fischer { 1035*9dd622cdSAndre Fischer 1036*9dd622cdSAndre Fischer my @package_formats = @{$platform_descriptor->{'package-types'}}; 1037*9dd622cdSAndre Fischer for my $package_format (@package_formats) 1038f219747dSAndre Fischer { 1039*9dd622cdSAndre Fischer for my $language_id (@{$release_description->{'language-ids'}}) 1040f219747dSAndre Fischer { 1041*9dd622cdSAndre Fischer my $source_path = GetInstallationPackagePath( 1042*9dd622cdSAndre Fischer $platform_descriptor, 1043*9dd622cdSAndre Fischer $package_format, 1044*9dd622cdSAndre Fischer $language_id); 1045*9dd622cdSAndre Fischer my $archive_name = GetInstallationPackageName( 1046*9dd622cdSAndre Fischer $release_description, 1047*9dd622cdSAndre Fischer $package_descriptor, 1048*9dd622cdSAndre Fischer $package_format, 1049*9dd622cdSAndre Fischer $platform_descriptor, 1050*9dd622cdSAndre Fischer $language_id); 1051*9dd622cdSAndre Fischer my $candidate = $source_path."/".$archive_name; 1052*9dd622cdSAndre Fischer if ( ! -f $candidate) 1053*9dd622cdSAndre Fischer { 1054*9dd622cdSAndre Fischer# printf STDERR "ERROR: can not find download set '%s'\n", $candidate; 1055*9dd622cdSAndre Fischer next; 1056*9dd622cdSAndre Fischer } 1057*9dd622cdSAndre Fischer printf "adding %s\n", $archive_name; 1058*9dd622cdSAndre Fischer push @download_sets, { 1059*9dd622cdSAndre Fischer 'source-path' => $source_path, 1060*9dd622cdSAndre Fischer 'archive-name' => $archive_name, 1061*9dd622cdSAndre Fischer 'platform' => $platform_descriptor->{'pack-platform'}, 1062*9dd622cdSAndre Fischer 'destination-path' => sprintf("developer-snapshots/%s/%s", 1063*9dd622cdSAndre Fischer $release_description->{'name'}, 1064*9dd622cdSAndre Fischer $platform_descriptor->{'pack-platform'}) 1065*9dd622cdSAndre Fischer }; 1066f219747dSAndre Fischer } 1067f219747dSAndre Fischer } 1068f219747dSAndre Fischer } 1069f219747dSAndre Fischer } 1070f219747dSAndre Fischer 1071f219747dSAndre Fischer return @download_sets; 1072f219747dSAndre Fischer} 1073f219747dSAndre Fischer 1074f219747dSAndre Fischer 1075f219747dSAndre Fischer 1076f219747dSAndre Fischer 1077*9dd622cdSAndre Fischer=head2 ProvideChecksums ($context, @download_sets) 1078*9dd622cdSAndre Fischer 1079*9dd622cdSAndre Fischer Create checksums in MD5 and SHA256 format and a gpg signature for the given download set. 1080*9dd622cdSAndre Fischer The checksums are not created when they already exists and are not older than the download set. 1081*9dd622cdSAndre Fischer 1082*9dd622cdSAndre Fischer=cut 1083*9dd622cdSAndre Fischersub ProvideChecksums ($@) 1084f219747dSAndre Fischer{ 1085*9dd622cdSAndre Fischer my ($context, @download_sets) = @_; 1086*9dd622cdSAndre Fischer 1087*9dd622cdSAndre Fischer my @asc_requests = (); 1088*9dd622cdSAndre Fischer foreach my $download_set (@download_sets) 1089*9dd622cdSAndre Fischer { 1090*9dd622cdSAndre Fischer printf "%s\n", $download_set->{'archive-name'}; 1091*9dd622cdSAndre Fischer my $full_archive_name = $download_set->{'source-path'} . "/" . $download_set->{'archive-name'}; 1092*9dd622cdSAndre Fischer $full_archive_name = Trim(qx(cygpath -u "$full_archive_name")); 1093f219747dSAndre Fischer 1094*9dd622cdSAndre Fischer my $md5_filename = $full_archive_name . ".md5"; 1095*9dd622cdSAndre Fischer if ( ! -f $md5_filename || IsOlderThan($md5_filename, $full_archive_name)) 1096*9dd622cdSAndre Fischer { 1097*9dd622cdSAndre Fischer if ($context->{'dry-run'}) 1098*9dd622cdSAndre Fischer { 1099*9dd622cdSAndre Fischer printf " would create MD5\n"; 1100*9dd622cdSAndre Fischer } 1101*9dd622cdSAndre Fischer else 1102*9dd622cdSAndre Fischer { 1103*9dd622cdSAndre Fischer my $digest = Digest::MD5->new(); 1104*9dd622cdSAndre Fischer open my $in, $full_archive_name; 1105*9dd622cdSAndre Fischer $digest->addfile($in); 1106*9dd622cdSAndre Fischer my $checksum = $digest->hexdigest(); 1107*9dd622cdSAndre Fischer close $in; 1108f219747dSAndre Fischer 1109*9dd622cdSAndre Fischer open my $out, ">", $md5_filename; 1110*9dd622cdSAndre Fischer printf $out "%s *%s", $checksum, $download_set->{'archive-name'}; 1111*9dd622cdSAndre Fischer close $out; 1112f219747dSAndre Fischer 1113*9dd622cdSAndre Fischer printf " created MD5\n"; 1114*9dd622cdSAndre Fischer } 1115*9dd622cdSAndre Fischer } 1116*9dd622cdSAndre Fischer else 1117*9dd622cdSAndre Fischer { 1118*9dd622cdSAndre Fischer printf " MD5 already exists\n"; 1119*9dd622cdSAndre Fischer } 1120f219747dSAndre Fischer 1121*9dd622cdSAndre Fischer my $sha256_filename = $full_archive_name . ".sha256"; 1122*9dd622cdSAndre Fischer if ( ! -f $sha256_filename || IsOlderThan($sha256_filename, $full_archive_name)) 1123*9dd622cdSAndre Fischer { 1124*9dd622cdSAndre Fischer if ($context->{'dry-run'}) 1125*9dd622cdSAndre Fischer { 1126*9dd622cdSAndre Fischer printf " would create SHA256\n"; 1127*9dd622cdSAndre Fischer } 1128*9dd622cdSAndre Fischer else 1129*9dd622cdSAndre Fischer { 1130*9dd622cdSAndre Fischer my $digest = Digest::SHA->new("sha256"); 1131*9dd622cdSAndre Fischer open my $in, $full_archive_name; 1132*9dd622cdSAndre Fischer $digest->addfile($in); 1133*9dd622cdSAndre Fischer my $checksum = $digest->hexdigest(); 1134*9dd622cdSAndre Fischer close $in; 1135f219747dSAndre Fischer 1136*9dd622cdSAndre Fischer open my $out, ">", $sha256_filename; 1137*9dd622cdSAndre Fischer printf $out "%s *%s", $checksum, $download_set->{'archive-name'}; 1138*9dd622cdSAndre Fischer close $out; 1139f219747dSAndre Fischer 1140*9dd622cdSAndre Fischer printf " created SHA256\n"; 1141*9dd622cdSAndre Fischer } 1142*9dd622cdSAndre Fischer } 1143*9dd622cdSAndre Fischer else 1144*9dd622cdSAndre Fischer { 1145*9dd622cdSAndre Fischer printf " SHA256 already exists\n"; 1146*9dd622cdSAndre Fischer } 1147f219747dSAndre Fischer 1148*9dd622cdSAndre Fischer my $asc_filename = $full_archive_name . ".asc"; 1149*9dd622cdSAndre Fischer if ( ! -f $asc_filename || IsOlderThan($asc_filename, $full_archive_name)) 1150*9dd622cdSAndre Fischer { 1151*9dd622cdSAndre Fischer if ($context->{'dry-run'}) 1152*9dd622cdSAndre Fischer { 1153*9dd622cdSAndre Fischer printf " would create ASC\n"; 1154*9dd622cdSAndre Fischer } 1155*9dd622cdSAndre Fischer else 1156*9dd622cdSAndre Fischer { 1157*9dd622cdSAndre Fischer # gpg seems not to be able to sign more than one file at a time. 1158*9dd622cdSAndre Fischer # Password has to be provided every time. 1159*9dd622cdSAndre Fischer my $command = sprintf("gpg --armor --detach-sig \"%s\"", $full_archive_name); 1160*9dd622cdSAndre Fischer print $command; 1161*9dd622cdSAndre Fischer my $result = system($command); 1162*9dd622cdSAndre Fischer printf " created ASC\n"; 1163*9dd622cdSAndre Fischer } 1164*9dd622cdSAndre Fischer } 1165*9dd622cdSAndre Fischer else 1166*9dd622cdSAndre Fischer { 1167*9dd622cdSAndre Fischer printf " ASC already exists\n"; 1168*9dd622cdSAndre Fischer } 1169f219747dSAndre Fischer } 1170f219747dSAndre Fischer} 1171f219747dSAndre Fischer 1172f219747dSAndre Fischer 1173f219747dSAndre Fischer 1174f219747dSAndre Fischer 1175*9dd622cdSAndre Fischer=head2 IsOlderThan ($filename1, $filename2) 1176*9dd622cdSAndre Fischer 1177*9dd622cdSAndre Fischer Return true (1) if the last modification date of $filename1 is older than (<) that of $filename2. 1178*9dd622cdSAndre Fischer 1179*9dd622cdSAndre Fischer=cut 1180*9dd622cdSAndre Fischersub IsOlderThan ($$) 1181f219747dSAndre Fischer{ 1182*9dd622cdSAndre Fischer my ($filename1, $filename2) = @_; 1183*9dd622cdSAndre Fischer 1184*9dd622cdSAndre Fischer my @stat1 = stat $filename1; 1185*9dd622cdSAndre Fischer my @stat2 = stat $filename2; 1186*9dd622cdSAndre Fischer 1187*9dd622cdSAndre Fischer return $stat1[9] < $stat2[9]; 1188f219747dSAndre Fischer} 1189f219747dSAndre Fischer 1190f219747dSAndre Fischer 1191f219747dSAndre Fischer 1192f219747dSAndre Fischer 1193*9dd622cdSAndre Fischersub GetInstallationPackageName ($$$$$) 1194f219747dSAndre Fischer{ 1195*9dd622cdSAndre Fischer my ($release_description, $package_descriptor, $package_format, $platform_descriptor, $language) = @_; 1196*9dd622cdSAndre Fischer 1197*9dd622cdSAndre Fischer my $name = $package_descriptor->{'archive-name'}; 1198*9dd622cdSAndre Fischer 1199*9dd622cdSAndre Fischer my $archive_package_type = ""; 1200*9dd622cdSAndre Fischer if ($platform_descriptor->{'add-package-type-to-archive-name'} =~ /^(1|true|yes)$/i) 1201f219747dSAndre Fischer { 1202*9dd622cdSAndre Fischer $archive_package_type = "-".$package_format; 1203f219747dSAndre Fischer } 1204*9dd622cdSAndre Fischer 1205*9dd622cdSAndre Fischer $name =~ s/%V/$release_description->{'version'}/g; 1206*9dd622cdSAndre Fischer $name =~ s/%P/$platform_descriptor->{'archive-platform'}/g; 1207*9dd622cdSAndre Fischer $name =~ s/%T/$archive_package_type/g; 1208*9dd622cdSAndre Fischer $name =~ s/%L/$language/g; 1209*9dd622cdSAndre Fischer $name =~ s/%E/$platform_descriptor->{'extension'}/g; 1210*9dd622cdSAndre Fischer return $name; 1211*9dd622cdSAndre Fischer} 1212*9dd622cdSAndre Fischer 1213*9dd622cdSAndre Fischer 1214*9dd622cdSAndre Fischer 1215*9dd622cdSAndre Fischer 1216*9dd622cdSAndre Fischersub GetInstallationPackagePath ($$$) 1217*9dd622cdSAndre Fischer{ 1218*9dd622cdSAndre Fischer my ($product_descriptor, $package_format, $language) = @_; 1219*9dd622cdSAndre Fischer 1220*9dd622cdSAndre Fischer my $full_language = $language; 1221*9dd622cdSAndre Fischer if ($EnUSBasedLanguages{$language}) 1222f219747dSAndre Fischer { 1223*9dd622cdSAndre Fischer $full_language = "en-US_".$language; 1224f219747dSAndre Fischer } 1225*9dd622cdSAndre Fischer 1226*9dd622cdSAndre Fischer return sprintf("%s/instsetoo_native/%s/Apache_OpenOffice%s/%s/install/%s_download", 1227*9dd622cdSAndre Fischer $ENV{'SOLARSRC'}, 1228*9dd622cdSAndre Fischer $ENV{'INPATH'}, 1229*9dd622cdSAndre Fischer $product_descriptor->{'product-name-tail'}, 1230*9dd622cdSAndre Fischer $package_format, 1231*9dd622cdSAndre Fischer $full_language); 1232f219747dSAndre Fischer} 1233f219747dSAndre Fischer 1234f219747dSAndre Fischer 1235f219747dSAndre Fischer 1236f219747dSAndre Fischer 1237*9dd622cdSAndre Fischersub GetCurrentPlatformDescriptor ($) 1238f219747dSAndre Fischer{ 1239*9dd622cdSAndre Fischer my ($release_description) = @_; 1240*9dd622cdSAndre Fischer 1241*9dd622cdSAndre Fischer my $platform_descriptor = $release_description->{'platforms'}->{$ENV{'INPATH'}}; 1242*9dd622cdSAndre Fischer if ( ! defined $platform_descriptor) 1243f219747dSAndre Fischer { 1244*9dd622cdSAndre Fischer printf STDERR "ERROR: platform '%s' is not supported\n", $ENV{'INPATH'}; 1245f219747dSAndre Fischer } 1246*9dd622cdSAndre Fischer return $platform_descriptor; 1247f219747dSAndre Fischer} 1248f219747dSAndre Fischer 1249f219747dSAndre Fischer 1250f219747dSAndre Fischer 1251f219747dSAndre Fischer 1252f219747dSAndre Fischersub Wiki ($$) 1253f219747dSAndre Fischer{ 1254f219747dSAndre Fischer my ($release_descriptor, $context) = @_; 1255f219747dSAndre Fischer 1256f219747dSAndre Fischer open my $out, ">", $context->{'output-filename'}; 1257f219747dSAndre Fischer 1258f219747dSAndre Fischer my @table_list = GetTableList($release_descriptor); 1259f219747dSAndre Fischer foreach my $table_name (@table_list) 1260f219747dSAndre Fischer { 1261f219747dSAndre Fischer my @table_packages = GetPackagesForTable($release_descriptor, $table_name); 1262f219747dSAndre Fischer my @table_languages = GetLanguagesForTable($release_descriptor, @table_packages); 1263f219747dSAndre Fischer my @table_platforms = GetPlatformsForTable($release_descriptor, @table_packages); 1264f219747dSAndre Fischer 1265*9dd622cdSAndre Fischer printf "packages: %s\n", join(", ", map {$_->{'package'}->{'display-name'}} @table_packages); 1266f219747dSAndre Fischer printf "languages: %s\n", join(", ", map {$_->{'english-name'}} @table_languages); 1267f219747dSAndre Fischer printf "platforms: %s\n", join(", ", map {$_->{'id'}} @table_platforms); 1268f219747dSAndre Fischer 1269f219747dSAndre Fischer print $out "{| class=\"wikitable\"\n"; 1270*9dd622cdSAndre Fischer 1271*9dd622cdSAndre Fischer # Write the table head. 1272f219747dSAndre Fischer print $out "|-\n"; 1273f219747dSAndre Fischer print $out "! colspan=\"2\" | Language<br>The names do not refer to countries\n"; 1274f219747dSAndre Fischer print $out "! Type\n"; 1275f219747dSAndre Fischer foreach my $platform_descriptor (@table_platforms) 1276f219747dSAndre Fischer { 1277*9dd622cdSAndre Fischer foreach my $package_type (@{$platform_descriptor->{'package-types'}}) 1278*9dd622cdSAndre Fischer { 1279*9dd622cdSAndre Fischer printf $out "! %s<br>%s bit<br>%s\n", 1280f219747dSAndre Fischer $platform_descriptor->{'display-name'}, 1281f219747dSAndre Fischer $platform_descriptor->{'word-size'}, 1282*9dd622cdSAndre Fischer uc($package_type); 1283*9dd622cdSAndre Fischer } 1284f219747dSAndre Fischer } 1285f219747dSAndre Fischer 1286f219747dSAndre Fischer foreach my $language_descriptor (@table_languages) 1287f219747dSAndre Fischer { 1288f219747dSAndre Fischer if ($context->{'check-links'}) 1289f219747dSAndre Fischer { 1290f219747dSAndre Fischer $| = 1; 1291*9dd622cdSAndre Fischer printf "%-5%s: ", $language_descriptor->{'id'}; 1292f219747dSAndre Fischer } 1293f219747dSAndre Fischer 1294f219747dSAndre Fischer print $out "|-\n"; 1295f219747dSAndre Fischer printf $out "| rowspan=\"%d\" | %s\n", scalar @table_packages, $language_descriptor->{'english-name'}; 1296f219747dSAndre Fischer printf $out "| rowspan=\"%d\" | %s\n", scalar @table_packages, $language_descriptor->{'local-name'}; 1297f219747dSAndre Fischer 1298f219747dSAndre Fischer my $is_first = 1; 1299*9dd622cdSAndre Fischer foreach my $wiki_package_descriptor (@table_packages) 1300f219747dSAndre Fischer { 1301*9dd622cdSAndre Fischer my $package_descriptor = $wiki_package_descriptor->{'package'}; 1302*9dd622cdSAndre Fischer 1303f219747dSAndre Fischer if ($is_first) 1304f219747dSAndre Fischer { 1305f219747dSAndre Fischer $is_first = 0; 1306f219747dSAndre Fischer } 1307f219747dSAndre Fischer else 1308f219747dSAndre Fischer { 1309f219747dSAndre Fischer printf $out "|-\n"; 1310f219747dSAndre Fischer } 1311f219747dSAndre Fischer 1312f219747dSAndre Fischer # Write the name of the package, e.g. Full Install or Langpack. 1313f219747dSAndre Fischer if (defined $package_descriptor->{'link-URL'}) 1314f219747dSAndre Fischer { 1315f219747dSAndre Fischer printf $out "| [%s %s]\n", 1316f219747dSAndre Fischer $package_descriptor->{'link-URL'}, 1317f219747dSAndre Fischer $package_descriptor->{'display-name'}; 1318f219747dSAndre Fischer } 1319f219747dSAndre Fischer else 1320f219747dSAndre Fischer { 1321f219747dSAndre Fischer printf $out "| %s\n", $package_descriptor->{'display-name'}; 1322f219747dSAndre Fischer } 1323f219747dSAndre Fischer 1324f219747dSAndre Fischer foreach my $platform_descriptor (@table_platforms) 1325f219747dSAndre Fischer { 1326*9dd622cdSAndre Fischer foreach my $package_type (@{$platform_descriptor->{'package-types'}}) 1327*9dd622cdSAndre Fischer { 1328*9dd622cdSAndre Fischer WriteDownloadLinks( 1329*9dd622cdSAndre Fischer $out, 1330*9dd622cdSAndre Fischer $release_descriptor, 1331*9dd622cdSAndre Fischer $context, 1332*9dd622cdSAndre Fischer $release_descriptor, 1333*9dd622cdSAndre Fischer $language_descriptor, 1334*9dd622cdSAndre Fischer $wiki_package_descriptor, 1335*9dd622cdSAndre Fischer $platform_descriptor, 1336*9dd622cdSAndre Fischer $package_type); 1337*9dd622cdSAndre Fischer } 1338f219747dSAndre Fischer } 1339f219747dSAndre Fischer } 1340f219747dSAndre Fischer 1341f219747dSAndre Fischer if ($context->{'check-links'}) 1342f219747dSAndre Fischer { 1343f219747dSAndre Fischer printf "\n"; 1344f219747dSAndre Fischer } 1345f219747dSAndre Fischer } 1346f219747dSAndre Fischer 1347f219747dSAndre Fischer print $out "|}\n"; 1348f219747dSAndre Fischer } 1349f219747dSAndre Fischer close $out; 1350f219747dSAndre Fischer} 1351f219747dSAndre Fischer 1352f219747dSAndre Fischer 1353f219747dSAndre Fischer 1354f219747dSAndre Fischer 1355f219747dSAndre Fischersub GetTableList ($) 1356f219747dSAndre Fischer{ 1357f219747dSAndre Fischer my ($release_descriptor) = @_; 1358f219747dSAndre Fischer 1359f219747dSAndre Fischer my %seen_table_names = (); 1360f219747dSAndre Fischer my @table_names = (); 1361*9dd622cdSAndre Fischer foreach my $wiki_package_descriptor (@{$release_descriptor->{'wiki-packages'}}) 1362f219747dSAndre Fischer { 1363*9dd622cdSAndre Fischer my $table_name = $wiki_package_descriptor->{'table'}; 1364f219747dSAndre Fischer if ( ! $seen_table_names{$table_name}) 1365f219747dSAndre Fischer { 1366f219747dSAndre Fischer push @table_names, $table_name; 1367f219747dSAndre Fischer $seen_table_names{$table_name} = 1; 1368f219747dSAndre Fischer } 1369f219747dSAndre Fischer } 1370f219747dSAndre Fischer return @table_names; 1371f219747dSAndre Fischer} 1372f219747dSAndre Fischer 1373f219747dSAndre Fischer 1374f219747dSAndre Fischer 1375f219747dSAndre Fischer 1376f219747dSAndre Fischersub GetPackagesForTable ($$) 1377f219747dSAndre Fischer{ 1378f219747dSAndre Fischer my ($release_descriptor, $table_name) = @_; 1379f219747dSAndre Fischer 1380f219747dSAndre Fischer my @packages = (); 1381*9dd622cdSAndre Fischer foreach my $wiki_package_descriptor (@{$release_descriptor->{'wiki-packages'}}) 1382f219747dSAndre Fischer { 1383*9dd622cdSAndre Fischer if ($wiki_package_descriptor->{'table'} eq $table_name) 1384f219747dSAndre Fischer { 1385*9dd622cdSAndre Fischer my $package_descriptor = $release_descriptor->{'packages'}->{ 1386*9dd622cdSAndre Fischer $wiki_package_descriptor->{'package-id'}}; 1387*9dd622cdSAndre Fischer $wiki_package_descriptor->{'package'} = $package_descriptor; 1388*9dd622cdSAndre Fischer push @packages, $wiki_package_descriptor; 1389f219747dSAndre Fischer } 1390f219747dSAndre Fischer } 1391f219747dSAndre Fischer return @packages; 1392f219747dSAndre Fischer} 1393f219747dSAndre Fischer 1394f219747dSAndre Fischer 1395f219747dSAndre Fischer 1396f219747dSAndre Fischer 1397f219747dSAndre Fischersub GetLanguagesForTable ($@) 1398f219747dSAndre Fischer{ 1399f219747dSAndre Fischer my ($release_descriptor, @packages) = @_; 1400f219747dSAndre Fischer 1401f219747dSAndre Fischer # Find the languages that are reference by at least one package. 1402f219747dSAndre Fischer my %matching_languages = (); 1403f219747dSAndre Fischer foreach my $package_descriptor (@packages) 1404f219747dSAndre Fischer { 1405f219747dSAndre Fischer foreach my $language_id (@{$package_descriptor->{'language-list'}}) 1406f219747dSAndre Fischer { 1407f219747dSAndre Fischer $matching_languages{$language_id} = 1; 1408f219747dSAndre Fischer } 1409f219747dSAndre Fischer } 1410f219747dSAndre Fischer 1411f219747dSAndre Fischer # Retrieve the language descriptors for the language ids. 1412f219747dSAndre Fischer my @matching_language_descriptors = (); 1413f219747dSAndre Fischer foreach my $language_id (@{$release_descriptor->{'language-ids'}}) 1414f219747dSAndre Fischer { 1415f219747dSAndre Fischer if (defined $matching_languages{$language_id}) 1416f219747dSAndre Fischer { 1417f219747dSAndre Fischer my $language_descriptor = $release_descriptor->{'languages'}->{$language_id}; 1418f219747dSAndre Fischer if (defined $language_descriptor) 1419f219747dSAndre Fischer { 1420f219747dSAndre Fischer push @matching_language_descriptors, $language_descriptor; 1421f219747dSAndre Fischer } 1422f219747dSAndre Fischer } 1423f219747dSAndre Fischer } 1424f219747dSAndre Fischer 1425f219747dSAndre Fischer return @matching_language_descriptors; 1426f219747dSAndre Fischer} 1427f219747dSAndre Fischer 1428f219747dSAndre Fischer 1429f219747dSAndre Fischer 1430f219747dSAndre Fischer 1431f219747dSAndre Fischersub GetPlatformsForTable ($@) 1432f219747dSAndre Fischer{ 1433f219747dSAndre Fischer my ($release_descriptor, @packages) = @_; 1434f219747dSAndre Fischer 1435f219747dSAndre Fischer # Find the platforms that are reference by at least one package. 1436f219747dSAndre Fischer my %matching_platform_ids = (); 1437f219747dSAndre Fischer foreach my $package_descriptor (@packages) 1438f219747dSAndre Fischer { 1439f219747dSAndre Fischer foreach my $platform_id (@{$package_descriptor->{'platform-list'}}) 1440f219747dSAndre Fischer { 1441f219747dSAndre Fischer $matching_platform_ids{$platform_id} = 1; 1442f219747dSAndre Fischer } 1443f219747dSAndre Fischer } 1444f219747dSAndre Fischer 1445f219747dSAndre Fischer # Retrieve the platform descriptors for the plaform ids. 1446f219747dSAndre Fischer my @matching_platform_descriptors = (); 1447f219747dSAndre Fischer foreach my $platform_id (@{$release_descriptor->{'platform-ids'}}) 1448f219747dSAndre Fischer { 1449f219747dSAndre Fischer if ($matching_platform_ids{$platform_id}) 1450f219747dSAndre Fischer { 1451*9dd622cdSAndre Fischer print $platform_id."\n"; 1452f219747dSAndre Fischer push @matching_platform_descriptors, $release_descriptor->{'platforms'}->{$platform_id}; 1453f219747dSAndre Fischer } 1454f219747dSAndre Fischer } 1455f219747dSAndre Fischer 1456f219747dSAndre Fischer return @matching_platform_descriptors; 1457f219747dSAndre Fischer} 1458f219747dSAndre Fischer 1459f219747dSAndre Fischer 1460f219747dSAndre Fischer 1461f219747dSAndre Fischer 1462f219747dSAndre Fischermy $bold_text_start = "<b>"; 1463f219747dSAndre Fischermy $bold_text_end = "</b>"; 1464f219747dSAndre Fischermy $small_text_start = "<span style=\"font-size:80%\">"; 1465f219747dSAndre Fischermy $small_text_end = "</span>"; 1466f219747dSAndre Fischermy $broken_link_start = "<span style=\"color:#FF0000\">"; 1467f219747dSAndre Fischermy $broken_link_end = "</span>"; 1468f219747dSAndre Fischer 1469f219747dSAndre Fischer 1470*9dd622cdSAndre Fischersub WriteDownloadLinks ($$$$$$$) 1471f219747dSAndre Fischer{ 1472f219747dSAndre Fischer my ($out, 1473*9dd622cdSAndre Fischer $release_descriptor, 1474f219747dSAndre Fischer $context, 1475f219747dSAndre Fischer $release_descriptor, 1476f219747dSAndre Fischer $language_descriptor, 1477*9dd622cdSAndre Fischer $wiki_package_descriptor, 1478*9dd622cdSAndre Fischer $platform_descriptor, 1479*9dd622cdSAndre Fischer $package_type) = @_; 1480*9dd622cdSAndre Fischer 1481*9dd622cdSAndre Fischer my $package_descriptor = $wiki_package_descriptor->{'package'}; 1482f219747dSAndre Fischer 1483f219747dSAndre Fischer # Check if the current language and platform match the package. 1484*9dd622cdSAndre Fischer if (defined $wiki_package_descriptor->{'platforms'}->{$platform_descriptor->{'id'}} 1485*9dd622cdSAndre Fischer && defined $wiki_package_descriptor->{'languages'}->{$language_descriptor->{'id'}}) 1486f219747dSAndre Fischer { 1487f219747dSAndre Fischer my $archive_package_name = ""; 1488f219747dSAndre Fischer my $extension = $package_type; 1489f219747dSAndre Fischer if (defined $platform_descriptor->{'extension'}) 1490f219747dSAndre Fischer { 1491f219747dSAndre Fischer $extension = $platform_descriptor->{'extension'}; 1492f219747dSAndre Fischer } 1493f219747dSAndre Fischer if (defined $package_descriptor->{'download-extension'}) 1494f219747dSAndre Fischer { 1495f219747dSAndre Fischer $extension = $package_descriptor->{'download-extension'}; 1496f219747dSAndre Fischer } 1497f219747dSAndre Fischer $archive_package_name = "-".$package_type if ($package_type =~ /deb|rpm/); 1498*9dd622cdSAndre Fischer 1499*9dd622cdSAndre Fischer my $archive_name = GetInstallationPackageName( 1500*9dd622cdSAndre Fischer $release_descriptor, 1501*9dd622cdSAndre Fischer $package_descriptor, 1502*9dd622cdSAndre Fischer $package_type, 1503*9dd622cdSAndre Fischer $platform_descriptor, 1504*9dd622cdSAndre Fischer $language_descriptor->{'id'}); 1505*9dd622cdSAndre Fischer 1506*9dd622cdSAndre Fischer printf $out "| align=\"center\" | "; 1507*9dd622cdSAndre Fischer my $download = FindDownload( 1508*9dd622cdSAndre Fischer $context, 1509*9dd622cdSAndre Fischer $release_descriptor, 1510*9dd622cdSAndre Fischer $platform_descriptor, 1511*9dd622cdSAndre Fischer $package_type, 1512*9dd622cdSAndre Fischer $archive_name); 1513*9dd622cdSAndre Fischer if (defined $download) 1514*9dd622cdSAndre Fischer { 1515*9dd622cdSAndre Fischer my $url = $download->{'base-url'} . "/". $archive_name; 1516*9dd622cdSAndre Fischer printf $out "%s%s%s<br><br>%s%s %s<br>%s%s", 1517f219747dSAndre Fischer $bold_text_start, 1518f219747dSAndre Fischer CreateLink($url, $extension, $context), 1519f219747dSAndre Fischer $bold_text_end, 1520f219747dSAndre Fischer $small_text_start, 1521f219747dSAndre Fischer CreateLink($url.".asc", "ASC", $context), 1522f219747dSAndre Fischer CreateLink($url.".md5", "MD5", $context), 1523f219747dSAndre Fischer CreateLink($url.".sha256", "SHA256", $context), 1524f219747dSAndre Fischer $small_text_end; 1525*9dd622cdSAndre Fischer } 1526*9dd622cdSAndre Fischer printf $out "\n"; 1527f219747dSAndre Fischer } 1528f219747dSAndre Fischer else 1529f219747dSAndre Fischer { 1530f219747dSAndre Fischer printf $out "|\n"; 1531f219747dSAndre Fischer } 1532f219747dSAndre Fischer} 1533f219747dSAndre Fischer 1534f219747dSAndre Fischer 1535f219747dSAndre Fischer 1536f219747dSAndre Fischer 1537*9dd622cdSAndre Fischersub FindDownload ($$$$$) 1538*9dd622cdSAndre Fischer{ 1539*9dd622cdSAndre Fischer my ($context, 1540*9dd622cdSAndre Fischer $release_descriptor, 1541*9dd622cdSAndre Fischer $platform_descriptor, 1542*9dd622cdSAndre Fischer $package_type, 1543*9dd622cdSAndre Fischer $archive_name) = @_; 1544*9dd622cdSAndre Fischer 1545*9dd622cdSAndre Fischer foreach my $download (@{$release_descriptor->{'downloads'}}) 1546*9dd622cdSAndre Fischer { 1547*9dd622cdSAndre Fischer if ($download->{'platform-id'} eq $platform_descriptor->{'id'}) 1548*9dd622cdSAndre Fischer { 1549*9dd622cdSAndre Fischer my $url = $download->{'base-url'} . "/". $archive_name; 1550*9dd622cdSAndre Fischer if ($context->{'check-links'}) 1551*9dd622cdSAndre Fischer { 1552*9dd622cdSAndre Fischer if (CheckLink($url)) 1553*9dd622cdSAndre Fischer { 1554*9dd622cdSAndre Fischer # URL points to an existing file. 1555*9dd622cdSAndre Fischer printf "+"; 1556*9dd622cdSAndre Fischer return $download; 1557*9dd622cdSAndre Fischer } 1558*9dd622cdSAndre Fischer else 1559*9dd622cdSAndre Fischer { 1560*9dd622cdSAndre Fischer # URL is broken. 1561*9dd622cdSAndre Fischer # Try the next download area for the platform. 1562*9dd622cdSAndre Fischer next; 1563*9dd622cdSAndre Fischer } 1564*9dd622cdSAndre Fischer } 1565*9dd622cdSAndre Fischer else 1566*9dd622cdSAndre Fischer { 1567*9dd622cdSAndre Fischer # Use the URL unchecked. If there is more than one download area for the platform then only 1568*9dd622cdSAndre Fischer # the first is ever used. 1569*9dd622cdSAndre Fischer printf "."; 1570*9dd622cdSAndre Fischer return $download; 1571*9dd622cdSAndre Fischer } 1572*9dd622cdSAndre Fischer } 1573*9dd622cdSAndre Fischer } 1574*9dd622cdSAndre Fischer 1575*9dd622cdSAndre Fischer if ($context->{'check-links'}) 1576*9dd622cdSAndre Fischer { 1577*9dd622cdSAndre Fischer printf "-"; 1578*9dd622cdSAndre Fischer } 1579*9dd622cdSAndre Fischer 1580*9dd622cdSAndre Fischer return undef; 1581*9dd622cdSAndre Fischer} 1582*9dd622cdSAndre Fischer 1583*9dd622cdSAndre Fischer 1584*9dd622cdSAndre Fischer 1585*9dd622cdSAndre Fischer 1586f219747dSAndre Fischersub CreateLink ($$$) 1587f219747dSAndre Fischer{ 1588f219747dSAndre Fischer my ($url, $text, $context) = @_; 1589f219747dSAndre Fischer 1590f219747dSAndre Fischer my $is_link_broken = 0; 1591f219747dSAndre Fischer if ($context->{'check-links'}) 1592f219747dSAndre Fischer { 1593*9dd622cdSAndre Fischer if (CheckLink($url)) 1594*9dd622cdSAndre Fischer { 1595*9dd622cdSAndre Fischer $is_link_broken = 0; 1596*9dd622cdSAndre Fischer printf "+"; 1597*9dd622cdSAndre Fischer } 1598*9dd622cdSAndre Fischer else 1599*9dd622cdSAndre Fischer { 1600*9dd622cdSAndre Fischer $is_link_broken = 1; 1601*9dd622cdSAndre Fischer printf "-"; 1602*9dd622cdSAndre Fischer } 1603*9dd622cdSAndre Fischer } 1604*9dd622cdSAndre Fischer else 1605*9dd622cdSAndre Fischer { 1606f219747dSAndre Fischer printf "."; 1607f219747dSAndre Fischer } 1608f219747dSAndre Fischer 1609f219747dSAndre Fischer if ( ! $is_link_broken) 1610f219747dSAndre Fischer { 1611f219747dSAndre Fischer return sprintf ("[%s %s]", $url, $text); 1612f219747dSAndre Fischer } 1613f219747dSAndre Fischer elsif ($context->{'mark-broken-links'}) 1614f219747dSAndre Fischer { 1615f219747dSAndre Fischer return sprintf ("%sbroken%s[%s %s]", $broken_link_start, $broken_link_end, $url, $text); 1616f219747dSAndre Fischer } 1617f219747dSAndre Fischer else 1618f219747dSAndre Fischer { 1619f219747dSAndre Fischer return sprintf ("%s", $text); 1620f219747dSAndre Fischer } 1621f219747dSAndre Fischer} 1622f219747dSAndre Fischer 1623f219747dSAndre Fischer 1624f219747dSAndre Fischer 1625f219747dSAndre Fischer 1626*9dd622cdSAndre Fischer=head2 CheckLink ($url) 1627*9dd622cdSAndre Fischer 1628*9dd622cdSAndre Fischer Check if the file referenced by $url can be downloaded. 1629*9dd622cdSAndre Fischer This is determined by downloading only the header. 1630*9dd622cdSAndre Fischer 1631*9dd622cdSAndre Fischer=cut 1632*9dd622cdSAndre Fischermy $LastCheckedURL = undef; 1633*9dd622cdSAndre Fischermy $LastCheckedResult = undef; 1634*9dd622cdSAndre Fischersub CheckLink ($) 1635*9dd622cdSAndre Fischer{ 1636*9dd622cdSAndre Fischer my ($url) = @_; 1637*9dd622cdSAndre Fischer 1638*9dd622cdSAndre Fischer if ($url ne $LastCheckedURL) 1639*9dd622cdSAndre Fischer { 1640*9dd622cdSAndre Fischer my $head = LWP::Simple::head($url); 1641*9dd622cdSAndre Fischer $LastCheckedURL = $url; 1642*9dd622cdSAndre Fischer $LastCheckedResult = !!$head; 1643*9dd622cdSAndre Fischer } 1644*9dd622cdSAndre Fischer 1645*9dd622cdSAndre Fischer return $LastCheckedResult; 1646*9dd622cdSAndre Fischer} 1647*9dd622cdSAndre Fischer 1648*9dd622cdSAndre Fischer 1649*9dd622cdSAndre Fischer 1650*9dd622cdSAndre Fischer 1651*9dd622cdSAndre Fischersub SignFile ($$) 1652*9dd622cdSAndre Fischer{ 1653*9dd622cdSAndre Fischer my ($signature, $filename) = @_; 1654*9dd622cdSAndre Fischer 1655*9dd622cdSAndre Fischer my $command = sprintf( 1656*9dd622cdSAndre Fischer "gpg --armor --output %s.asc --detach-sig %s", 1657*9dd622cdSAndre Fischer $filename, 1658*9dd622cdSAndre Fischer $filename); 1659*9dd622cdSAndre Fischer} 1660*9dd622cdSAndre Fischer 1661*9dd622cdSAndre Fischer 1662*9dd622cdSAndre Fischer 1663*9dd622cdSAndre Fischer 1664f219747dSAndre Fischermy $context = ProcessCommandline(@ARGV); 1665f219747dSAndre Fischermy $release_description = ReadReleaseDescription($context->{'filename'}, $context); 1666f219747dSAndre Fischerif ($context->{'command'} eq "build") 1667f219747dSAndre Fischer{ 1668*9dd622cdSAndre Fischer WriteMakefile($release_description, $context); 1669f219747dSAndre Fischer} 1670f219747dSAndre Fischerelsif ($context->{'command'} eq "upload") 1671f219747dSAndre Fischer{ 1672f219747dSAndre Fischer Upload($release_description, $context); 1673f219747dSAndre Fischer} 1674f219747dSAndre Fischerelsif ($context->{'command'} eq "wiki") 1675f219747dSAndre Fischer{ 1676f219747dSAndre Fischer Wiki($release_description, $context); 1677f219747dSAndre Fischer} 1678