#!/usr/bin/regina
/*
 vim:ts=4:noet:wrap:
 $Id: ppack,v 1.190 2002/03/13 01:05:32 rick Exp $
 * Rick Younie <younie@debian.org>
-+-
USAGE: ppack [options] arg
 -7         - new packages in the last 7 days
 -a [?]     - show anomalies (dupes in Packages, non-standard status...)
 -A [?]|T|V|E - P[A]ckages, s[T]atus, a[V]ailable, Sourc[E]s files -> pager
 -b arg     - view bugs by number, package name or maintainer
 -B[m] [pkg[_vers]] - get build logs for pkg | pkg_vers; m = m68k only
 -cl pkg    - view the changelog for an installed pkg
 -ch[fn]    - show changed packages.  Overwrite old list?: f=force, n=no
 -C[id]     - search Contents file; i=insensitive, d=directories too
 -d pkg     - show description (control stanza) for pkg
 -D/R pkg [max] - print Depends/Reverse-Depends for pkg to max. depth max
 -f pkg     - pull the archive directory for pkg into the browser, ? for usage
 -g         - pull incoming.debian.org into the browser
 -H pkg     - view the debian.org home page for pkg
 -i[lsq] pat - status of all packages in the Available file matching pat
 -ir pat    - nocase, partial match for pat against name or IRC nick at db.d.o
 -I[lsq] pat - show only the installed packages that match pat
 -If[q] val - show all installed packages that match val
 -l[lsvq] pat - show all packages in the Packages files that match pat
 -L[bq] pkg - list the files that make up pkg.  b urlifies -> browser
 -m[q] pat  - show packages belonging to the maintainer matching pat
              [pat: if any uppercase then case matters; else ignore case]
 -M         - pull New Maintainer page into browser
 -n[rsvq] pkg - show installed packages that need [+recommend +suggest] pkg
 -N[rsvq] pkg - packages in *Packages that need [+recommend +suggest] pkg
 -NS[q] pkg - packages in *Sources that build-depend on pkg
 -o[rsq]   - orphans -- no packages depend on [+recommend +suggest] these
 -O[q]     - the same as -ors
 -p[q] pat - show which packages provide the virtual package matching pat
              [pat: *pat (ends in), pat* (starts with), *pat* (contains)]
 -q[aceijpsu] -  various upload queues (auric, erlangen, samosa..) -> browser
 -r root   - add a root directory to dpkg/APT files; for chroot work
 -s[bn] pkg - print the source stanza for pkg; b brings up its archive dir
 -S pat    - show the (installed) packages that pat belongs to
 -t        - ajt's testing page
 -u [?]    - show packages that are newer than installed versions
 -U [?]    - shows all packages that are different than installed versions
 -v[n] v1 v2 - compare 2 Debian version numbers (n is numeric output)
 -y        - pull the PopCon stats and massage them a bit
 -Y        - show Popularity Contest home page

Modifiers:
 -l  - long: with -i,-I add descriptions; with -l, add versions
 -P  - pattern indicating which Packages files to use; '-P "?"' for usage
 -q  - quiet: print just the filename so the output is suitable for piping
 -s  - also sort by section for -l,-i,-I
 -# sec - timeout in seconds for socket routine in -y, -B
-*-
 */
	TRACE OFF
	SIGNAL ON HALT
	SIGNAL OFF ERROR
	SIGNAL ON FAILURE
	SIGNAL ON NOVALUE
	SIGNAL ON SYNTAX

/* -------------------------------------------------------------------
 *	constants
 */
	g.$tab		= '09'x
	g.$lf		= '0a'x
	g.$cr		= '0d'x
	g.$wipe		= g.$cr || '1b'x || '[K' || g.$cr

	main_archive = 'gluck.debian.org'	/* http.us.debian.org */
	globals		= 'g. opt. rootdir distpins main_archive packagesfiles'

	/* for version validity checking -- take it out of the loop */
	g.$alphanum = xrange('a','z') || xrange('A','Z') || xrange(0,9)
	g.$upstream = '-:.+'g.$alphanum
	g.$debian	= '.+'g.$alphanum

	default_browser = '/usr/bin/lynx'
	available	= '/var/lib/dpkg/available'
	dpkgdir		= '/var/lib/dpkg/info'
	statusfile	= '/var/lib/dpkg/status'

/* -------------------------------------------------------------------
 *
 */
MAIN:
	parse arg rgs
	if rgs = '-h' | rgs = '--help' then signal USAGE

	/* if different root, append new root to all data files */
	rootdir = ''
	if pos(' -r', ' 'rgs) <> 0 then do
		rgs = ' 'rgs
		parse var rgs pre ' -r' rootdir ' -' +0 post
		rgs = space(pre post)
		rootdir = strip(rootdir)

		root = '/usr/local/chroot'
		if rootdir = '?' then do
			call popen 'find 2>/dev/null' root'/ -type d -maxdepth 1',
				'-printf "%f\n"','ch.'
			say 'Directories (possibly chroots) at' root':'
			if ch.0 = 0 then say '   ..none'
			else do i = 1 to ch.0
				if ch.i = '' then iterate
				say '   'ch.i
			end
			exit 0
		end
		else if pos('/',rootdir) = 0 then do
			if rootdir = 'st' then rootdir = 'stable'
			else if rootdir = 'fr' then rootdir = 'frozen'
			else if rootdir = 'un' then rootdir = 'unstable'
			rootdir = root'/'rootdir
		end
	end

	available	= rootdir||available
	dpkgdir		= rootdir||dpkgdir
	statusfile	= rootdir||statusfile

	/* apt/lists changed location potato -> woody */
	packagesdir = rootdir'/var/lib/apt/lists/'
	if stream(packagesdir,'C','QUERY EXISTS') = '' then do
		packagesdir = rootdir'/var/state/apt/lists/'
		if stream(packagesdir,'C','QUERY EXISTS') = ''
			then call EX 1,'..no packages directory -- no chroot?'
	end

	/* ignore PPDIST if working in a chroot */
	distpins = ''
	/* command line has priority */
	if pos(' -P', ' 'rgs) <> 0 then do
		rgs = ' 'rgs
		parse var rgs pre ' -P' distpins ' -' +0 post
		rgs = space(pre post)
	end
	else if rootdir = '' then distpins  = value('PPDIST',,'SYSTEM')
	packagesfiles = SETPFILE('P',distpins)

	if pos(' -#', ' 'rgs) <> 0 then do
		rgs = ' 'rgs
		parse var rgs pre ' -#' timeout ' -' +0 post
		rgs = space(pre post)
	end
	if value('timeout') = 'TIMEOUT' then timeout = 60
	else if \datatype(timeout,'NUM') then timeout = 60

	/* ----------------------------------------------
	 *	handle environment variables
	 * ---------------------------------------------*/

	/* column env var set? */
	g.$columns = value('COLUMNS',,'SYSTEM')
	if \datatype(g.$columns,'NUM') then g.$columns = 80

	/* which pager? */
	pager = value('PAGER',,'SYSTEM')
	if pager = '' then pager = 'sensible-pager'

	/* set path to the external function directory */
	call value 'REGINA_MACROS', '/usr/lib/searchscripts','SYSTEM'

	if value('PPBROWSER',,'SYSTEM') <> ''
		then g.$browser = value('PPBROWSER',,'SYSTEM')
	else if value('SSBROWSER',,'SYSTEM') <> ''
		then g.$browser = value('SSBROWSER',,'SYSTEM')
	else do
		if value('DISPLAY',,'SYSTEM') <> ''
			then g.$browser = value('X11BROWSER',,'SYSTEM')
		else g.$browser = value('CONSOLEBROWSER',,'SYSTEM')
	end
	if g.$browser = '' then g.$browser = default_browser
	'type >/dev/null 2>&1' g.$browser
	if RC <> 0 then call EX 1,'..you will have to install lynx',
		'or set *BROWSER - please see man page'

	/* ----------------------------------------------
	 *	optional switch modifiers
	 * ---------------------------------------------*/

	parse var rgs '-' orig_opt val
	parse var orig_opt opt +1 mods
	opt. = 0
	mod = ''			/* -q pukes if modifier is LIT */
	do while mods <> ''
		parse var mods mod +1 mods
		select
			when mod = 'S' then opt.$sourceneedsme = 1
			when mod = 'b' then opt.$browselist = 1
			when mod = 'd' then opt.$directoriestoo = 1 /* Contents */
			when mod = 'f' then opt.$force = 1
			when mod = 'h' then opt.$changed_packages = 1
			when mod = 'i' then opt.$ignorecase = 1		/* Contents */
			when mod = 'l' then opt.$long = 1
			when mod = 'm' then opt.$m68k = 1
			when mod = 'n' then opt.$numeric_nowrite = 1
			when mod = 'q' then opt.$quiet = 1
			when mod = 'r' then opt.$rec = 1
			when mod = 's' then opt.$sug_sec = 1
			when mod = 'v' then opt.$virtual_vendor = 1

			/* mods for -q */
			when pos(mod,'aceijpsu') <> 0 then nop

			/* we use most letters now; this check doesn't make much sense */
			otherwise call EX 1,'..unknown modifier "'mod'" in -'orig_opt
		end
	end

	/* ----------------------------------------------
	 *	the switches
	 * ---------------------------------------------*/

	select
		/* ----------------------------------------
		 *	show dpkg/apt files in the pager
		 * ---------------------------------------*/

		when opt = 'A' | opt = 'E' then do
			/* if pattern is given on commandline, use it for packages */
			if val <> '' then packagesfiles = SETPFILE('A',val)
			if opt = 'E' then packagesfiles = changestr('Packages',packagesfiles,'Sources')
			'cat 2>/dev/null' packagesfiles '|'pager
		end
		when opt = 'T' then pager statusfile
		when opt = 'V' then pager available

		/* ----------------------------------------
		 * show some debian.org pages in the browser
		 * ---------------------------------------*/

		when opt = '7' then call DOBROWSER,
							'http://auric.debian.org/~tausq/newpkgs.html'
		when opt = 'b' then do
			do i = 1 to words(val)
				pkg = word(translate(word(val,i),' ','#_'),1)
				call DOBROWSER 'http://bugs.debian.org/'pkg
			end
		end
		when opt = 'c' then do
			if opt.$changed_packages then call CHANGED_PACKAGES val
			else if opt.$long then call LOCAL_CHANGELOG val
			else do i = 1 to words(val)
				pkg = word(val,i)
				call DOBROWSER 'http://master.debian.org/cgi-bin/' ||,
					'get-changelog?package='pkg
			end
		end
		when opt = 'g' then call DOBROWSER 'http://incoming.debian.org'
		when opt = 'H' then call DOBROWSER 'http://packages.debian.org/'val
		when opt = 'M' then call DOBROWSER 'http://nm.debian.org/nmlist.php'
		when opt = 'q' then do
			if mod = 'a' then call DOBROWSER ,
				'ftp://auric.debian.org/pub/UploadQueue'
			else if mod = 'c' then call DOBROWSER ,
				'ftp://ftp.chiark.greenend.org.uk/../queue/'
			else if mod = 'e' then call DOBROWSER ,
				'ftp://ftp.uni-erlangen.de/public/pub/Linux/debian/UploadQueue/'
			else if mod = 'j' then call DOBROWSER ,
				'ftp://master.debian.or.jp/pub/Incoming/upload'
			else if mod = 'i' then call DOBROWSER ,
				'ftp://ftp3.linux.it/pub/Linux/UploadQueue/'
			else if mod = 'p' then call DOBROWSER ,
				'ftp://non-us.debian.org/pub/UploadQueue/'
			else if mod = 's' then call DOBROWSER ,
				'ftp://samosa.debian.org/pub/UploadQueue/'
			else if mod = 'u' then call DOBROWSER ,
				'ftp://ftp.uk.debian.org/debian/UploadQueue/'
			else call EX 1,'..unknown modifier "'mod'"'
		end
		when opt = 't'
			then call DOBROWSER 'http://ftp-master.debian.org/testing/'
		when opt = 'w' then call DOBROWSER 'http://www.debian.org/devel/wnpp'

		/* ----------------------------------------
		 * end pager/browser
		 * ---------------------------------------*/

		when opt = 'a' then call ANOMALIES val
		when opt = 'd' then do
			do i = 1 to words(val)
				parse value word(val,i) with pkg '_'
				pkg = changestr('*', pkg, '.*')
				sedstring = '^Package:' pkg'$'
				'sed 2>/dev/null -n "/'sedstring'/,/^$/p"' packagesfiles
			end i
		end
		when opt = 'B' then do
			if val = '' then call BUILDLOGS
			else do i = 1 to words(val)
				call BUILDLOGS word(val,i)
			end
		end
		when opt = 'C' then call QUERYCONTENTS val
		when opt = 'D' | opt = 'R' then call DEP_TREE opt,val
		when opt = 'f' then call VIEWARCHIVE val
		when translate(opt) = 'I' then do
			if opt.$rec then call IRC_NICK val
			else do
				if opt = 'I' then do
					g.$onlyinstalled = 1
					if opt.$force then do
						statusfile = stream(val,'C','QUERY EXISTS')
						val = '*'
					end
				end
				else g.$onlyinstalled = 0
				call STATUS val
			end
		end
		when opt = 'l' then do
			if opt.$virtual_vendor then call LIST_BY_VENDOR val
			else call LISTSTATUS val
		end
		when opt = 'L' then call PKGLIST val
		when opt = 'm' then call MAINTAINER val
		when translate(opt) = 'N' then do
			if opt.$sourceneedsme then do
				do i = 1 to words(val)
					call SOURCENEEDSME word(val,i)
				end
			end
			else do
				/* only installed packages from status file */
				if opt = 'n' then do
					packagelist = statusfile
					opt.$installed = 1
				end

				/* all, from *Packages files */
				else do
					packagelist = packagesfiles
					opt.$installed = 0
				end
				do i = 1 to words(val)
					call NEEDSME word(val,i)
				end
			end
		end
		when translate(opt) = 'O' then do
			if opt = 'O' then do
				opt.$rec = 1
				opt.$sug_sec = 1
			end
			call NODEPS ''
		end
		when opt = 'p' then do
			do i = 1 to words(val)
				call PROVIDES word(val,i)
			end
		end
		when opt = 's' then do i = 1 to words(val)
			call GOSOURCE word(val,i)
		end
		when opt = 'S' then do
			if chdir(dpkgdir) <> 0
				then call EX 1,'..could not chdir to "'dpkgdir'"'

			do j = 1 to words(val)
				thisval = word(val, j)
				/* if an *, do exact match on other end */
				if pos('*',thisval) <> 0
					then thisval = changestr('*',thisval,'.*')
				'grep 2>/dev/null "'thisval'" *.list |sed "s/.list:/: /"'
			end j
		end
		when translate(opt) = 'U' then do
			if opt = 'U' then opt.$alldiff = 1
			call NEEDUPDATE val
		end
		when opt = 'v' then call VERSIONS val
		when translate(opt) = 'Y' then call POPCON opt
		otherwise call EX 1,'..unknown argument "'opt'"'
	end

	exit 0

