# ==================================================================
# Gossamer Links - enhanced directory management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   CVS Info : 087,071,086,086,085      
#   Revision : $Id: Update.pm,v 1.11 2009/05/08 19:56:50 brewt Exp $
# 
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
#

package Links::Update;
use strict;
use Links qw/$CFG $IN %STASH/;
use GT::Update qw/:severity/;
use GT::File::Tools qw/basename/;
use GT::Config;
use constant CACHE_TIMEOUT => 5*60; # Only check the server at most once every 5 minutes

sub _updater {
    $STASH{updates} ||= GT::Config->load("$CFG->{admin_root_path}/Links/Config/Updates.pm", { debug => $CFG->{debug_level} });
    return $STASH{updater} if $STASH{updater};
    (my $cgi_path = $CFG->{admin_root_path}) =~ s{[\\/]+admin[\\/]*$}//;
    $STASH{updater} = GT::Update->new(
        product => 'Links',
        version => $CFG->{version},
        reg_number => $CFG->{reg_number},
        init_path => $CFG->{admin_root_path},
        perl_path => $CFG->{path_to_perl},
        backup_path => "$CFG->{admin_root_path}/updates",
        paths => {
            script => {
                cgi => $cgi_path,
                admin => $CFG->{admin_root_path}
            },
            library => $CFG->{admin_root_path},
            template => $CFG->{admin_root_path} . '/templates',
            static => {
                static => $CFG->{build_static_path},
            },
            fixed => {
                static => $CFG->{build_static_path},
                cool => $CFG->{build_cool_path},
                detail => $CFG->{build_detail_path},
                new => $CFG->{build_new_path},
                ratings => $CFG->{build_ratings_path},
                build => $CFG->{build_root_path},
            },
            version => $CFG->{admin_root_path}
        },
        replacements => {
            library => {
                '' => {
                    'Links.pm' => {
                        '<%VERSION%>' => $CFG->{version}
                    }
                }
            }
        },
        installed => ($STASH{updates}->{installed} ||= {}),
        testing => $STASH{updates}->{testing}
    );
}

sub check {
    my $updater = _updater;
    my ($cached, @updates);
    if (my $cache = $STASH{updates}->{cache} and !$STASH{updates}->{testing}) {
        if ($cache->{version} == $GT::Update::VERSION and $cache->{time} > time - CACHE_TIMEOUT) { # Only check at most once every 5 minutes
            @updates = @{$cache->{updates}};
            $cached = 1;
        }
    }
    unless ($cached) {
        @updates = $updater->check;

        if (@updates == 1 and not defined $updates[0]) {
            my $error = $updater->error;
            my ($error_code, $error_message) = $error =~ /error code: (\d{3})\s*(.*)/;
            return { error => $error, update_error_code => $error_code, update_error_message => $error_message };
        }

        $STASH{updates}->{cache} = { time => time, version => $GT::Update::VERSION, updates => \@updates };
        $STASH{updates}->save;
    }

    my %ret;
    my %available = map { $_->id => $_ } @updates;
    for my $update (@updates) {
        my $id = $update->id;
        my $severity = $update->severity;
        my $update_type = $severity == CRITICAL ? 'critical' : $severity == RECOMMENDED ? 'recommended' : $severity == VERSION ? 'version' : 'optional';
        my $info = {
            id => $id,
            title => $update->title,
            description => \($update->description),
            severity => $severity,
            files => [$update->files],
            reversible => $update->reversible,
            unique => $update->unique,
            deps => [$update->deps],
            revdeps => [$update->revdeps],
            requires => [$update->requires],
            deps_first => $update->deps_first,
            update_type => $update_type,
            installed => $update->installed
        };
        push @{$ret{$update_type}}, $info;
        $ret{update}->{$id} = $info;
    }
    for (sort { $a <=> $b } keys %{$STASH{updates}->{installed}->{$CFG->{version}}}) {
        next if $available{$_};
        my %info = %{$STASH{updates}->{installed}->{$CFG->{version}}->{$_}};
        $info{id} = $_;
        my $severity = $info{severity};
        my $update_type = $severity == CRITICAL ? 'critical' : $severity == RECOMMENDED ? 'recommended' : $severity == VERSION ? 'version' : 'optional';
        push @{$ret{$update_type}}, \%info;
    }

    for (qw/critical recommended optional version/) {
        $ret{"${_}_total"} = @{$ret{$_} ||= []};
        $ret{"${_}_installed"} = $ret{"${_}_installable"} = 0;
        for my $update (@{$ret{$_}}) {
            next unless $available{$update->{id}};
            if ($available{$update->{id}}->{installed}) {
                $ret{"${_}_installed"}++;
            }
            elsif (!$available{$update->{id}}->{impossible}) {
                $ret{"${_}_installable"}++;
            }
        }
        push @{$ret{update_types}}, { update_type => $_, updates => $ret{$_} };
    }

    my @historic = sort { _numeric_version($a) <=> _numeric_version($b) } keys %{$STASH{updates}->{installed}};
    $ret{historic} = \@historic;

    \%ret;
}

