installer/patch/ReleasesList.pm

#**************************************************************
#
#  Licensed to the Apache Software Foundation (ASF) under one
#  or more contributor license agreements.  See the NOTICE file
#  distributed with this work for additional information
#  regarding copyright ownership.  The ASF licenses this file
#  to you under the Apache License, Version 2.0 (the
#  "License"); you may not use this file except in compliance
#  with the License.  You may obtain a copy of the License at
#
#    http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing,
#  software distributed under the License is distributed on an
#  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
#  KIND, either express or implied.  See the License for the
#  specific language governing permissions and limitations
#  under the License.
#
#**************************************************************

package installer::patch::ReleasesList;

use XML::Parser;
use File::Spec;

use strict;

=head1 NAME

    package installer::patch::ReleasesList  -  Functions for accessing the instsetoo_native/data/releases.xml file

=cut


my $Instance = undef;

=head2 Instance()

    Return the singleton instance.

=cut
sub Instance()
{
    if ( ! defined $Instance)
    {
        $Instance = new installer::patch::ReleasesList(
            File::Spec->catfile($ENV{'SRC_ROOT'}, "instsetoo_native", "data", "releases.xml"));
    }
    return $Instance;
}


=head2 new($class, $filename)

    Internal constructor.  Don't call.

=cut
sub new ($$)
{
    my ($class, $filename) = @_;

    my $self = {
        'releases' => []
    };
    bless($self, $class);


    $self->Read($filename);


    return $self;
}


=head2 GetFirstChild ($node, $child_name)

    Internal function that returns the first child.  Use only when the
    first child is the (expected) only child in a list.

=cut
sub GetFirstChild ($$)
{
    my ($node, $child_name) = @_;

    if ( ! defined $node)
    {
        return undef;
    }
    else
    {
        my $value = $node->{$child_name};
        if (ref($value) eq 'ARRAY')
        {
            return $value->[0];
        }
        else
        {
            return $value;
        }
    }
}


=head2 GetText ($node)

    Internal function that returns the trimmed text content of a node.

=cut
sub GetText ($;$)
{
    my ($node, $default_text) = @_;

    if ( ! defined $node)
    {
        if (defined $default_text)
        {
            return $default_text;
        }
        else
        {
            return "";
        }
    }
    else
    {
        my $text = $node->{'__text__'};
        $text =~ s/(^\s+|\s+$)//g;
        return $text;
    }
}


sub GetAttribute ($$)
{
    my ($node, $attribute_name) = @_;

    my $attributes = $node->{'__attributes__'};
    if ( ! defined $attributes)
    {
        return undef;
    }
    else
    {
        return $attributes->{$attribute_name};
    }
}


sub PrintNode($$);

=head2 ReadDomTree ($filename)

    Read the dom tree for the XML in $filename.

    Note that
    a) this was initially written for another XML library that provided the dom tree directly.
    b) the dom tree creation is basic and simple but good enough for the current format.
       When the format should change substantially, then we may need a better parser.

=cut
sub ReadDomTree ($)
{
    my ($filename) = @_;

    my $root = {};
    my $data = {
        'current_node' => $root,
        'node_stack' => []
    };
    my $parser = new XML::Parser(
        'Handlers' => {
            'Start' => sub {HandleStartTag($data, @_)},
            'End' => sub{HandleEndTag($data, @_)},
            'Char' => sub{HandleText($data, @_)}
        });
    $parser->parsefile($filename);

#    PrintNode("", $root);

    return $root;
}


=head HandleStartTag ($data, $expat, $element_name, @attributes)

    Callback for start tags.

    A new hash is appended to the array that is referenced by the parent by $element_name.
    That means that when this function ends there the new hash can be referenced by
        my $parent = $data->{'node_stack'}->[-1];
        my $new_hash = $parent->{$element_name}->[-1];

    Note that, just like in other implementations of dom trees,
    $parent->{$element_name} is an array, even when there is only one
    element.

    The new hash is empty or contains the given @attributes as hash.
    When fully read (ie its end tag has been processed) then it can contain two special keys:
    __attributes__ for the attributes
    __text__ for the concatenated text parts