/* -------------------------------------------------------------------
 * 
 */
BUILDLOGS: PROCEDURE EXPOSE (globals) timeout

	m68ksite = 'bruno.fmepnet.org'
	builddsite = 'buildd.debian.org'

	parse arg pkg_vers '.dsc'
	parse var pkg_vers pkg '_' vers

	if pkg_vers = '' then do
		if opt.$m68k then call DOBROWSER 'http://'m68ksite
		else call DOBROWSER 'http://'builddsite
		return
	end

	call popen 'tempfile -p ppack__ -d /tmp -s .html 2>/dev/null', 'tf.'
	if tf.0 <> 1 then call EX 1,'..could not create tempfile in /tmp'
	savefile = tf.1

	call lineout savefile, '<h3>'pkg_vers
	/* add bug URL ... */
	call lineout savefile,,
		'<a href="http://bugs.debian.org/'pkg'">[bug page]</a>'

	/* ... and source URL */
	opt.$forbugscan = 1		/* tell GOSOURCE to return a link */
	sourcelink = GOSOURCE(pkg)
	if sourcelink <> ''
		then call lineout savefile, '<a href="'sourcelink'">[source]</a>'
	call lineout savefile, '</h3>'

	if opt.$m68k then call DOM68K pkg_vers
	else call DOBUILDD pkg vers

	call DOBROWSER savefile
	'rm 2>/dev/null' savefile

	return

DOM68K: PROCEDURE EXPOSE (globals) timeout savefile m68ksite

	parse arg pkg_vers

	ret = GETPAGE(m68ksite,'/cgi/show_all_current_links?pkg='||,
		pkg_vers'&searchtype=[m68k]',timeout)

	parse var sockbuff '<ul>' +0 sockbuff '</ul>'

	if pos('<LI>',translate(sockbuff)) = 0
		then call lineout savefile, '  ..no hits'
	else call lineout savefile, sockbuff '</ul>'

	return

DOBUILDD: PROCEDURE EXPOSE (globals) timeout savefile builddsite

	parse arg pkg vers
	/* the bruno lookup handles epochs properly */
	if pos(':',vers) <> 0 then parse var vers ':' vers

	ret = GETPAGE(builddsite,'/build.php?arch=&pkg='pkg,timeout)

	parse var sockbuff '<ul>' sockbuff '</ul>'
	i = 0
	do while sockbuff <> ''
		parse var sockbuff '<li>' line '<li>' +0 sockbuff

		parse var line '>' dispvers arch '<' . '<a href="' url '">',
			date '<' . '<em>' status '<'
		if vers <> '' then do
			if pos(':',dispvers) <> 0 then parse var dispvers ':' compvers
			else compvers = dispvers
			if compvers <> vers then iterate
		end
		i = i + 1
		l.i = '<a href="http://'builddsite'/'url'">'dispvers'</a>' arch status
	end
	l.0 = i

	if l.0 = 0 then call lineout savefile, '  ..no hits'
	else do
		call lineout savefile, '<ul>'
		do i = l.0 to 1 by -1
			call lineout savefile, '<li>'l.i
		end
		call lineout savefile, '</ul>'
	end

	return

GETPAGE: PROCEDURE EXPOSE (globals) sockbuff

	msg = ''
	SIGNAL ON HALT NAME CTRL_3

	parse arg site,url,timeout,header,dots

	/* pull a page of hits */
	return = PULLPAGE(site, url, timeout, header, dots)
	parse var return errnum ',' sockbuff

	if errnum <> 0 then do
		if errnum = -3 then msg = '  ..no rxsock function library'
		else if errnum = -2 then msg = '  ..timeout'
		else if errnum = -1 then msg = '  ..CTRL-C'
		else if errnum > 0 then msg = '  ..socket error:' errnum
		else msg = errnum
	end

	return msg
CTRL_3:
	return '^C'

/* -------------------------------------------------------------------
 * pull up the source directory if pool
 */
QUERYCONTENTS: PROCEDURE EXPOSE (globals)

	parse arg val

	if val = '' then do
		call DOBROWSER 'http://www.debian.org/distrib/packages'
		return
	end

	if opt.$directoriestoo then dirstoo = 'yes'
	else dirstoo = 'no'
	if opt.$ignorecase then case = 'insensitive'
	else case = 'sensitive'

	arch = ''; distro = ''; tomatch = ''
	arches = ' i386 m68k alpha sparc powerpc arm '
	distros = ' stable testing unstable '
	do i = 1 to words(val)
		rg = word(val,i)
		select
			when pos(' 'rg' ',arches) <> 0 then arch = rg
			when pos(' 'rg' ',distros) <> 0 then distro = rg
			otherwise tomatch = rg
		end
	end

	if distro = '' then distro = 'unstable'
	if arch = '' then do
		arch = 'dpkg --print-architecture'()
		if pos(' 'arch' ',arches) = 0 then arch = 'i386'
	end

	call DOBROWSER 'http://packages.debian.org/cgi-bin/search_contents.pl?' ||,
		'word='tomatch'\&case='case'\&version='distro ||,
		'\&arch='arch'\&directories='dirstoo

	return