sub check_historic {
    my $updater = _updater;
    my $version = shift || $CFG->{version};

    my @updates = $updater->check($version);
    my %ret = (historic_version => $version, current_version => $CFG->{version});

    for (@updates) {
        my @files = $_->files;
        my $severity = $_->severity;
        my $update_type = $severity == CRITICAL ? 'critical' : $severity == RECOMMENDED ? 'recommended' : $severity == VERSION ? 'version' : 'optional';
        my $id = $_->id;
        my %info = (
            id => $id,
            title => $_->title,
            description => \($_->description),
            severity => $severity,
            files => \@files,
            reversible => ($version eq $CFG->{version} ? $_->reversible : 0),
            unique => $_->unique,
            deps => [$_->deps],
            revdeps => [$_->revdeps],
            requires => [$_->requires],
            revdeps_first => $_->revdeps_first,
            update_type => $update_type,
            installed => $_->installed
        );
        push @{$ret{$update_type}}, \%info;
        $ret{update}->{$id} = \%info;
    }

    for (qw/critical recommended optional version/) {
        push @{$ret{update_types}}, { update_type => $_, updates => $ret{$_} };
    }

    my @historic = sort { _numeric_version($a) <=> _numeric_version($b) } grep keys %{$STASH{updates}->{installed}->{$_}}, keys %{$STASH{updates}->{installed}};
    $ret{historic} = \@historic;

    \%ret;
}

# Takes a version such as 1.3.7 and converts it to 1.0307.
sub _numeric_version {
    my @v = split /\./, (shift =~ /^(\d+(?:\.\d+)*)/)[0];
    my $numeric = 0;
    for (0 .. $#v) { $numeric += $v[$_] * 100**-$_ }
    $numeric;
}

sub browser_install {
    my @updates = $IN->param('install');
    my ($status, $errors) = install(@updates);
    if (!$status) {
        $errors->{updates_selected} = \@updates;
        return $errors;
    }
    my %ret = (update_success => 1, update_status => $status, updates_selected => []);

    if ($status == 2) {
        my $id = $errors;
        my $path;
        for (@{$STASH{updates}->{installed}->{$CFG->{version}}->{$updates[0]}->{files}}) {
            if (basename($_->{file}) eq 'install.cgi') {
                $path = $_->{file} . "?upgrade_choice=Yes;install_dir=" . $IN->escape($CFG->{admin_root_path});
                last;
            }
        }
        $ret{continue_url} = $path;
    }

    return \%ret;
}

# Installs updates passed in.  Returns (0, \%error_hash) on failure, 1 on
# success of normal updates, (2, $id) on the success of version upgrade files.
sub install {
    my @updates = @_;
    my $updater = _updater;
    my $v = $updater->verify(@updates);
    return 0, { %$v, update_failed => 1, verify_failed => 1 } if ref $v eq 'HASH';
    @updates = @$v;

    my $success = $updater->install_verified(@updates);
    if (!$success) {
        my $error = $updater->error;
        return 0, { update_failed => 1, error => "Update failed: $error" };
    }
    $STASH{updates}->{installed} = { $updater->installed };
    delete $STASH{updates}->{cache};
    $STASH{updates}->save;

    if (@updates == 1 and $STASH{updates}->{installed}->{$CFG->{version}}->{$updates[0]}->{severity} == VERSION) {
        # We just installed a version upgrade
        return (2, $updates[0]);
    }
    return 1;
}

sub browser_uninstall {
    my @updates = $IN->param('uninstall');
    my ($status, $errors) = uninstall(@updates);
    if (!$status) {
        $errors->{updates_selected} = \@updates;
        return $errors;
    }
    return { uninstall_success => 1, updates_selected => [] };
}

sub uninstall {
    my @updates = @_;
    my $updater = _updater;
    my $v = $updater->verify_uninstall(@updates);
    return { %$v, update_failed => 1, verify_failed => 1 } if ref $v eq 'HASH';
    @updates = @$v;

    my $success = $updater->uninstall_verified(@updates);
    if (!$success) {
        my $error = $updater->error;
        return 0, { uninstall_failed => 1, error => "Update uninstall failed: $error" };
    }
    $STASH{updates}->{installed} = { $updater->installed };
    delete $STASH{updates}->{cache};
    $STASH{updates}->save;

    return 1;
}

# Takes a string, such as '/foo/bar/blah/sdffffffddddddddddddddddddddddddddddd'
# and replaces a part of it with ...
# The arguments are:
#   - string
#   - number of characters before the ...
#   - number of characters after the ...
sub shorten {
    my ($string, $leading, $trailing) = @_;
    if (length($string) <= ($leading + $trailing + 3)) {
        return $string;
    }
    else {
        return substr($string, 0, $leading) . ' ... ' . substr($string, -$trailing);
    }
}

1;