CPM.mac.xml

<?xml version="1.0" encoding="UTF-8"?>
<Export generator="Cache" version="25">
<Routine name="CPM" type="MAC" languagemode="0"><![CDATA[
#include CPM.License
#include %occInclude
#include CPM.LIB
#include CPM.DataTypes
#include CPM.SourceTypes

SHELL
    new
    #; here goes interactive entry
    #; aliases for commands
    try {
        do init
        for {
            write !,"CPM:"_$Namespace_">> "
            read line
            do ExtractArgs(.line, .command, .args)
            continue:command=""

            set command=$zconvert(command,"U")
            if $data(aliases(command),command)
            quit:command="QUIT"

            do batch1(command, args...)
        }
    }
    catch e {
        do BACK^%ETN
    }
    do fini
    quit

#; shell initialization code
init() {
    do RegisterAllSourceTypes()
    do ALIASES(.aliases)
    do $$$CpmInstance.Registry.Cache.Update()
    if '##class(CPM.Utils.Session).Lock() {
        ztrap "Can't lock CPM session global: "_$$$CpmSessionGlobal
    }
}

#; shell finalization code
fini() {
    do ##class(CPM.Utils.Session).Unlock()
    do ##class(CPM.Source.IBase).UnregisterExts()
}

#; register all known metainfo extensions
RegisterAllSourceTypes() {
    $$$RegisterAllExtensions
}

#include CPM.GetOptions

#; BEWARE - this entry point consume whole command-line
#;          and then tries to split it into command and arguments
BATCH(line)
    new (line)
    do ExtractArgs(.line, .command, .args)
    do batch1(command, args...)
    quit
    
error(sc) {
	write !,"Error occured: ", $$DisplayError^%apiOBJ(sc)
	quit 
}
#; actual batch entry-point with command and arguments given
batch1(command="help", args...)
    ; load aliases
    do ALIASES(.aliases)
    ; convert to upper case
    set command=$zconvert(command,"U")
    ; translate from alias to command (if it was alias)
    if $data(aliases(command),command)
    
    ; check we have appropriate tag entry COMMAND^CPM
    if $text(@command)="" {
        write !,"Unrecognized command: ",command,!
        quit
    }
    new sc
    ; call this COMMAND^CPM routine with arguments args...
    try {
        set @("sc = $$" _ command _ "(args...)")
        if $$$ISERR(sc) {
	        do error(sc)
        }
    } catch ex {
        do error(ex.AsStatus())
    }
    quit

ALIASES(aliases)
 ;QUIT;Q
 ;INSTALL;INS;I
 ;HELP;HLP;H;?
 ;LIST;LIS;LS;L
 ;EXPORT;EXP;EX;E
#; aliases for commands
    new (aliases)
    for i=1:1 {
        set line=$text(ALIASES+i)
        quit:$extract(line)'=" "
        set command=$zstrip($piece(line,";",2),"<>WCP")
        for j=3:1:$length(line,";") {
            set alias=$zconvert($piece(line,";",j),"U")
            continue:alias=""
            continue:$data(aliases(alias))
            set aliases(alias)=command
        }
    }
    quit

COMMANDS

INSTALL(args...) ;;install package
    new (args)
    #dim opts 
    #dim dryrun As %Boolean = 0
    #dim silent As %Boolean = 0
    #dim verbose As %Boolean = 0
    #dim sc As %Status = $$$OK
    set sc = $$GetOptions(.args, 
                          "/dryrun|/d", .dryrun,
                          "/s|/silent", .silent, "/verbose|/v", .verbose)
    if $$$ISERR(sc) { 
        quit sc 
    }
    #; FIXME - create special GetOptions version which will set opts{} directly
    set opts("dryrun") = $get(dryrun)
    set opts("silent") = $get(silent)
    set opts("verbose") = $get(verbose)
    do $$$CpmInstance.Install(.opts,args...)
    quit $$$OK

PACKAGE(args...) ;;package creation commands
    new (args)
    #dim debug As %Boolean = 0
    #dim create As %Boolean = 0
    #dim delete As %Boolean = 0
    #dim prjName As %String = ""
    #dim autoload As %Boolean = 0
    #dim pkgAuthor As %String = ""
    #dim pkgDescription As %String = ""
    #dim pkgLicense As %String = ""
    #dim pkgVersion As %String = ""
    #dim import As %String = ""
    
    #dim status As %Status = $$$OK
    set status = $$GetOptions(.args, 
                              "/debug", .debug,
                              "/c|/create", .create, "/delete", .delete,
                              "/prj:|/from:", .prjName, "/autoload", .autoload,
                              "/author:", .pkgAuthor, "/description:", .pkgDescription,
                              "/license:", .pkgLicense, "/version:", .pkgVersion,
                              "/i:|/import:", .import)
    if $$$ISERR(status) { 
        quit status 
    }

    #dim pkgName As %String = ""

    if create {
        set pkgName = $$PopArrValue(.args)
        set $$$CpmLastPkgName = pkgName
    }
    elseif delete {
        set pkgName = $$PopArrValue(.args)
        write !, "Deleting package definition: ", pkgName,!
        set status = ##class(CPM.Registry.Package).%DeleteId(pkgName)

        return status
    }
    elseif import '= "" {
        if (import = "all") {
	        set status = ##class(CPM.Registry.Package).ImportAll("intersystems-ru", 0) ; FIXME - hard-coded, not dry run
        } else {	        
        	write !, "Import from url: ", import,!
        	set status = ##class(CPM.Registry.Package).ImportFrom(import)
        }
        
        return status
    }
    else {
        set pkgName = $$$CpmLastPkgName
    }
    #dim p As CPM.Registry.Package = ##class(CPM.Registry.Package).CreateOrOpenId(pkgName)
    $$$THROWONERROR(status,$isobject(p))
    