=cut
sub HandleStartTag ($$$@)
{
    my ($data, $expat, $element_name, @attributes) = @_;

    # Create new node with attributes.
    my $node = {'__attributes__' => {@attributes}};

    # Append it to the list of $element_name objects.
    my $current_node = $data->{'current_node'};
    $current_node->{$element_name} = [] unless defined $current_node->{$element_name};
    push @{$current_node->{$element_name}}, $node;

    # Make the new node the current node.
    push @{$data->{'node_stack'}}, $current_node;
    $data->{'current_node'} = $node;
}

=head HandleEndTag ($data, $expat, $element_name, @attributes)

    Callback for end tags.

=cut
sub HandleEndTag ($$$)
{
    my ($data, $expat, $element) = @_;

    # Restore the parent node as current node.
    $data->{'current_node'} = pop @{$data->{'node_stack'}};
}

=head2 HandleText ($data, $expat, $text)

    Callback for text.

    $text is appended to the __text__ member of the current node in
    the dom tree.

=cut
sub HandleText ($$$)
{
    my ($data, $expat, $text) = @_;
    if ($text !~ /^\s*$/)
    {
        $data->{'current_node'}->{'__text__'} .= $text;
    }
}


=head2 PrintNode ($indentation, $node)

    For debugging.
    Print $node recursively with initial $indentation.

=cut
sub PrintNode($$)
{
    my ($indentation, $node) = @_;

    if (defined $node->{'__attributes__'})
    {
        while (my ($name,$attribute) = each(%{$node->{'__attributes__'}}))
        {
            printf("    %s%s -> %s\n", $indentation, $name, $attribute);
        }
    }

    while (my ($key,$value) = each(%$node))
    {
        if ($key eq '__text__')
        {
            printf("%stext '%s'\n", $indentation, $value);
        }
        elsif ($key eq '__attributes__')
        {
            next;
        }
        elsif (ref($value) eq "ARRAY")
        {
            foreach my $item (@$value)
            {
                printf("%s%s {\n", $indentation, $key);
                PrintNode($indentation."    ", $item);
                printf("%s}\n", $indentation);
            }
        }
        else
        {
            printf("%s%s {\n", $indentation, $key);
            PrintNode($indentation."    ", $value);
            printf("%s}\n", $indentation);
        }
    }
}


=head2 Read($self, $filename)

    Read the releases.xml file as doctree and parse its content.

=cut
sub Read ($$)
{
    my ($self, $filename) = @_;

    my $document = ReadDomTree($filename);
    foreach my $release_node (@{$document->{'releases'}->[0]->{'release'}})
    {
        my $version_node = GetFirstChild($release_node, "version");
        my $version_major = GetText(GetFirstChild($version_node, "major"));
        my $version_minor = GetText(GetFirstChild($version_node, "minor"), "0");
        my $version_micro = GetText(GetFirstChild($version_node, "micro"), "0");
        my $version = sprintf("%d.%d.%d", $version_major, $version_minor, $version_micro);
        die "could not read version from releases.xml" if $version eq "";

        push @{$self->{'releases'}}, $version;

        my $download_node = GetFirstChild($release_node, "downloads");
        my $package_format = GetText(GetFirstChild($download_node, "package-format"));
        my $url_template = GetText(GetFirstChild($download_node, "url-template"));
        my $upgrade_code = GetText(GetFirstChild($download_node, "upgrade-code"));
        my $build_id = GetText(GetFirstChild($download_node, "build-id"));
        die "could not read package format from releases.xml" if $package_format eq "";

        $self->{$version}->{$package_format}->{'upgrade-code'} = $upgrade_code;
        $self->{$version}->{$package_format}->{'build-id'} = $build_id;
        $self->{$version}->{$package_format}->{'url-template'} = $url_template;

        my @languages = ();
        foreach my $item_node (@{$download_node->{'item'}})
        {
            my ($language, $download_data) = ParseDownloadData($item_node, $url_template);
            if (defined $download_data && defined $language)
            {
                push @languages, $language;
                $self->{$version}->{$package_format}->{$language} = $download_data;
            }
        }
        $self->{$version}->{$package_format}->{'languages'} = \@languages;
    }
}


=head2 ParseDownloadData ($item_node, $url_template)

    Parse the data for one set of download data (there is one per release and package format).