/* -------------------------------------------------------------------
 * show a local changelog
 */
LOCAL_CHANGELOG: PROCEDURE EXPOSE (globals) pager

	parse arg val
	changelogs = '/usr/share/doc/'val'/changelog.Debian.gz',
				'/usr/doc/'val'/changelog.Debian.gz',
				'/usr/share/doc/'val'/changelog.gz',
				'/usr/share/doc/'val'/changelog.gz'
	do i = 1 to words(changelogs)
		changelog = word(changelogs,i)
		if stream(changelog,'C','QUERY EXISTS') = '' then iterate
		'gzip -dc' changelog '|' pager
		leave i
	end i
	if i > words(changelogs) then say '..no changelog for "'val'"'
	return

/* -------------------------------------------------------------------
 *
 */
IRC_NICK: PROCEDURE EXPOSE (globals)

	parse arg pat
	pat = strip(pat,'B','*')

	'type >/dev/null 2>&1 ldapsearch'
	if RC <> 0 then call EX 1,'..ldapsearch is needed for this option;',
		'please install the ldap-utils package'

	searchcmd = 'ldapsearch -x -P 2 -b "ou=users,dc=debian,dc=org"',
		'-h db.debian.org "objectClass=debianDeveloper" uid cn sn ircnick'

	call popen searchcmd '|grep -i -B3 ircnick:','n.'
	nickwidth = 12; nick_addrwidth = 32
	ircnick='';cn='';sn='';uid=''
	do i = 1 to n.0
		parse var n.i tag ': ' val
		if tag = '--' then do
			out = ircnick
			addr = uid'@debian.org'
			if length(out) < nickwidth then out = left(out,nickwidth) addr
			else out = out addr
			if length(out) < nick_addrwidth
			  then out = left(out,nick_addrwidth) cn sn
			else out = out cn sn
			if pat = '' then say out
			else if pos(translate(pat),translate(out)) <> 0 then say out
		end
		call value(tag,val)
	end

    exit 0

/* -------------------------------------------------------------------
 * show deleted/added packages in new Packages files vs. saved list
 *
 */
CHANGED_PACKAGES: PROCEDURE EXPOSE (globals) packagesdir

	parse arg dists
	if dists = '' then call EX 1,'Usage: ppack -ch distro1 [distro2 ...]'

	packagesfiles = SETPFILE('a',dists)

	/* make save names; space, star -> underscore */
	oldgz = 'old_'translate(dists,,' *','_')'.gz'
	new   = 'new_'translate(dists,,' *','_')
	newgz = new'.gz'

	workdir = value('HOME',,'SYSTEM')'/.changed-pkgs'
	if stream(workdir'/','C','QUERY EXISTS') = '' then do
		'mkdir' workdir
		if RC <> 0 then call EX 1,'..could  not make' workdir
	end
	if chdir(workdir) <> 0 then call EX 1,'..could not chdir to' workdir

	opt.$quiet = 1
	ret = LISTSTATUS('*')
	if ret = 0 then do
		'LIFO> sort |uniq |grep -v "^$" | tee' new '|wc >LIFO'
		'gzip -f' new

		parse pull pkgs .
		indent = copies(' ',10)
		say indent dists'   'pkgs 'packages'
		say indent copies('=',length(dists))

		if stream(oldgz,'C','QUERY EXISTS') = '' then do
			say '..no old list so copying new->old for next time'
			'mv -f' newgz oldgz
		end
		else do
			'DIFFDIRS="diff -u" diffdirs' oldgz newgz,
				 '|tail +3 |grep "^[-+]" >LIFO'

			removed = '';added = ''
			q = queued()
			if q = 0 then say '..no changes'
			else if q > 500 then say '.. >500 diff so passing this time'
			else do
				do queued()
					parse pull line
					if abbrev(line,'+') then removed = removed substr(line,2)
					else if abbrev(line,'-') then added = added substr(line,2)
					else say '..unknown diff "'line'"'
				end

				opt.$quiet = 0
				call PRINTCHANGES 'added'
				call PRINTCHANGES 'removed'
			end

			if \opt.$numeric_nowrite then do
				if opt.$force then 'mv' newgz oldgz
				else do /* b/u -> old if not todays */
					timestamp_dash = word(stream(oldgz,'C','QUERY TIMESTAMP'),1)
					timestamp_std = changestr('-',timestamp_dash,'')
					/* convert standard -> base */
					timestamp_indays = date('B',timestamp_std,'S')
					if timestamp_indays <> date('B') then 'mv' newgz oldgz
					else 'rm' newgz
				end
			end
		end
	end

	return

PRINTCHANGES:

	parse arg type

	say '     'translate(type)
	say '     'copies('-',length(type))

	changed = value(type)
	if words(changed) = 0 then say '..none' type
	else if type = 'added' then call LISTSTATUS changed

	/* if removed, pack -l knows nothing about the pkg */
	else do i = 1 to words(changed)
		say word(changed,i)
	end

	return

/* -------------------------------------------------------------------
 * - walk the dependency/reverse dependency tree for a package
 *	 using apt-cache showpkg/depends; pretty slow, bit of a kludge.
 *	 apt-cache returns suggests as depends
 *
 *	 ppack pkg maxdepth (0 for no max)
 */
DEP_TREE: PROCEDURE EXPOSE (globals)

	parse arg opt,val

	lastwordno = words(val)
	if lastwordno = 0 then return

	if datatype(subword(val,lastwordno),'NUM') then do
		maxdepth = subword(val,lastwordno)
		pkgs = subword(val,1,lastwordno - 1)
	end
	else do
		pkgs = val
		maxdepth = 20
	end

	if opt = 'D' then do
		ac_pre = "apt-cache 2>&1 depends"
		ac_post = '|sed 2>/dev/null -n -e "s/^  Depends: //p"',
				'-n -e "/^W: /p" -n -e "/^E: /p" |sort |uniq'
		blurb = 'depends on:'
	end
	else do  /* reverse dep */
		ac_pre = "apt-cache 2>&1 showpkg"
		ac_post = '|sed 2>/dev/null -n -e "/^Reverse Depends:/,/^[^ ]/p"',
					'|sed 2>/dev/null -n -e "s/^  \(.*\),.*/\1/p" |sort |uniq'
		blurb = 'is depended on by:'
	end

	gotsave. = 0
	do i = 1 to words(pkgs)
		pkg = word(pkgs,i)
		seen. = 0
		depth = 0
		firstmax = 1
		call charout ,g.$lf || pkg blurb || g.$lf || copies('-',length(pkg))
		call GET_DEPENDS pkg,' |- ',0
		say
	end

	return

GET_DEPENDS: PROCEDURE EXPOSE (globals) ac_pre ac_post seen. depth,
			maxdepth firstmax save. gotsave.

	parse arg pkg,indent

	depth = depth + 1

	if \gotsave.pkg then do
		call popen ac_pre pkg ac_post, 'p.'
		/* cache it in case this one is needed again */
		do i = 0 to p.0
			save.pkg.i = p.i
		end
		gotsave.pkg = 1
	end

	do i = 1 to save.pkg.0
		next_dep = save.pkg.i
		if maxdepth > 0 then do /* infinite for 0 */
			if depth > maxdepth then do
				if firstmax then do
					call charout ,'  (*max depth' maxdepth 'reached*)'
					firstmax = 0
				end
				iterate i
			end
		end
		if depth = 1 then seen. = 0 /* start anew from root */
		call charout ,g.$lf || indent || next_dep
		select
			when next_dep = pkg then call charout ,' (*circular*)'
			when seen.next_dep then call charout ,' ..' /* been here before */
			when abbrev(next_dep,'<') then nop /* not found - may be virtual */
			when abbrev(next_dep,'W:') then nop /* pkg not found */
			when abbrev(next_dep,'E:') then nop
			otherwise do
				seen.next_dep = 1
				call GET_DEPENDS next_dep,indent' |- '
			end
		end
	end i
	depth = depth - 1

	return

/* -------------------------------------------------------------------
 * massage *.list and pull into browser
 */
PKGLIST: PROCEDURE EXPOSE (globals) statusfile rootdir

	parse arg val
	if val = '' then return

	infodir = rootdir'/var/lib/dpkg/info'

	if \opt.$browselist then do
		do i = 1 to words(val)
			pkg = word(val,i)
			fn = infodir'/'pkg'.list'
			if stream(fn, 'C', 'QUERY EXISTS') <> '' then do
				if \opt.$quiet then do
					say pkg':'
					indent = "|sed 's/^/  /'"
				end
				else indent = ''
				'cat' fn indent
			end
			else say '..no file list for "'pkg'"'
		end i
	end
	/* pull the package filelist into the browser */
	else do
		call popen 'tempfile -s .html', 't.'
		if t.0 <> 1 then call EX 1,'..could not create tempfile'
		tmpfile = t.1
		gothit = 0
		do i = 1 to words(val)
			pkg = word(val,i)
			fn = infodir'/'pkg'.list'
			call lineout tmpfile, '<BR><H2>'pkg':</H2>'
			if stream(fn, 'C', 'QUERY EXISTS') <> '' then do
				gothit = 1
				'cat' fn '>FIFO'
				do queued()
					parse pull dlink /* display link has no rootdir path */
					link = rootdir||dlink
					if directory(dlink) <> '' then dlink = dlink'/'
					call lineout tmpfile, '<BR><A HREF="'link'">'  dlink'</A>'
				end
				call lineout tmpfile, '<BR>--'
				'ls -1' infodir'/'pkg'.* >FIFO'
				do queued()
					parse pull link
					if rootdir <> '' then parse var link (rootdir) dlink
					else dlink = link
					call lineout tmpfile, '<BR><A HREF="'link'">'  dlink'</A>'
				end
				/* a shell append intermixes data */
				call lineout tmpfile, '<PRE><BR>--'
				'sed 2>/dev/null -n "/^Package: 'pkg'$/,/^$/p"',
					statusfile '>FIFO'
				do queued()
					parse pull link
					call lineout tmpfile, '<BR>'link
				end
			end
			else do
				call lineout tmpfile, '<PRE><BR>   ..no file list for "'pkg'"'
				call lineout tmpfile, '<BR>'
			end
			call lineout tmpfile, '</PRE>'
		end i
		if gothit then g.$browser tmpfile
		else say '..no file list for "'pkg'"'
		if g.$browser <> 'netscape' then 'rm 2>/dev/null' tmpfile
	end

	return