#define SetIf(%val,%init) if %init'="" { set %val = %init }

    $$$SetIf(p.name,pkgName)
    $$$SetIf(p.author,pkgAuthor)
    $$$SetIf(p.description,pkgDescription)
    $$$SetIf(p.license,pkgLicense)
    $$$SetIf(p.version,pkgVersion)
    
    // link package to the project content
    if prjName '= "" {
        #dim prjExt As %String = $piece(prjName,".",*)
        // loading from preexisting Studio Project .PRJ
        if prjExt="prj" || (prjExt="PRJ") {
            do p.AddProjectItems(prjName)
        }
        // loading from barebone XML export file ("webterminal" mode)
        elseif prjExt="xml" || (prjExt="XML") {
            do p.AddXmlItems(prjName, autoload)
        }
        elseif ##class(%Library.File).DirectoryExists(prjName) {
            do p.AddDirectoryItems(prjName, autoload)
        }
    }
    if debug { zw p }

    do p.UsePackageJsonProps()

    set status = p.%Save()

    quit status
    
NormalizeVersion(version) {
    quit:'$data(version) "0.0.0"

    #dim list = $lfs(version, ".")
    
    // make sure we have >= 3 numbers in the version string
    if $ll(list) < 3 {
        if $ll(list) < 2 {
            set $li(list,2) = 0
        }
        set $li(list,3) = 0
    }

    quit $lts(list, ".")
}
IncreaseMinorVersion(version) {
    #dim list = $lfs(version, ".")
    set $li(list, *) = $li(list, *) + 1
    quit $lts(list, ".")
}

IncreaseMajorVersion(version) {
    #dim list = $lfs(version, ".")
    set $li(list, *-1) = $li(list, *-1) + 1
    quit $lts(list, ".")
}

