#
#    Copyright (C) 2010 Alexandros Stergiakis <alsterg@gmail.com>
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU Affero General Public License as
#    published by the Free Software Foundation, either version 3 of the
#    License, or (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU Affero General Public License for more details.
#
#    You should have received a copy of the GNU Affero General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

#//#
# The "pms" module enables Package Management System (PMS) operations. It supports the [http://www.opkg.org/ opkg] PMS.
#//#

module require base 1.0
module provide pms 1.0

package require uri 1.2.1

namespace eval ::module::pms {
namespace import ::helper::* ::module::api::*

# An order-sensitive list of tuples. Each tuple is a mapping of "name" => "url".
# Tuples are in order of configuration (first configured, first in the list).
variable Repositories

proc description {} {
    return "Package Management System"
}

proc version {} {
    exec opkg --version
}

proc check {} {
    if {[lempty [auto_execok opkg]]} {
        error "opkg is not installed"
    }
}

proc reset {} {
    Global TMP_DIR
    Module pms OPKG_FILE REP_DIR OVERLAY_ROOT_DIR
    
    file mkdir $REP_DIR $OVERLAY_ROOT_DIR
    fileutil::writeFile $OPKG_FILE \
"dest root /
dest ram $TMP_DIR
lists_dir ext $REP_DIR
option overlay_root $OVERLAY_ROOT_DIR
"

    variable Repositories {}
}

proc constructor {} {
    log::Info "Loading \"pms\" module: [description]"
    
    Global CONF_DIR
    parseconf pms [file join $CONF_DIR "pms.conf"]
    
    check

    reset

    # Finally load Command Specs
    sysconf loadspecs "modules/pms/pms.specs"
}

proc destructor {} {
    # First unload Command Specs
    sysconf remove "pms"
    
    reset
}

################
# Handlers
################

command ShPackageList {cmdline argstart sid out no arguments args} {
    Module pms OPKG_FILE
    OnError Error
    
    set type [dict get $arguments TYPE]
    
    switch -exact -- $type {
        "available" {
            exec opkg -f $OPKG_FILE list
        }
        "installed" {
            exec opkg -f $OPKG_FILE list-installed
        }
        "upgradable" {
            exec opkg -f $OPKG_FILE list-upgradable
        }
    }
}

command ShPackageInfo {cmdline argstart sid out no arguments args} {
    Module pms OPKG_FILE
    OnError Error
    
    if {[dict exists $arguments PACKAGE]} {
        exec opkg -f $OPKG_FILE info [dict get $arguments PACKAGE]
    } else {
        exec opkg -f $OPKG_FILE info
    }
}

command ShPackageStatus {cmdline argstart sid out no arguments args} {
    Module pms OPKG_FILE
    OnError Error
    
    if {[dict exists $arguments PACKAGE]} {
        exec opkg -f $OPKG_FILE status [dict get $arguments PACKAGE]
    } else {
        exec opkg -f $OPKG_FILE status
    }
}

command ShPackageFiles {cmdline argstart sid out no arguments args} {
    Module pms OPKG_FILE
    OnError Error
    exec opkg -f $OPKG_FILE files [dict get $arguments PACKAGE]
}

command UpdatePackages {cmdline argstart sid out no arguments args} {
    Module pms OPKG_FILE
    OnError Critical
    exec opkg -f $OPKG_FILE update
}

proc get_force_opts {arguments} {
    set opts [list]
    if {[dict exists $arguments force]} {
        foreach f [getall FORCE] {
            switch -exact -- $f {
                "depends" { lappend opts "--force-depends" }
                "maintainer" { lappend opts "--force-maintainer" }
                "reinstall" { lappend opts "--force-reinstall" }
                "overwrite" { lappend opts "--force-overwrite" }
                "downgrade" { lappend opts "--force-downgrade" }
                "space" { lappend opts "--force-space" }
                "removal" { lappend opts "--force-removal-of-dependent-packages" }
                "autoremove" { lappend opts "--force-autoremove" }
            }
        }
    }
    return $opts
}

command PackageUpgrade {cmdline argstart sid out no arguments args} {
    Module pms OPKG_FILE
    OnError Critical
    exec opkg -f $OPKG_FILE {*}[get_force_opts $arguments] upgrade
}

command PackageInstall {cmdline argstart sid out no arguments args} {
    Module pms OPKG_FILE
    OnError Critical
    exec opkg -f $OPKG_FILE {*}[get_force_opts $arguments] install [getall PACKAGE]
}

command PackageConfigure {cmdline argstart sid out no arguments args} {
    Module pms OPKG_FILE
    OnError Critical
    exec opkg -f $OPKG_FILE {*}[get_force_opts $arguments] configure [getall PACKAGE]
}

command PackageRemove {cmdline argstart sid out no arguments args} {
    Module pms OPKG_FILE
    OnError Critical
    exec opkg -f $OPKG_FILE {*}[get_force_opts $arguments] remove [getall PACKAGE]
}

command PackageFlag {cmdline argstart sid out no arguments args} {
    Module pms OPKG_FILE    
    exec opkg -f $OPKG_FILE {*}[get_force_opts $arguments] flag [dict get $arguments FLAG] [getall PACKAGE]
}

# @assume Supported URL types by opkg are only http and ftp.
command PackageRepository {cmdline argstart sid out no arguments args} {
    Module pms OPKG_FILE
    variable Repositories
    OnError Ignore
    
    set name [dict get $arguments NAME]
    if {[llength $name] != 1 || ! [string is alnum $name]} {
        ferror "not a valid name" [getpos NAME]
    }
    if {[lsearch -exact -index 0 $Repositories $name] >= 0} {
        ferror "name is already in use by a different repository" [getpos NAME]
    }
    
    set url [uri::canonicalize [dict get $arguments URL]]
    array set url_split [uri::split $url]
    if {$url_split(scheme) ni "http ftp"} {
        ferror "unsupported URL type" [getpos URL]
    }
    
    OnError Critical
    ::fileutil::appendToFile $OPKG_FILE "src/gz $name $url\n"
    lappend Repositories [list $name $url]
    return
}

proc print_pms_configuration {} {
    variable Repositories
    set result {}
    foreach e $Repositories {
        lassign $e name url
        append result "package repository $name $url\n"
    }
    
    if {! [lempty $result]} {
        set result "#\n${result}#\n"
    }
    
    return $result
}

} ;# End of Namespace