/* -------------------------------------------------------------------
 * pull up the source directory if pool
 */
GOSOURCE: PROCEDURE EXPOSE (globals) packagesdir packagesfiles

	sourcesfiles = changestr('Packages',packagesfiles,'Sources')

	parse arg pkg '_'	/* lose version, .dsc &c */
	if pkg = '' then call EX 1,'..no argument given'

	call popen 'grep 2>/dev/null -h "^Package: 'pkg'$"' sourcesfiles,'f.'
	if f.0 = 0 then do
		pat = changestr('+',pkg,'\\+') /* make egrep happy */
		call popen 'egrep 2>/dev/null -h -B1 "Binary:.* 'pat'(,|$)"' sourcesfiles,'f.'
		if f.0 = 0 then do
			if opt.$forbugscan then return ""
			else call EX 1,"..can't find source package for '"pkg"'"
			exit 0
		end
	end

	call popen "sed 2>/dev/null -n '/^"f.1"$/,/^$/p'" sourcesfiles, 'h.'

	/* show the stanza if not -sb -sn or -B */
	if \opt.$browselist & \opt.$forbugscan & \opt.$numeric_nowrite then do
		do i = 1 to h.0
			say h.i
		end
		return 0
	end
	/* else extract the pool url */
	else do dummy = 1
		do i = 1 to h.0
			if abbrev(h.i,'Directory:') then do
				parse var h.i 'Directory:' path .
				leave dummy
			end
		end
		call EX 1,'..could not extract the directory path for' pkg
	end

	if pos('/non-US/',path) <> 0 then site = 'non-us.debian.org'
	else site = main_archive'/debian'

	fullpath = 'http://'site'/'path

	/* a no-act; just print the path and return */
	if opt.$numeric_nowrite then do
		say fullpath
	end
	else do
		if opt.$forbugscan then return fullpath
		else call DOBROWSER fullpath
	end

	return

/* -------------------------------------------------------------------
 * pull up files list for an arch
 */
VIEWARCHIVE: PROCEDURE EXPOSE (globals)

	lf = g.$lf
	parse arg cline '_' .	/* remove any version/.dsc from last arg */
	if cline = '?' then do
		call PRINTBLOCK /*

USAGE:

- 'non-us' and the distro names can appear anywhere as they are
  removed first
- use non-us archive if given, else the main archive
- if an arch is given, it implies non-pool; stable is used if none given
  (arch = alpha, arm, ...)
- if distro is given (stable unstable testing frozen experimental),
  then any remaining arguments must be:
    - section: contrib, non-free, main (default main)
    - subsection: admin, base (default = the section directory)

        ppack -f stable base            -> stable/main/i386/base
        ppack -f contrib stable web     -> stable/contrib/i386/web
        ppack -f contrib alpha stable web -> stable/contrib/alpha/web
        ppack -f arm non-free sound     -> stable/non-free/arm/sound

    - if arch wasn't given (but distro was), get it with uname -m

- else pool if no distro is given.  Any remaining arguments are
  parsed like so:
    - if argument begins with libX... then libX/libX...
    - else first_letter_of_argument/argument

        ppack -f worker                 -> pool/main/w/worker
        ppack -f libdebconf-ruby        -> pool/main/libd/libdebconf-ruby/
        ppack -f non-us libpam-krb5     -> pool/non-US/main/libp/libpam-krb5/
        ppack -f contrib realplayer     -> pool/contrib/r/realplayer

 (this is too complicated -- if you have Sources files in sources.list,
  try "ppack -sb pkg" instead)
*/
		return
	end

	distros = 'stable unstable testing frozen experimental sid potato woody'
	dist = FIND_REMOVE_WORD(distros)

	nonus = FIND_REMOVE_WORD('non-us nonus')

	section = FIND_REMOVE_WORD('main contrib non-free')
	if section = '' then section = 'main'

	arches = 'alpha arm hppa hurd-i386 i386 ia64 m68k mips mipsel powerpc s390 sh sparc'
	arch = FIND_REMOVE_WORD(arches)
	if arch <> '' then if dist = '' then dist = 'stable'

	us_site = main_archive
	nonus_site = 'non-us.debian.org'
	if dist = 'experimental'
		then url = 'http://'us_site'/debian/project/experimental'
	else if dist = '' then do
		if nonus<>'' then site = 'http://'nonus_site'/pool/non-US'
		else site = 'http://'us_site'/debian/pool'

		if left(cline,3) = 'lib' then cline = left(cline,4)'/'cline
		else if length(cline) > 1 then cline = left(cline,1)'/'cline
		url = site'/'section'/'cline
	end
	else do
		if arch = '' then arch = 'dpkg --print-architecture'()
		if nonus<>'' then site = 'http://'nonus_site'/dists/'dist'/non-US'
		else site = 'http://'us_site'/debian/dists/'dist''
		cline = translate(space(cline),'/',' ')
		url = site'/'section'/binary-'arch'/'cline
	end

	if opt.$forbugscan then return url
	else call DOBROWSER url

	return

FIND_REMOVE_WORD: PROCEDURE EXPOSE (globals) cline

	parse arg searchwords

	foundword = ''
	do i = 1 to words(searchwords)
		searchword = word(searchwords,i)
		wp = wordpos(searchword,cline)
		if wp = 0 then iterate
		foundword = searchword
		cline = delword(cline,wp,1)
	end

	return foundword

PRINTBLOCK:
	j = 1
	do forever
		line = sourceline(SIGL + j)
		if line = '*/' then leave
		say line
		j = j + 1
	end
	return

/* -------------------------------------------------------------------
 * play with the Popularity Contest results
 */
POPCON: PROCEDURE EXPOSE (globals) pager sockbuff timeout

	site = 'people.debian.org'
	tarballpath = '/~apenwarr/popcon/all-popcon-results.txt.gz'
	homepage = 'http://'site'/~apenwarr/popcon/'

	/* if option was 'Y', pull up the popcon home page & ret */
	parse arg opt
	if pos('Y', opt) <> 0 then do
		call DOBROWSER homepage
		return 0
	end

	/* full path/name of this script - calling ourself later */
	parse source . . ppack

	ret = GETPAGE(site, tarballpath,timeout,,1)
	call charout ,g.$wipe
	if ret <> '' then call EX 1,ret

	/* save the buffer to a temp file */
	call popen 'tempfile -p ppack__ -d /tmp -s .gz 2>/dev/null', 'tf.'
	if tf.0 <> 1 then call EX 1,'..could not create tempfile in /tmp'
	savefile = tf.1

	call charout savefile, sockbuff
	call close savefile

	/* gunzip and queue it */
	'gzip 2>/dev/null -dc' savefile '>FIFO'
	'rm 2>/dev/null' savefile
	if RC <> 0 then call EX 1,'..could not download'g.$lf,
		'  http://'site || tarballpath

	i = 0
	do queued()
		parse pull pkg now.pkg old.pkg new.pkg .
		if pkg = '' then leave
		if now.pkg = 0 then iterate  /* few users, don't bother */
		current.pkg = now.pkg + new.pkg
		ratio.pkg = format(current.pkg/(current.pkg + old.pkg),1,2)
		i = i + 1
		pkg.i = pkg
	end
	pkg.0 = i

	do outer = 1
		say
		say ' Rightmost columns for 1,2 are Current, Old, Recent'
		say '   1. hot packages'
		say '   2. all (well, most) packages; highest Current+Recent first'
		say '   3. one line descriptions of hot packages'
		say '   4. show the description of a package'
		say '   5. Popularity Contest home page'
		say '     (q,x to quit, <ret> to reprint menu)'
		do inner = 1
			call charout ,'  > '
			pull ans
			select
				when ans = 'Q' | ans = 'X' then leave outer
				when ans = '1' then call DOHOT
				when ans = '2' then call DOALL
				when ans = '3' then call DOHOTONELINERS
				when ans = '4' then do
					call DOCONTROL
					leave inner
				end
				when ans = '5' then call DOBROWSER homepage
				when ans = '' then iterate outer
				otherwise iterate inner
			end
		end inner
	end outer

	if value('hotones') <> 'HOTONES' then 'rm 2>/dev/null' hotones

	return

DOCONTROL:

	do dummy = 1
		say '(q,x to return to Main)'
		do forever
			call charout ,'pattern?: '
			parse pull pat
			if translate(pat) = 'Q' | translate(pat) = 'X' then leave dummy
			else if pat = '' then iterate dummy
			else ppack '-d' pat '|' pager
		end
	end dummy

	return

DOHOTONELINERS:

	/* create the hotones file if it doesn't exist */
	if value('hotones') = 'HOTONES' then do
		/* make temp file */
		call popen 'tempfile -p pphot__ -d /tmp 2>/dev/null', 'tf.'
		if tf.0 <> 1 then call EX 1,'..could not create tempfile in /tmp'
		hotones = tf.1

		do i = 1 to pkg.0
			pkg = pkg.i
			if current.pkg > 9 & current.pkg < 100 then queue ratio.pkg pkg
		end

		'LIFO> cat |sort -nr | head -200 | cut -d" " -f2',
			'|xargs' ppack '-ls >'hotones
	end

	pager hotones

	return

DOHOT:

	do i = 1 to pkg.0
		pkg = pkg.i
		if current.pkg > 9 & current.pkg < 100 then queue ratio.pkg,
			left(pkg.i,30) left(now.pkg,4) left(old.pkg,4) left(new.pkg,4)
	end

	'LIFO> cat |sort -nr | head -400 |'pager

	return