=cut
sub ParseDownloadData ($$)
{
    my ($item_node, $url_template) = @_;

    my $language = GetText(GetFirstChild($item_node, "language"));
    my $checksum_node = GetFirstChild($item_node, "checksum");
    if ( ! defined $checksum_node)
    {
        print STDERR "releases data file corrupt (item has no 'checksum' node)\n";
        return undef;
    }
    my $checksum_type = GetAttribute($checksum_node, "type");
    my $checksum_value = GetText($checksum_node);
    my $file_size = GetText(GetFirstChild($item_node, "size"));
    my $product_code = GetText(GetFirstChild($item_node, "product-code"));

    my $url = $url_template;
    $url =~ s/\%L/$language/g;
    return (
        $language,
        {
            'URL' => $url,
            'checksum-type' => $checksum_type,
            'checksum-value' => $checksum_value,
            'file-size' => $file_size,
            'product-code' => $product_code
        });
}


=head2 Write($self, $filename)

    Write the content of the releases data to a file named $filename.

=cut
sub Write ($$)
{
    my ($self, $filename) = @_;

    open my $out, ">", $filename || die "can not write releases data to ".$filename;
    $self->WriteHeader($out);
    $self->WriteContent($out);
    close $out;
}


=head2 WriteContent ($self, $out)

    Write the content of the releases.xml list.

=cut
sub WriteContent ($$)
{
    my ($self, $out) = @_;

    print $out "<releases>\n";
    # Write the data sets for each releases with the same sort order as @{$self->{'releases'}}
    foreach my $version (@{$self->{'releases'}})
    {
        print $out "  <release>\n";

        my @version_array = split(/\./, $version);
        printf $out "    <version>\n";
        printf $out "      <major>%s</major>\n", $version_array[0];
        printf $out "      <minor>%s</minor>\n", $version_array[1];
        printf $out "      <micro>%s</micro>\n", $version_array[2];
        printf $out "    </version>\n";

        # Write one download data set per package format.
        while (my ($package_format, $data) = each %{$self->{$version}})
        {
            print $out "    <download>\n";
            printf $out "      <package-format>%s</package-format>\n", $package_format;
            print $out "      <url-template>\n";
            printf $out "        %s\n", $data->{'url-template'};
            print $out "      </url-template>\n";
            printf $out "      <upgrade-code>%s</upgrade-code>\n", $data->{'upgrade-code'};
            printf $out "      <build-id>%s</build-id>\n", $data->{'build-id'};

            foreach my $language (@{$data->{'languages'}})
            {
                my $language_data = $data->{$language};
                print $out "      <item>\n";
                printf $out "        <language>%s</language>\n", $language;
                printf $out "        <checksum type=\"%s\">%s</checksum>\n",
                    $language_data->{'checksum-type'},
                    $language_data->{'checksum-value'};
                printf $out "        <size>%s</size>\n", $language_data->{'file-size'};
                printf $out "        <product-code>%s</product-code>\n", $language_data->{'product-code'};
                print $out "      </item>\n";
            }

            print $out "    </download>\n";
        }

        print $out "    </release>\n";
    }

    print $out "</releases>\n";
}


=head2 WriteHeader ($self, $out)

    Write the header for the releases.xml list.

=cut
sub WriteHeader ($$)
{
    my ($self, $out) = @_;

print $out <<EOT;
<?xml version='1.0' encoding='UTF-8'?>
<!--***********************************************************
 *
 * Licensed to the Apache Software Foundation (ASF) under one
 * or more contributor license agreements.  See the NOTICE file
 * distributed with this work for additional information
 * regarding copyright ownership.  The ASF licenses this file
 * to you under the Apache License, Version 2.0 (the
 * "License"); you may not use this file except in compliance
 * with the License.  You may obtain a copy of the License at
 *
 *   http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing,
 * software distributed under the License is distributed on an
 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
 * KIND, either express or implied.  See the License for the
 * specific language governing permissions and limitations
 * under the License.
 *
 ***********************************************************-->
EOT
}


=head2 GetPreviousVersion($version)

    Look up $version in the sorted list of released versions.  Return
    the previous element.  Whe $version is not found then return the
    last element (under the assumption that $version will be the next
    released version).

=cut
sub GetPreviousVersion ($)
{
    my ($current_version) = @_;

    my $release_data = installer::patch::ReleasesList::Instance();
    my $previous_version = undef;
    foreach my $version (@{$release_data->{'releases'}})
    {
        if ($version eq $current_version)
        {
            return $previous_version;
        }
        else
        {
            $previous_version = $version;
        }
    }

    return $previous_version;
}


1;