EXPORT(args...) ;;prepare to publish - export package(s)
    new (args)
    #dim verbose As %Boolean = 0
    #dim minor As %Boolean = 0
    #dim major As %Boolean = 0
    #dim sc As %Status = $$$OK
    set sc = $$GetOptions(.args, "/v|/verbose", .verbose, 
                        "/minor", .minor, "/major", .major)
    if $$$ISERR(sc) { 
        quit sc 
    }

    for i=1:1:$get(args) {
        #dim packageName As %String = $get(args(i))
        continue:packageName=""
        
        #dim p As CPM.Registry.Package = ##class(CPM.Registry.Package).%OpenId(packageName)
        if $isobject(p) {
            // if we were ordered to increase version...
            if minor || major {
                #dim version As %String = p.version
                set version = $$NormalizeVersion(version)
                if minor {
                    set version = $$IncreaseMinorVersion(version)
                }
                elseif major {
                    set version = $$IncreaseMajorVersion(version)
                }
                set p.version = version
                write !,packageName, " version set to:  ", version,!
            }
            do p.Export(verbose)
            if p.%IsModified() {
                do p.%Save()
            }
        }
    }
    quit $$$OK

SEARCH(terms...) ;;search packages
    do $$$CpmInstance.Search(terms...)
    quit $$$OK

LIST(args...) ;;list of installed and available packages
    new (args)
    #dim verbose As %Boolean = 0
    #dim local As %Boolean = 1
    #dim remote As %Boolean = 0
    #dim sc As %Status = $$$OK
    set sc = $$GetOptions(.args, "/v|/verbose", .verbose, "/local", .local, "/remote", .remote)
    if $$$ISERR(sc) { 
        quit sc 
    }

    #dim sql As %SQL.Statement = ##class(%SQL.Statement).%New()
    #dim tSC As %Status = sql.%Prepare("SELECT %ID, Name, Version, Description FROM CPM_Registry.Package")
    if $$$ISERR(tSC) { quit tSC }

    #dim tRS As %SQL.StatementResult = sql.%Execute()
    while tRS.%Next() {
        write !?3,tRS.Name, ?32,tRS.Version, " ", ?41,tRS.Description
        if verbose {
            #dim o As CPM.Registry.Package = ##class(CPM.Registry.Package).%OpenId(tRS.ID)
            #dim items As list of %String = o.items
            #dim i As %Integer
            if $isobject(items) {
	            for i=1:1:items.Count() {
	                write !,?10,items.GetAt(i)
	            }
            }
            write !
        }
    }
    quit $$$OK

PURGE(args...) ;;purge all installed packages
    ;FIXME - do uninstall
    do ##class(CPM.Registry.Package).%DeleteExtent()
    quit $$$OK
    
CONFIG(args...) ;;get/set configuration parameters
    new (args)
    #dim debug As %Boolean = 0
    #dim getOp As %Boolean = 0
    #dim setOp As %Boolean = 0
    #dim sc As %Status = $$$OK
    set sc = $$GetOptions(.args, "/g|/get", .getOp, "/s|/set", .setOp, "/debug", .debug)
    if $$$ISERR(sc) { 
        quit sc 
    }

    #dim nameParam As %String = ""
    #dim valueParam As %String = ""
    
    if getOp {
        set nameParam  = $$PopArrValue(.args)
        write !,nameParam, ?14, " = ", $property( $$$CpmConfig, nameParam)
    }
    if setOp {
        set nameParam  = $$PopArrValue(.args)
        set valueParam = $$PopArrValue(.args)
        set $property($$$CpmConfig, nameParam) = valueParam
        write !,nameParam, ?14, " = ", $property( $$$CpmConfig, nameParam)
    }
    if debug || ('getOp && 'setOp) {
        do $$$CpmConfig.DumpAll()
    }
    quit $$$OK

HELP(command="",args...) ;;this help
    new (command,args)
#if 0
    if command'="" {
        set cpm=##class(CPM.Main).%New()
        do cpm.Help(command,args...)
        quit $$$OK
    }
#else
    if command'="" {
        do BATCH(command_" /help")
        quit $$$OK
    }
#endif
    write !,"Caché Package Manager"
    write !!,"Available commands:"
    for i=1:1 {
        set line=$text(COMMANDS+i)
        quit:line=""

        continue:$zstrip($extract(line),"*WCP")=""
        set help=$piece(line,";;",2)
        continue:help=""
        set command=$zconvert($piece(line,"("),"L")
        write !?3,command,?15,help
    }
    write !?3,"quit",?15,"quit from shell"
    write !
    quit $$$OK
    

]]></Routine>
</Export>