DOALL:

	do i = 1 to pkg.0
		pkg = pkg.i
		queue now.pkg + new.pkg left(pkg.i,30) left(now.pkg,5),
			left(old.pkg,5) left(new.pkg,5)
	end

	'LIFO> cat |sort -nr |cut -d" " -f2- |'pager

	return

/* -------------------------------------------------------------------
 * show oddities in the status/Packages files
 */
ANOMALIES: PROCEDURE EXPOSE (globals) statusfile packagesdir

	parse arg val
	pfiles = SETPFILE('a',val)

	marker = '^Package:|^Status:|^Description:|^$'
	'egrep 2>/dev/null -h "'marker'"' statusfile '>FIFO'

	msg = "'Misconfigured' Packages"
	say msg; say copies('-',length(msg))

	misconfigured = 0
	status. = ''
	descr. = ''
	installed = ''
	do queued()
		parse pull line
		select
			when abbrev(line, 'Pa') then parse var line . pkg
			when abbrev(line, 'St') then parse var line . status.pkg
			when abbrev(line, 'De') then parse var line . descr.pkg
			otherwise do
				select
					when status.pkg = 'purge ok not-installed' then nop
					when right(status.pkg,12) = 'ok installed' then do
						installed = installed pkg
						if \abbrev(status.pkg, 'install') then call PRINTSTATUS
					end
					when status.pkg = 'deinstall ok not-installed' then nop
					otherwise call PRINTSTATUS
				end
			end
		end
	end
	if \misconfigured then say '  ..none'

	msg = 'Duplicate packages'
	say; say msg; say copies('-',length(msg))

	'egrep 2>/dev/null -h ^Package:' pfiles '|sort |uniq -c >FIFO'
	current. = 0; dupe = 0
	do queued()
		parse pull num . name
		current.name = 1
		if num = 1 then iterate
		say right(num,3) name
		dupe = 1
	end
	if \dupe then say '  ..none'

	msg = 'Installed debs not in the current Packages files'
	say; say msg; say copies('-',length(msg))
	j = 0
	do i = 1 to words(installed)
		pkg = word(installed,i)
		if current.pkg then iterate
		j = j + 1
		pkg.j = pkg
	end
	pkg.0 = j

	if pkg.0 = 0 then say '  ..none'
	else do
		sortstem = 'pkg.'
		call SORT
		do i = 1 to pkg.0
			pkg = pkg.i
			call PRINTDESCRIPTION2
		end
	end

	if value('USER',,'SYSTEM') = 'root' & rootdir = '' then do
		say g.$lf||copies('-',40)
		call charout 'stdout','"apt-get check" says..'
		call popen 'apt-get check','l.'
		if RC = 0 then say 'OK'
		else do
			say 'error:' RC
			do i = 3 to l.0
				say l.i
			end
		end
	end

	return

PRINTSTATUS:

	misconfigured = 1

	if opt.$quiet then say pkg
	else do
		if length(pkg) < 25 then say left(left(pkg,25) ||,
			status.pkg,g.$columns)
		else say left(pkg status.pkg,g.$columns)
	end

	return

/* */
PRINTDESCRIPTION2:

	if opt.$quiet then say pkg
	/* print description along with package name */
	else do
		if length(pkg) < 16 then say left(left(pkg,16) ||,
			descr.pkg,g.$columns)
		else say left(pkg descr.pkg,g.$columns)
	end
	return

/* -------------------------------------------------------------------
 * show the packages that need this one
 */
SOURCENEEDSME: PROCEDURE EXPOSE (globals) packagelist

	parse arg target

	if opt.$quiet then indent = ''
	else do
		say target':'
		indent = '  '
	end

	sourcesfiles = changestr('Packages',packagesfiles,'Sources')

	call popen "sed -e :a -e 's/"g.$tab"/ /; /,$/N; s/,\n/,/; ta'",
		sourcesfiles "|egrep 2>/dev/null -h '^Package:|^Build-Depends:'", 'h.'

	/* pull waits on stdin if queue is empty; should fix this though */
	a. = ''
	pkg = '-'	/* handle possible bogus Sources file */
	do i = 1 to h.0
		if abbrev(h.i,'P') then parse var h.i . pkg
		else if abbrev(h.i,'B') then do
			parse var h.i . builddepends
			do while builddepends <> ''
				parse var builddepends bdsection ',' builddepends
				testbdsection = translate(bdsection, ' ', '|,')
				if pos(' 'target' ',' 'testbdsection' ') <> 0 then do
					if bdsection = target then push pkg
					else push pkg '['strip(bdsection,'B')']'
				end
			end
		end
	end

	'LIFO> sort -u >FIFO'

	q = queued()
	if q = 0 then do
		if \opt.$quiet then say indent || '..no hits'
	end
	else do q
		parse pull pkg
		say indent || pkg
	end

	return

/* -------------------------------------------------------------------
 * show the packages that need this one
 */
NEEDSME: PROCEDURE EXPOSE (globals) packagelist

	parse arg target

	if opt.$quiet then indent = ''
	else do
		say target':'
		indent = '  '
	end
	target = changestr('+',target,'\\+')

	/* grep for the package's stanza & installed status, provides if desired */
	marker = '^Package: 'target'$'
	if opt.$installed then marker = marker'|^Status: '
	if opt.$virtual_vendor then marker = marker'|^Provides: '
	marker = marker'|^$'
	'egrep 2>/dev/null -h "'marker'"' packagelist,
		'|sed -n "/^Package/,/^$/p" >FIFO'

	q = queued()
	if q = 0 then do
		if \opt.$quiet then say indent || '..no hits'
		return
	end
	/* make a stanza of the first target hit */
	else do
		stanza = ''
		do queued()
			parse pull line
			if line = '' then leave
			stanza = stanza || line || g.$lf
		end
		/* discard further hits */
		do queued()
			pull junk
		end
	end

	/* if -n, bail if status says the package isn't installed */
	if opt.$installed then do
		if pos(' ok installed', stanza) = 0 then do
			if \opt.$quiet then say indent||'..not installed'
			return
		end
	end

	/* if -v, target now includes any packages it provides for */
	targets = target
	if opt.$virtual_vendor then do
		parse var stanza 'Provides:' provides (g.$lf)
		targets = targets translate(provides, '', ',')
	end
	targets = space(targets)

	/* grep for Depends &c on the targets */
	marker = '^Package: '
	do i = 1 to words(targets)
		targ = word(targets,i)
		targetmark = '.*[ |,]'targ'([ |(,]|$)'
		marker = marker'|Depends:'targetmark'|Pre-Depends:'targetmark
		if opt.$sug_sec then marker = marker'|^Suggests:'targetmark
		if opt.$rec then marker = marker'|^Recommends:'targetmark
	end i
	marker = marker'|^$'

	'egrep 2>/dev/null -h "'marker'"' packagelist,
		'|sed -n "/^Package:/,/^$/p" >FIFO'

	j = 0
	q = queued()
	do i = 1 to q
		parse pull line
		if \abbrev(line,'Pa') then iterate
		i = i + 1
		if i > q then leave
		parse pull line2
		if line2 <> '' then do
			j = j + 1
			hit.j = word(line,2)
		end
	end
	hit.0 = j

	if hit.0 <> 0 then do
		sortstem = 'hit.'
		call SORT

		lasthit = ''
		do i = 1 to hit.0
			if lasthit = hit.i then iterate
			say indent || hit.i
			lasthit = hit.i
		end
	end

	return

/* -------------------------------------------------------------------
 * which packages Provide the pattern matching the argument
 */
PROVIDES: PROCEDURE EXPOSE (globals)

	parse arg pattern
	if pattern = '' then return

	/* make the pattern used for tag string matching */
	stringpat = pattern
	if left(stringpat,1) <> '*' then stringpat = ' 'stringpat
	else stringpat = strip(stringpat,'L','*')
	if right(stringpat,1) <> '*' then stringpat = stringpat' '
	else stringpat = strip(stringpat,'T','*')
	pat = '^Package: |^Provides: |^$'

	call popen 'egrep 2>/dev/null -h "'pat'"' packagesfiles,
		'|egrep -B1 -h ^Provides: ', 'h.'

	/* extract the Provides tags and packages that do the providing */
	pstring = ' '		/* string of all provides tags */
	provides. = ''
	i = 1
	if h.0 > 0 then do dummy = 1
		if \abbrev(h.i,'Pa') then call ERX,
			'..either a Packages file is corrupt or the parsing is',
				'borked; please email author'
		pkg = word(h.i, 2)

		i = i + 1
		/* ptags is a string of tags that this package provides for */
		ptags = changestr(',', subword(h.i, 2), ' ')

		do j = 1 to words(ptags)
			tag = word(ptags,j)
			if wordpos(' 'tag' ',pstring) = 0
				then pstring = pstring || tag || ' '
			provides.tag = provides.tag || pkg || ' '
		end

		i = i + 2
		if i >= h.0 then leave dummy
	end dummy

	po = pos(stringpat,pstring)
	i = 0
	do while po <> 0
		st = lastpos(' ',pstring,po) + 1
		en = pos(' ',pstring,po + 1)
		/* this catches problems with '*' for pattern */
		if en = 0 then leave
		i = i + 1
		tag.i = substr(pstring,st,en-st)

		po = pos(stringpat,pstring,en)
	end
	tag.0 = i

	/* sort the virtual package names */
	sortstem = 'tag.'
	call SORT

	do j = 1 to tag.0
		tag = tag.j
		if \opt.$quiet then do
			say tag':'
			indent = '  '
		end
		else indent = ''

		do i = 1 to words(provides.tag)
			prov.i = word(provides.tag,i)
		end
		prov.0 = i - 1

		/* sort the packages that provide for the virtual package */
		sortstem = 'prov.'
		call SORT

		do i = 1 to prov.0
			say indent || prov.i
		end
	end j

	return

/* -------------------------------------------------------------------
 * find pattern in *Packages files and display one-liners by section
 *
 * opt.$long	- also print version; sort by section, then package
 * opt.$quiet	- only print package name; sort by package name
 * opt.$sug_sec - print sections too; sort by section, then package
 *
 * sections - string of section names
 * s.section.i - pkgs in that section, 1 to s.section.0
 *
 */
LISTSTATUS: PROCEDURE EXPOSE (globals)

	parse arg patterns
	if patterns = '' then return 1

	pat = '^Package:' changestr('*',word(patterns,1),'.*')'$'
	do i = 2 to words(patterns)
		pattern = word(patterns,i)
		pat = pat'|^Package:' changestr('*',pattern,'.*')'$'
	end i
	/* egrep needs +'s escaped */
	pat = changestr('+',pat,'\\+')
	marker = pat'|^Section: |^Version: |^Description: |^$'

	'egrep 2>/dev/null -h "'marker'"' packagesfiles,
		'|sed -n "/^Package/,/^$/p" >FIFO'

	q = queued()
	if q = 0 then do
		say '..no match'
		return 1
	end

	sections = ''
	vers. = ''
	descr. = ''
	s. = 0

	i = 0
	do dummy = 1
		i = i + 1
		if i > q then leave dummy

		parse pull type val
		if \abbrev(type,'Pa') then call ERX,
			'..either a *Packages file is corrupt or the parsing is',
				'borked; please email author'

		pkg = val

		sect = '??'
		do forever
			i = i + 1
			if i > q then leave dummy
			parse pull type val
			select
				when abbrev(type, 'Se') then do
					sect = val

					/* add package to its section stem */
					s.sect.0 = s.sect.0 + 1
					index = s.sect.0
					s.sect.index = pkg

					/* if a new section name, add to the list */
					if pos(' 'sect' ', sections) = 0
						then sections = sections sect' '
				end
				when abbrev(type, 'Ve') then do
					if vers.pkg = '' then vers.pkg = val
					else if COMPARE_VERSIONS(val,vers.pkg) = 1
						then vers.pkg = val
				end
				when abbrev(type, 'De') then descr.pkg = val
				/* prob. isn't nec. here but stable status file is missing
				   several Section: lines; so cover all bases */
				otherwise do
					/* if no section name (stable misses many) add one */
					if sect = '??' then do
						s.sect.0 = s.sect.0 + 1
						index = s.sect.0
						s.sect.index = pkg
						/* if a new section name, add to the list */
						if pos(' 'sect' ', sections) = 0
							then sections = sections sect' '
					end
					iterate dummy
				end
			end
		end /*forever */
	end dummy

	/* field widths for the print subroutine */
	field1 = 16
	field2 = field1 + 11

	lastpkg = ''
	if opt.$quiet then do
		do i = 1 to words(sections)
			section = word(sections,i)
			do j = 1 to s.section.0
				queue s.section.j
			end j
		end
		/* if called from CHANGED_PACKAGES, return hits in the pipe */
		if \opt.$changed_packages then 'LIFO> sort |uniq'
	end

	/* printing section names */
	else if opt.$sug_sec then do
		/* sort section names */
		call SORTSECTIONS

		do i = 1 to words(sections)
			section = word(sections,i)
			/* sort packages in this section */
			do j = 1 to s.section.0
				queue s.section.j
			end j

			q = queued()
			if q <> 0 then do
				if \opt.$quiet then say section ||,
					g.$lf || copies('-',length(section))

				'LIFO> sort >FIFO'
				do q
					parse pull pkg
					call PRINT_PKG_SECT_DESC2
				end
				if \opt.$quiet then say
			end
		end i
	end

	/* else not printing section names */
	else do
		do i = 1 to words(sections)
			section = word(sections,i)
			do j = 1 to s.section.0
				queue s.section.j
			end j
		end i

		if queued() > 0 then do
			'LIFO> sort >FIFO'
			do queued()
				parse pull pkg
				call PRINT_PKG_SECT_DESC2
			end
		end
	end

	return 0

PRINT_PKG_SECT_DESC2:

	if pkg = lastpkg then return
	else lastpkg = pkg

	if opt.$quiet then say pkg
	else do
		out = pkg
		if length(out) < field1 then out = left(out, field1)
		if opt.$long then do
			out = out vers.pkg
			if length(out) < field2 then out = left(out, field2)
		end
		out = out descr.pkg
		/* if out < 80 cols, length(,80) will pad w. spaces, so check */
		if length(out) <= g.$columns then say out
		else say left(out,g.$columns)
	end

	return

/* -------------------------------------------------------------------
 *
 */
LIST_BY_VENDOR: PROCEDURE EXPOSE (globals) packagesdir

	parse arg patterns
	if patterns = '' then return
	do while pos('_',patterns) <> 0
		parse var patterns st '_' ' ' en
		patterns = st en
	end
	patterns = strip(patterns)

	pat = '^Package:' changestr('*',word(patterns,1),'.*')'$'
	do i = 2 to words(patterns)
		pattern = word(patterns,i)
		pat = pat'|^Package:' changestr('*',pattern,'.*')'$'
	end i
	/* egrep needs +'s escaped */
	pat = changestr('+',pat,'\\+')
	marker = pat'|^Version: |^$'

	if chdir(packagesdir) <> 0
		then call EX 1,'..could not chdir to' packagesdir

	call popen 'ls -1' '*_Packages', 'pfile.'
	if pfile.0 = 0 then call EX 1,'..no Packages files in' packagesdir

	call popen 'tempfile', 't.'
	if t.0 <> 1 then call EX 1,'..could not create tempfile'
	tmpfile = t.1

	fw = 13
	field1 = 18		/* pkg */
	field2 = field1 + fw	/* + version */
	field3 = field2 + fw
	field4 = field3 + fw
	field5 = field4 + fw

	header = left('Package',field1) left('Version', fw) || left('Label',fw) ||,
				left('Archive',fw) || left('Component',fw)
	say header
	say copies('-',length(header))

	label. = 'n/a'
	archive. = 'n/a'
	component. = 'n/a'
	do i = 1 to pfile.0
		parse var pfile.i stem '_Packages'
		releasefile = stem'_Release'
		if stream(releasefile,'C','QUERY EXISTS') <> '' then do
			release = charin(releasefile,1,999)
			parse var release 'Label: ' label.stem (g.$lf)
			parse var release 'Archive: ' archive.stem (g.$lf)
			parse var release 'Component: ' component.stem (g.$lf)
		end

		'egrep 2>/dev/null -h "'marker'"' pfile.i,
			'|sed -n "/^Package/,/^$/p" >FIFO'

		q = queued()
		if q = 0 then iterate
		j = 0
		do dummy = 1
			j = j + 1
			if j > q then leave dummy
			parse pull 'Package: ' pkg
			j = j + 1
			if j > q then leave dummy
			parse pull 'Version: ' vers.pkg
			j = j + 1
			if j > q then leave dummy
			parse pull junk

			out = pkg
			if length(out) < field1 then out = left(out, field1)
			out = out vers.pkg
			if length(out) < field2 then out = left(out, field2)
			out = out label.stem
			if length(out) < field3 then out = left(out, field3)
			out = out archive.stem
			if length(out) < field4 then out = left(out, field4)
			out = out component.stem
			if length(out) < field5 then out = left(out, field5)
			if length(out) <= g.$columns then call lineout tmpfile, out
			else call lineout tmpfile, left(out,g.$columns)
		end
	end

	'sort <' tmpfile
	'rm' tmpfile

	return

/* -------------------------------------------------------------------
 * show installed status
 *
 * sections - string of section names
 * s.section.i - pkgs in that section, 1 to s.section.0
 *
 */
STATUS: PROCEDURE EXPOSE (globals) statusfile

	parse arg patterns
	if patterns = '' then return

	pat = '^Package:' changestr('*',word(patterns,1),'.*')'$'
	do i = 2 to words(patterns)
	   pattern = word(patterns,i)
	   pat = pat'|^Package:' changestr('*',pattern,'.*')'$'
	end i

	marker = pat'|^Status:|^Section:|^Version:|^Description:|^$'

	/* egrep needs +'s escaped */
	marker = changestr('+',marker,'\\+')

	'egrep 2>/dev/null -h "'marker'"' statusfile,
		'|sed -n "/^Package/,/^$/p" >FIFO'

	q = queued()
	if q = 0 then do
		say '..no match'
		return
	end

	installed. = 0	/* installed indicator of each package */
	sections = ' '	/* string of all section names with a package match */
	stat. = ''
	vers. = ''
	descr. = ''
	s. = 0		/* stem to allow variable section name in compound stem */

	i = 0		/* index through queued() */
	do dummy = 1
		/* extract package name from hits and save it */
		i = i + 1
		if i > q then leave dummy
		parse pull type val
		if \abbrev(type,'Pa') then call ERX,
			'..either a *Packages file is corrupt or the parsing is',
				'borked; please email author'
		pkg = val

		sect = '??' /* some stanzas have no section; start blank and check */
		/* parse the rest of this stanza */
		/*	might have Status, Section, Version, or ^$ */
		do forever
			i = i + 1
			if i > q then leave dummy
			parse pull type val

			select
				when abbrev(type, 'St') then do
					stat.pkg = val
					installed.pkg = (right(val,10) == ' installed')
				end
				when abbrev(type, 'Se') then do
					sect = val
					/* add package to its section stem */
					s.sect.0 = s.sect.0 + 1
					index = s.sect.0
					s.sect.index = pkg
					/* if a new section name, add to the list */
					if pos(' 'sect' ', sections) = 0
						then sections = sections sect' '
				end
				when abbrev(type, 'Ve') then vers.pkg = val
				when abbrev(type, 'De') then descr.pkg = val
				/* gotta be the blank line ending the stanza */
				otherwise do
					/* if no section name (stable misses many) add one */
					if sect = '??' then do
						s.sect.0 = s.sect.0 + 1
						index = s.sect.0
						s.sect.index = pkg
						/* if a new section name, add to the list */
						if pos(' 'sect' ', sections) = 0
							then sections = sections sect' '
					end
					iterate dummy
				end
			end
		end /*forever */
	end dummy

	/* field widths for the print subroutine */
	field1 = 16		/* pkg */
	if \g.$onlyinstalled then field1 = field1 + 3  /* for status + pkg */
	field2 = field1 + 11	/* + version */

	if opt.$quiet then do
		do i = 1 to words(sections)
			section = word(sections,i)
			do j = 1 to s.section.0
				pkg = s.section.j
				if \g.$onlyinstalled then queue pkg
				else if installed.pkg then queue pkg
			end j
		end

		'LIFO> sort'
	end

	/* printing section names */
	else if opt.$sug_sec then do
		/* sort section names */
		call SORTSECTIONS

		do i = 1 to words(sections)
			section = word(sections,i)
			/* sort packages in this section */
			do j = 1 to s.section.0
				pkg = s.section.j
				if \g.$onlyinstalled then queue pkg
				else if installed.pkg then queue pkg
			end j

			q = queued()
			if q > 0 then do
				'LIFO> sort >FIFO'

				if \opt.$quiet then say section ||,
						g.$lf || copies('-',length(section))
				do q
					parse pull pkg
					call PRINT_PKG_SECT_DESC
				end
				if \opt.$quiet then say
			end
		end i
	end

	/* else not printing section names */
	else do
		do i = 1 to words(sections)
			section = word(sections,i)
			do j = 1 to s.section.0
				pkg = s.section.j
				if \g.$onlyinstalled then queue pkg
				else if installed.pkg then queue pkg
			end j
		end i

		if queued() > 0 then do
			'LIFO> sort >FIFO'
			do queued()
				parse pull pkg
				call PRINT_PKG_SECT_DESC
			end
		end
	end

	return

PRINT_PKG_SECT_DESC:

	/* 3-letter abbrev for status + package name */
	if g.$onlyinstalled then out = pkg
	else out = left(word(stat.pkg,1),1) || left(word(stat.pkg,2),1) ||,
		left(word(stat.pkg,3),1) pkg

	if length(out) < field1 then out = left(out, field1) vers.pkg
	else out = out vers.pkg

	if opt.$long then do
		if length(out) < field2 then out = left(out, field2)
		out = out descr.pkg
	end

	if length(out) <= g.$columns then say out
	else say left(out,g.$columns)

	return

SORTSECTIONS: PROCEDURE EXPOSE g. sections

	/* sort the section names (contrib/non-free last) */
	do i = 1 to words(sections)
		section = word(sections,i)
		if pos('non-free',section) <> 0 |,
			pos('contrib',section) <> 0
			then queue '~'section
		else queue section
	end

	'LIFO> sort |tr -d "~" >FIFO'

	sections = ''
	do queued()
		parse pull section
		sections = sections section
	end

	return

/* -------------------------------------------------------------------
 * Show a maintainer's packages
 */
MAINTAINER: PROCEDURE EXPOSE (globals)

	parse arg pat

	if pat = '' then return

	/* if all, just do the egrep and don't filter the hits further */
	if pat = '*' then append = ''
	else do
		/* if any uppercase letters in pat, do case-sensitive match */
		if verify(pat,xrange('41'x,'5a'x),'M') <> 0 then case = ''
		else case = '-i'

		pat = changestr('*',pat,'')		/* lose any wildcards */
		pattern = '^Maintainer: .*'pat'.*'
		append = '|egrep -B3 -A1 -h' case '"'pattern'" |sed -n "/^Pack/,/^$/p"'
	end

	call popen 'egrep 2>/dev/null -h "^Package: |^Section: |^Maintainer: |^$"',
		packagesfiles append, 'h.'

	if h.0 = 0 then call EX 0,'..no packages for "'pat'"'

	package. = 0
	seen. = 0 /* big speedup to not queue multiples if lots of vendors */
	parse var h.1 'Package: ' pkg
	do i = 2 to h.0
		if h.i = '' then do
			package.maint.0 = package.maint.0 + 1
			j = package.maint.0
			package.maint.j = pkg
			section.pkg = sect

			if \seen.maint then queue maint
			seen.maint = 1

			/* can set h.='' before popen sets it and go one past
			 * the end of the array here, then exit on the iterate
			 * instead...neither is very pretty
			 */
			i = i + 1
			if i > h.0 then leave i
			parse var h.i 'Package: ' pkg
			iterate i
		end
		if abbrev(h.i,'S') then parse var h.i 'Section: ' sect
		if abbrev(h.i,'M') then parse var h.i 'Maintainer: ' maint
	end i

	'LIFO> sort |uniq >FIFO'

	sortchar = '7b'x	/* for non-free/contrib to sort last */
	do queued()
		parse pull mtr

		if \opt.$quiet then say mtr

		/* sort packages, contrib & non-free last */
		do i = 1 to package.mtr.0
			pkg = package.mtr.i
			/* add dummy char so contrib/non-free sort last */
			if pos('contrib',section.pkg) <> 0
				then pack.i = sortchar || package.mtr.i
			else if pos('non-free',section.pkg) <> 0
				then pack.i = sortchar || package.mtr.i
			else pack.i = package.mtr.i
		end i
		pack.0 = package.mtr.0

		sortstem = 'pack.'
		call SORT

		do i = 1 to pack.0
			/* strip any dummy character */
			pkg = changestr(sortchar,pack.i,'')
			if opt.$quiet then say pkg
			else do
				if length(pkg) < 25
				  then say '  'left(pkg,25) section.pkg
				  else say '  'pkg section.pkg
			end
		end i
	end

	return

/* -------------------------------------------------------------------
 * find the packages that no other installed package depends on
 *	(+recommends +suggests)
 */
NODEPS: PROCEDURE EXPOSE (globals) statusfile

	essentialmark = g.$lf'Essential: yes' /* there is at least one 'no' */
	requiredmark  = g.$lf'Priority: required'
	installedmark = g.$lf'Installed-Size: '	/* dpkg normalizes case */
	providesmark  = g.$lf'Provides: '
	depmark		  = g.$lf'Depends: '
	predepmark	  = g.$lf'Pre-Depends: '
	recmark		  = g.$lf'Recommends: '
	sugmark		  = g.$lf'Suggests: '
	descrmark	  = g.$lf'Description: '

	chunksize = 2**10		 /* tune for speed */
	chunk = ''
	pindex = 0
	dep. = 0
	prov. = ''
	required. = 0

	call stream(statusfile,'C','OPEN READ')
	p = 0
	lf2 = g.$lf || g.$lf
	do forever
		if lines(statusfile) = 0 then leave

		/* get at least a paragraph */
		if pos(lf2,chunk) = 0
			then chunk = chunk || charin(statusfile,,chunksize)
		if pos(lf2,chunk) = 0 then iterate

		/* process each paragraph */
		do while pos(lf2,chunk) <> 0
			parse var chunk stanza (lf2) chunk
			if pos('ok installed'g.$lf, stanza) <> 0
				then call PROCESS_STANZA stanza
		end
	end
	package.0 = p
	call stream(statusfile,'C','CLOSE')

	/* nodeps -> stem array */
	k = 0
	do i = 1 to package.0
		pkg = package.i
		if \dep.pkg then do
			/* this package provides for an installed package? */
			do j = 1 to words(prov.pkg)
				provide = word(prov.pkg, j)
				if dep.provide then iterate i
			end j

			/* essential & required packages can't be removed */
			if required.pkg then iterate i

			k = k + 1
			nodep.k = pkg
		end
	end i
	nodep.0 = k

	sortstem = 'nodep.'
	call SORT

	field1 = 16
	field2 = 6
	field1_2 = field1 + field2
	f1_2 = field1 + field2
	do i = 1 to nodep.0
		pkg = nodep.i
		call PRINTDESCRIPTION
	end i

	return

/* */
PRINTDESCRIPTION:

	if opt.$quiet then say pkg
	else do
		if length(pkg) + length(installedsize.pkg) < field1_2
		  then out = pkg right(installedsize.pkg,field1_2 - length(pkg)),
				descr.pkg
		  else out = pkg installedsize.pkg descr.pkg
		if length(out) <= g.$columns then say out
		else say left(out,g.$columns)
	end

	return

/* -------------------------------------------------------------------
 * RETURNS:
 *	  package.	 - names of all installed packages
 *	  p			 - number of package.'s
 *	  descr.	 - one-line description of the above
 *	  dep.		 - array of packages that are depended on
 *	  required.  - 1 if package is marked essential or required
 */
PROCESS_STANZA:

	parse var stanza 'Package: ' pkg (g.$lf)

	p = p + 1
	package.p = pkg

	parse var stanza (descrmark) descr.pkg (g.$lf)
	parse var stanza (installedmark) installedsize.pkg (g.$lf)

	/* essential,required can't be removed */
	if pos(essentialmark, stanza) <> 0 then required.pkg = 1
	if pos(requiredmark, stanza) <> 0 then required.pkg = 1

	/* extract all the (pre-)deps, [+suggests +recommends] for all packages */
	depends = ''
	parse var stanza (depmark) deps (g.$lf)
	depends = depends deps
	parse var stanza (predepmark) deps (g.$lf)
	depends = depends deps
	if opt.$rec then do
		parse var stanza (recmark) deps (g.$lf)
		depends = depends deps
	end
	if opt.$sug_sec then do
		parse var stanza (sugmark) deps (g.$lf)
		depends = depends deps
	end
	depends = translate(depends, '', '|,')

	/* lose the version numbers */
	do while pos('(', depends) <> 0
		parse var depends pre '(' . ')' post
		depends = pre || post
	end

	/* set boolean for packages with dependencies */
	do di = 1 to words(depends)
		depend = word(depends,di)
		/* something depends on this package */
		dep.depend = 1
	end

	/* not an orphan if this pkg provides a needed virtual package */
	parse var stanza (providesmark) provides (g.$lf)
	/* lose the or */
	provides = translate(provides, '', '|,')
	/* lose the version numbers */
	do while pos('(', provides) <> 0
		parse var provides pre '(' . ')' post
		provides = pre || post
	end
	/* string of virtual packages that this one provides */
	prov.pkg = provides

	return

/* -------------------------------------------------------------------
 * Show the packages that need updating
 */
NEEDUPDATE: PROCEDURE EXPOSE (globals) statusfile packagesdir

	parse arg val

	pfiles = SETPFILE('u',val)

	call popen 'egrep -h "^Package: |^Status: |^Version: |^$"' statusfile,
		'|egrep -B2 -h "^Version: "', 'h.'

	if \abbrev(h.1,'Pa') then call EX 1,'..no "'statusfile'"?'

	/* this relies on Status always coming before Version in
		the *Packages files */
	i = 1
	j = 0
	iversion. = ''		/* installed version */
	hold. = 0
	do forever
		parse var h.i 'Package: ' pkg
		i = i + 1
		parse var h.i 'Status: ' status
		i = i + 1
		parse var h.i 'Version: ' version
		if version = '' then call ERX,
			'..either' statusfile 'is corrupt or missing or the parsing is',
			'borked; please email author'

		/* only add installed packages to list */
		if right(status,12) = 'ok installed' then do
			j = j + 1
			package.j = pkg
			iversion.pkg = version
			if abbrev(status,'hold') then hold.pkg = 1
		end

		i = i + 2
		if i >= h.0 then leave
	end
	package.0 = j

	h. = ''
	/* extract Version numbers from Packages */
	call popen 'egrep 2>/dev/null -h "^Package: |^Version: "',
		pfiles, 'h.'
	if \abbrev(h.1,'Pack') then call EX 1,'..no Packages file?'

	i = 1
	pversion. = ''			/* version in Packages */
	do forever
		parse var h.i 'Package: ' pkg

		i = i + 1

		/* only keep newest version # from the selected Packages files */
		parse var h.i 'Version: ' version
		if pversion.pkg = '' then pversion.pkg = version
		else if COMPARE_VERSIONS(version,pversion.pkg) = 1
			then pversion.pkg = version

		i = i + 1
		if i >= h.0 then leave
	end

	j = 0
	/* extract the package we are going to print */
	do i = 1 to package.0
		pkg = package.i

		/* if the package isn't in *Packages, it's just local -- don't print */
		if pversion.pkg = '' then iterate

		/* pass if installed version == *Packages version */
		if iversion.pkg == pversion.pkg then iterate

		if \opt.$alldiff	/* if U, show all differences */
			then if COMPARE_VERSIONS(pversion.pkg,iversion.pkg) <> 1
			then iterate

		j = j + 1
		out.j = pkg
	end i
	out.0 = j

	sortstem = 'out.'
	call SORT

	field1 = 20
	field2 = field1 + 16
	do i = 1 to out.0
		pkg = out.i
		if opt.$quiet then do
			if \hold.pkg then say pkg
		end
		else do
			if hold.pkg then out = pkg '(h)'
			else out = pkg
			if length(out) < field1 then out = left(out, field1) iversion.pkg
			else out = out iversion.pkg
			if length(out) < field2 then say left(out, field2) pversion.pkg
			else say out pversion.pkg
		end
	end i

	return

/* -------------------------------------------------------------------
 * Compare version numbers
 * RETURNS:
 *	 -v		-vn
 * ------------
 * v1 > v2	  1
 * v1 = v2	  0
 * v1 < v2	 -1
 *
 */
VERSIONS: PROCEDURE EXPOSE (globals)

	parse arg val
	if words(val) <> 2 then call EX 1,'..need 2 arguments'

	parse var val v1 v2
	ret = COMPARE_VERSIONS(v1,v2)

	if opt.$numeric_nowrite then say ret
	else do
		if ret = 1 then say v1 '>' v2
		else if ret = -1 then say v1 '<' v2
		else say v1 '=' v2
	end

	return

/* ------------------------------------------------------------------
 * From dpkg-python's dpkg_version.py
 *
 * RETURNS:
 *	1  v1 > v2
 *	0  v1 = v2
 * -1  v1 < v2
 */
COMPARE_VERSIONS: PROCEDURE EXPOSE g.

	parse arg v1,v2
	parse value PARSE_VERSION(v1) with e1','u1','d1
	parse value PARSE_VERSION(v2) with e2','u2','d2

	r = COMPARE_SUBVERSION(e1,e2)
	if r <> 0 then return r
	r = COMPARE_SUBVERSION(u1,u2)
	if r <> 0 then return r
	r = COMPARE_SUBVERSION(d1,d2)
	if r <> 0 then return r

	return 0

/* split to epoch, upstream, debian; check if valid */
PARSE_VERSION: PROCEDURE EXPOSE g.

	parse arg u

	e='';d=''

	if pos(':',u) <> 0 then do
		parse var u e ':' u
		if \datatype(e,'NUM') then call EX 1,'"'e'" is not a valid epoch'
	end

	if pos('-',u) <> 0 then do
		ldash = lastpos('-',u)
		parse var u u =(ldash) +1 d
		if d = '' | (verify(d,g.$debian) <> 0)
			then call EX 1,'"'d'" is not a valid Debian version'
	end

	if u = '' | (verify(u,g.$upstream) <> 0)
		then call EX 1,'"'u'" is not a valid upstream version'

	return e','u','d

COMPARE_SUBVERSION: PROCEDURE EXPOSE g.

	parse arg nv1,nv2

	do while 1
		parse value STRIP_NONDIGIT(nv1) with sv1','nv1
		parse value STRIP_NONDIGIT(nv2) with sv2','nv2

		r = COMPARE_NONDIGIT(sv1,sv2)
		if r <> 0 then return r
		if (nv1 = '') & (nv2 = '') then return 0

		parse value STRIP_DIGIT(nv1) with sv1','nv1
		parse value STRIP_DIGIT(nv2) with sv2','nv2

		if sv1 < sv2 then return -1
		if sv1 > sv2 then return 1
		if (nv1 = '') & (nv2 = '') then return 0
	end

	return 0

COMPARE_NONDIGIT: PROCEDURE EXPOSE g.

	parse arg s1,s2

	do i = 1 to max(length(s1), length(s2))
		if i > length(s1) then return -1
		if i > length(s2) then return 1
		c1 = substr(s1,i,1)
		c2 = substr(s2,i,1)
		if datatype(c1,'MIXED') & \datatype(c2,'MIXED') then return -1
		if datatype(c2,'MIXED') & \datatype(c1,'MIXED') then return 1
		if c1 < c2 then return -1
		if c2 < c1 then return 1
	end i

	return 0

STRIP_DIGIT: PROCEDURE EXPOSE g.

	parse arg s

	do i = 1 to length(s)
		if \datatype(substr(s,i,1),'NUM') then leave i
	end

	if i = 1 then return 0','s
	parse var s digit =(i) nondigit

	return digit','nondigit

STRIP_NONDIGIT: PROCEDURE EXPOSE g.

	parse arg s

	do i = 1 to length(s)
		if datatype(substr(s,i,1),'NUM') then leave i
	end i
	if i = 1 then return ','s

	parse var s nondigit =(i) digit
	return nondigit','digit

/* -------------------------------------------------------------------
 * called by ANOMALIES, NEEDUPDATE, startup to set the Packages files
 */
SETPFILE: PROCEDURE EXPOSE (globals) packagesdir

	parse arg caller,val

	if val = '' then val = distpins
	if val = '' then val = '*'

	olddir = value('PWD',,'SYSTEM')
	call chdir packagesdir

	if val = '?' then do
		say 'Choose a unique string to select only some Packages files.  You can also'
		say 'set the PPDIST environment variable.  Currently,'
		say
		say '  PPDIST="'getenv('PPDIST')'"'
		say
		say ' Sources:'
		say ' -------'
		"ls -1 *Sources |sed 's/_source.*//'"
		say
		say ' Packages:'
		say ' --------'
		"ls -1 *Packages |sed 's/_binary-.*//'"
		exit 0
	end

	pfiles = ''
	do i = 1 to words(val)
		pfiles = pfiles packagesdir'*'word(val,i)'*Packages'
	end

	call chdir olddir

	return pfiles

/* -------------------------------------------------------------------
 * RETURNS:
 *	the sorted stem array
 */
SORT: PROCEDURE EXPOSE g. (sortstem)

	/* define m for passes */
	m = 1
	do while (9 * m + 4) < value(sortstem'0')
		m = m * 3 + 1
	end

	/* sort stem */
	do while m > 0
		k = value(sortstem'0') - m
		do j = 1 to k
			q = j
			do while q > 0
				l = q + m
				if value(sortstem'q') <= value(sortstem'l') then leave
				/* switch elements */
				tmp = value(sortstem'q')
				interpret sortstem'q =' sortstem'l'
				interpret sortstem'l = tmp'
				q = q - m
			end
		end
		m = m % 3
	end

	return

/* -------------------------------------------------------------------
 *
 */
DOBROWSER: PROCEDURE EXPOSE (globals)

	parse arg url

	/* not Netscape; start browser with url */
	if pos('netscape', g.$browser) = 0 then g.$browser url

	else do		 /* Netscape */
		/* lockfile symlink means it is already running */
		lockfile = value('HOME',,'SYSTEM')'/.netscape/lock'
		'[ -h' lockfile ']'
		/* if lockfile is set use existing Netscape */
		if RC = 0
			then g.$browser '-remote "openURL('url')" 2>/dev/null'

		/* no lockfile; start Netscape with url */
		else do
			g.$browser url '2>/dev/null&'
			call sleep 5
		end

	end

	return

/* -------------------------------------------------------------------
 * if the usage line starts with '!' it is interpreted
 *	to allow variable substitution
 */
USAGE:
	do i = 3 to 10
		line = sourceline(i)
		if left(line,3) <> '-+-' then iterate i
		do j = i + 1 by 1
			line = sourceline(j)
			if left(line,3) = '-*-' then leave i
			if left(line,1) <> '!' then say line
			else interpret substr(line,2)
		end j
	end i
	return 0

NOVALUE:
FAILURE:
SYNTAX:
ERROR:
	call lineout 'stderr',,
		 condition('C') 'error, line' SIGL': "'condition('D')'"'
	exit 1
HALT:
	say
	exit 1
QUIT:
	exit 0
EX:
	parse arg ret,err
	call lineout 'stderr', err
	exit ret
