<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/local/bin/perl
#
# @(#) mywebget.pl -- Perl, Batch download Net files with configuration file
# @(#) $Id: mywebget.pl,v 1.10 2000/12/30 03:30:49 jaalto Exp $
#
#  File id
#
#       .Copyright (C) 1998-2001 Jari Aalto
#       .Created: 1999-02
#       .$Contactid: jari.aalto@poboxes.com $
#       .$Keywords: Perl txt html conversion $
#	.$URL: http://www.poboxes.com/jari.aalto $
#       .$Perl: 5.004 $
#
#       This program is free software; you can redistribute it and or
#       modify it under the terms of the GNU General Public License as
#       published by the Free Software Foundation; either version 2 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
#       General Public License for more details.
#
#       You should have received a copy of the GNU General Public License along
#       with this program; if not, write to the Free Software Foundation,
#       Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#   About program layout
#
#	Code written with Unix Emacs and indentation controlled with
#	Emacs package tinytab.el, a generic tab minor mode for programming.
#
#       The {{ }}} marks you see in this file are party of file "fold"
#       control package called folding.el (Unix Emacs lisp package).
#       ftp://ftp.csd.uu.se/pub/users/andersl/beta to get the latest.
#
#       There is also lines that look like # ....... &amp;tag ... and they
#       are generated by Emacs Lisp package tinybm.el, which is also
#       document structure tool. You can jump between the blocks with
#       Ctrl-up and Ctrl-down keys and create those "bookmarks" with
#       Emacs M-x tibm-insert.
#
#   Funny identifiers at the top of file
#
#       The GNU RCS ident(1) program can print useful information out
#       of all variables that are in format $ IDENTIFIER: text $
#       See also Unix man pages for command what(1) which outputs all lines
#       matching @( # ). Try commands:
#
#       % what  PRGNAME
#       % ident PRGNAME
#
#   Introduction
#
#       Please start this perl script with options
#
#           --help      to get the help page
#
#   Description
#
#	If you retrieve latest versions of certain program blocks
#	periodically, this is the Perl script for you. Run from cron job
#	or once a week to upload newest versions of files around the net.
#
#	_Note:_ This is simple file by file copier and does not offer
#	any date comparing or recursive features like found from C-program
#	wget(1) http://www.ccp14.ac.uk/mirror/wget.htm and
#	ftp://prep.ai.mit.edu/pub/gnu
#
#   Change Log
#
#	(none)

use strict;

BEGIN { require 5.004 }

#       A U T O L O A D
#
#       The =&gt; operator quotes only words, and File::Basename is not
#       Perl "word"

use autouse 'Carp'          =&gt; qw( croak carp cluck confess );
use autouse 'Text::Tabs'    =&gt; qw( expand                   );
use autouse 'Pod::Text'     =&gt; qw( pod2text                 );
use autouse 'Pod::Html'     =&gt; qw( pod2html                 );
use autouse 'File::Copy'    =&gt; qw( copy move                );
use autouse 'File::Path'    =&gt; qw( mkpath rmtree            );

#   Standard perl modules

use Cwd;
use Env;
use English;
use File::Basename;
use Getopt::Long;

use Env;

use vars qw
(
    $PATH
    $HOME
    $TEMP
    $TEMPDIR
    $SHELL
);


#   Other CPAN modules

use LWP::UserAgent;
use Net::FTP;

    use vars qw ( $VERSION );

    #   This is for use of Makefile.PL and ExtUtils::MakeMaker
    #   So that it puts the tardist number in format YYYY.MMDD
    #   The REAL version number is defined later

    #   The following variable is updated by my Emacs setup whenever
    #   this file is saved

    $VERSION = '2001.0105';

# ****************************************************************************
#
#   DESCRIPTION
#
#       Set global variables for the program
#
#   INPUT PARAMETERS
#
#       none
#
#   RETURN VALUES
#
#       none
#
# ****************************************************************************

sub Initialize ()
{
    use vars qw
    (
        $PROGNAME
        $LIB

        $RCS_ID
        $VERSION
        $CONTACT
        $URL
	$WIN32
    );

    $LIB	= basename $PROGRAM_NAME;
    $PROGNAME   = $LIB;

    $RCS_ID   = '$Id: mywebget.pl,v 1.10 2000/12/30 03:30:49 jaalto Exp $'; #'
    $VERSION  = (split ' ', $RCS_ID)[2];     # version number in format N.NN+
    $CONTACT  = "&lt;jari.aalto\@poboxes.com&gt;"; # Who is the maintainer
    $URL      = "http://www.perl.com/CPAN-local//scripts/";

    $WIN32    = 1   if  $OSNAME =~ /win32/i;


    $OUTPUT_AUTOFLUSH = 1;
}


# ***************************************************************** &amp;help ****
#
#   DESCRIPTION
#
#       Print help and exit.
#
#   INPUT PARAMETERS
#
#       $msg    [optional] Reason why function was called.
#
#   RETURN VALUES
#
#       none
#
# ****************************************************************************

=pod

=head1 NAME

mywebget.pl - Perl Web URL fetch program

=head1 SYNOPSIS

    mywebget.pl http://example.com/ [URL ...]
    mywebget.pl --config $HOME/config/mywebget.conf --Tag linux --Tag emacs ..
    mywebget.pl --verbose --overwrite http://example.com/
    mywebget.pl --verbose --overwrite --Output ~/dir/ http://example.com/
    mywebget.pl --new --overwrite http://example.com/kit-1.1.tar.gz

=head1 OPTIONS

=head2 General options

=over 4

=item B&lt;--Create-paths&gt;

Create paths that do not exist in C&lt;lcd:&gt; directives.

By default, any LCD directive to non-existing directory will interrupt
program. With this option, local directories are created as needed making
it possible to re-create the exact structure as it is in configuration
file.

=item B&lt;--config FILE&gt;

This option can be given multiple times. All configurations are read.

Read URLs from configuration file. If no configuration file is given, file
pointed by enviromnet variable is read. See ENVIRONMENT.

=over 2

C&lt;Comments&gt;

The configuration file is NOT Perl code. Comments start with hash character
#.

C&lt;Variables&gt;

At this point, variable expansions happen only in B&lt;lcd:&gt;. Do not try
to use them anywhere else, like in URLs.

Path variables for B&lt;lcd:&gt; are defined using following notation, spaces are
not allowed in VALUE part (no directory names with spaces). Varaible names
are case sensitive. Variables substitute environment varaibales with the
same name. Environment variables are immediately available.


    VARIABLE = /home/my/dir	    # define variable
    VARIABLE = $dir/some/file	    # Use previously defined variable
    FTP	     = $HOME/ftp	    # Use environment variable

The right hand can refer to previously defined variables or existing
environment variables. Repeat, this is not Perl code although it may
look like one, but just an allowed syntax in the configuration file. Notice
that there is dollar to the right hand&gt; when variable is referred, but no
dollar to the left hand side when variable is defined. Here is example
of a possible configuration file contant. The tags are hierarchically
ordered without a limit.

Warning: remember to use different variables names in separate
include files. All variables are global.

C&lt;Includes&gt;

It is possible to include more configuration files with statement

    INCLUDE &lt;path-to-file-name&gt;

Variable expansions are possible in the file name. There is no limit how
many or how deep include structure is used. Every file is included only
once, so it is safe to to have multiple includes to the same file.

=back

C&lt;Configuraton file example&gt;

    #   $HOME/config/mywebget.conf - Perl mywebget.pl configuration file

    ROOT   = $HOME			# define variables
    CONF   = $HOME/config
    UPDATE = $ROOT/updates
    DOWNL  = $ROOT/download

    #	Include more configuration files. It is possible to
    #	split a huge file in pieces and have "linux",
    #	"win32", "debian", "emacs" configurations in separate
    #	and manageable files.

    INCLUDE &lt;$CONF/mywebget-other.conf&gt;
    INCLUDE &lt;$CONF/mywebget-more.conf&gt;




    tag1: local-copies tag1: local	# multiple names to this category

	lcd:  $UPDATE			# chdir directive

	file://absolute/dir/file-1.23.tar.gz

    tag1: external

      lcd:  $DOWNL

      tag2: external-http

	http://www.example.com/page.html
	http://www.example.com/page.html save:/dir/dir/page.html

      tag2: external-ftp

	ftp://ftp.com/dir/file.txt.gz save:xx-file.txt.gz login:foo pass:passwd x:

	lcd: $HOME/download-kit

	ftp://ftp.com/dir/kit-1.1.tar.gz new:

      tag2: package-x

        lcd: $DOWNL/package-x

        #  Person announces new files in his homepage, download all
	#  announced files. Unpack everything (x:) and remove any
	#  existing directories (xopt:rm)

	http://some.com/~foo   page:find  pregexp:\.tar\.gz$ x: xopt:rm

    # End of configuration file mywebget.conf


=item B&lt;--extract&gt;

Unpack any files after retrieving them. The command to unpack typical
archive files are defined in a program. Make sure these programs are
along path. Win32 users are encouraged to install the Cygwin utilities
where these programs come standard. Refer to section SEE ALSO.

  .tar =&gt; tar
  .tgz =&gt; tar + gzip
  .gz  =&gt; gzip
  .bz2 =&gt; bzip2
  .zip =&gt; unzip

=item B&lt;--Firewall FIREWALL&gt;

Use FIREWALL when accessing files via ftp:// protocol.

=item B&lt;--new -n&gt;

Get newest file. This applies to datafiles, which do not have extension
.asp or .html. When new releases are announced, the version
number in filename usually tells which is the current one so getting
harcoded file with:

    mywebget.pl -o -v http://example.com/dir/program-1.3.tar.gz

is not usually practical from automation point of view. Adding B&lt;--new&gt;
option to the command line causes double pass: a) the whole
http://example.com/dir/ is examined for all files. b) files matching
approximately filename program-1.3.tar.gz are examined, heuristically
sorted and file with latest version number is retrieved.

=item B&lt;--no-lcd&gt;

Ignore C&lt;lcd:&gt; directives in configuration file.

In the configuration file, any C&lt;lcd:&gt; directives are obeyed as they are seen.
But if you do want to retrieve URL to your current directory, be sure to
supply this option. Otherwise the file will end to the directory pointer by
C&lt;lcd:&gt;.

=item B&lt;--no-save&gt;

Ignore C&lt;save:&gt; directives in configuration file. If the URLs have
C&lt;save:&gt; options, they are ignored during fetch. You usually want to
combine B&lt;--no-lcd&gt; with B&lt;--no-save&gt;

=item B&lt;--no-extract&gt;

Ignore C&lt;x:&gt; directives in configuration file.

=item B&lt;--Output DIR&gt;

Before retrieving any files, chdir to DIR.

=item B&lt;--overwrite&gt;

Allow overwriting existing files when retrieving URLs.
Combine this with B&lt;--skip-version&gt; if you periodically update files.

=item B&lt;--Proxy PROXY&gt;

Use PROXY server for HTTP. (See B&lt;--Firewall&gt; for FTP.). The port number is
optional in the call:

    --Proxy this.proxy.com:8080
    --Proxy http://this.proxy.com:8080/
    --Proxy this.proxy.com
    --Proxy http://this.proxy.com/

=item B&lt;--prefix PREFIX&gt;

Add PREFIX to all retrieved files.

=item B&lt;--Postfix POSTFIX &gt;

Add POSTFIX to all retrieved files.

=item B&lt;--prefix-date -D&gt;

Add iso8601 ":YYYY-MM-DD" prefix to all retrived files.
This is added before possible B&lt;--prefix-www&gt; or B&lt;--prefix&gt;.

=item B&lt;--prefix-www -W&gt;

Usually the files are stored with the same name as in the URL dir, but
if you retrieve files that have identical names you can store each
page separately so that the file name is prefixed by the site name.

    http://example.com/page.html    --&gt; example.com::page.html
    http://example2.com/page.html   --&gt; example2.com::page.html

=item B&lt;--regexp REGEXP&gt;

Retrieve URLs matching REGEXP from your C&lt;configuration&gt; file. This cancels
B&lt;--Tag&gt; options in the command line.


=item B&lt;--stdout&gt;

Retrieve URL and write it to stdout.

=item B&lt;--skip-version&gt;

Do not download files that have version number and which already exists on
disk. Suppose you have these files and you use option B&lt;--skip-version&gt;:

    kit.tar.gz
    file-1.1.tar.gz

Only file.txt is retrieved, because file-1.1.tar.gz contains version number
and the file has not changed since last retrieval. The idea is, that in
every release the number in in distribution increases, but there may be
distributions which do not contain version number. In regular intervals
you may want to load those kits again, but skip versioned files. In short:
This option does not make much sense without additional option B&lt;--new&gt;

If you want to reload versioned file again, add option B&lt;--overwrite&gt;.

=item B&lt;--Tag NAME [NAME] ...&gt;

Search tag NAME from the config file and download only entries defined
under that tag. Refer to B&lt;--config FILE&gt; option description. You can give
Multiple B&lt;--Tag&gt; switches. Combining this option with B&lt;--regexp&gt;
does not make sense and the concequencies are undefined.

=back

=head2 Miscellaneous options

=over 4

=item B&lt;--debug LEVEL -d LEVEL&gt;

Turn on debug with positive LEVEL number. Zero means no debug.
This option turns on B&lt;--verbose&gt; too.

=item B&lt;--help -h&gt;

Print help page in text.

=item B&lt;--help-html&gt;

Print help page in HTML.

Print help page.

=item B&lt;--selftest&gt;

Run some internal tests. For maintainer or developer only.

=item B&lt;--test -t&gt;

Run in test mode.

=item B&lt;--verbose -v&gt;

Print verbose messages.

=item B&lt;--Version -V&gt;

Print program's version information.

=back

=head1 README

Automate periodic downloads of released files and packages.

This small utility makes it possible to keep a list of URLs in a
configuration file and periodically retrieve those pages or files with
simple commands. This utility is best suited for small batch jobs to
download e.g. most recent versions of software files. If you use an URL
that is already on disk, be sure to supply option B&lt;--overwrite&gt; to allow
overwriting existing files.

If the URL ends to slash, then posisble directory list at the remote machine
is stored to file:

    !path!000root-file

The content of this file can be either index.html or the directory listing
depending on the used http or ftp protocol.

While you can run this program from command line to retrieve individual
files, program has been designed to use separate configuration file via
B&lt;--config&gt; option. In the configuration file you can control the
downloading with separate directives like C&lt;save:&gt; which tells to save the
file under different name.

The simplest way to retreive a latest version of a kit from FTP site is:

    mywebget.pl --new --overwite --verbose \
       http://www.example.com/kit-1.00.tar.gz

Don't worry about the filename "kit-1.00.tar.gz". The latest version, say,
kit-3.08.tar.gz will be retrieved. The option B&lt;--new&gt; instructs to find
newer version than the provided URL.

=head1 EXAMPLES

Get file(s) from site:

    mywebget.pl http://www.example.com/dir/package.tar.gz ..

Read a directory and store it to filename YYYY-MM-DD::!dir!000root-file.

    mywebget.pl --prefix-date --overwrite --verbose http://www.example.com/dir/

To update newest version of the kit, but only if there is none in the
disk already. The --new option instructs to find nwer packages and
the filename is used only for guidance how the file looks like:

    mywebget.pl --overwrite --skip-version --new --verbose \
	ftp://ftp.example.com/dir/packet-1.23.tar.gz


To overwrite file and add a date prefix to the file name:

    mywebget.pl --prefix-date --overwrite --verbose \
       http://www.example.com/file.pl

    --&gt; YYYY-MM-DD::file.pl

To add date and WWW site prefix to the filenames:

    mywebget.pl --prefix-date --prefix-www --overwrite --verbose \
       http://www.example.com/file.pl

    --&gt; YYYY-MM-DD::www.example.com::file.pl

Get all updated files under KITS and use default configuration file:

    mywebget.pl --verbose --overwrite --skip-version --new --Tag kits
    mywebget.pl -v -o -s -n -T kits

Get files as they read in the configuration file to the current directory,
ignoring any C&lt;lcd:&gt; and C&lt;save:&gt; directives:

    mywebget.pl --config $HOME/config/mywebget.conf /
        --no-lcd --no-save --overwrite --verbose \
	http://www.example.com/file.pl

To check if C&lt;lcd:&gt; directives refer to live directories on disk, run the
program with non-matching regexp and it parses the file and checks the
lcd's along the way:

    mywebget.pl -v -r dummy-regexp

    --&gt;

    mywebget.pl.DirectiveLcd: LCD [$EUSR/directory ...]
    is not a directory at /users/foo/bin/mywebget.pl line 889.

=head2 List of directives in configuration file

All the directives must in the same line where the URL is. The programs
scans lines and determines all options given in line for the URL.
Directives can be overriden by command line options.

=over 4

=item B&lt;cnv:CONVERSION&gt;

Currently only B&lt;cnv:text&gt; is available.

Convert downloaded page to text. This option always needs either
B&lt;save:&gt; or B&lt;rename:&gt;, because only those change the filename. Here is an
example:

    http://example.com/dir/file.html cnv:text save:file.txt
    http://example.com/dir/ page:find pregexp:\.html cnv:text rename:s/html/txt/

A B&lt;text:&gt; shorthand directive can be used instead of B&lt;cnv:text&gt;.

=item B&lt;lcd:DIRECTORY&gt;

Set local download directory to DIRECTORY (chdir to it). Any environment
variables are substituted in path name. If this tag is found, it replaces
setting of B&lt;--Output&gt;. If path is not a directory, terminate with error.
See also B&lt;--Create-paths&gt; and B&lt;--no-lcd&gt;.

=item B&lt;login:LOGIN-NAME&gt;

Ftp login name. Default value is "anonymous".

=item B&lt;new:&gt;

Get newest file. This variable is reset to the value of B&lt;--new&gt; after the
line has been processed. Newest means, that an ls() command is run in the
ftp, and something equivalent in HTTP "ftp directories", and any files that
resemble the filename is examined, sorted and heurestically determined
according to file's version number which one is the latest. For example
files that have version information in YYYYMMDD format will most likely to
be retrieved right.

Time stamps of the files are not checked.

The only requirement is that filename C&lt;must&gt; follow the universal version
numbering standard for released kits:

    FILE-VERSION.extension	# de facto VERSION is defined as [\d.]+

    file-19990101.tar.gz	# ok
    file-1999.0101.tar.gz	# ok
    file-1.2.3.5.tar.gz		# ok

    file1234.txt		# not recognized. Must have "-"
    file-0.23d.tar.gz		# warning ! No letters allowed 0.23d

Files that have some alphabetic version indicator at the end of VERSION
are not handled correctly. Bitch the developer and persuade him to stick
to the de facto standard so that files can be retrieved intelligently.

=item B&lt;overwrite:&gt; B&lt;o:&gt;

Same as turning on B&lt;--overwrite&gt;

=item B&lt;page:&gt;

Download the HTTP page or apply command to it. A simple example, the
contact page name "index.html", "welcome.html" etc. is not known:

   http://some.com/~foo page: save:foo-homepage.html

C&lt;More about&gt; B&lt;page:&gt; C&lt;directive and downloading difficult packages&gt;

Read the HTTP url page "as is" and parse page content. You need this
directive if the archive is not stored in HTTP server's directory (similar
to ftp dir), but the maintainer has set up a separate HTML page where the
details how to get archive is explained.

In order to find the information from the page, you must also supply
some other directives to guide searching and constructing
the correct file name:

1) A page regexp directive C&lt;pregexp:ARCHIVE-REGEXP&gt; matches the A HREF
filename location in the page.

2) Directive C&lt;file:DOWNLOAD-FILE&gt; tells what is the template to use to
construt the downloadable file (for the C&lt;new:&gt; directive).

3) Directive C&lt;vregexp:VERSION-REGEXP&gt; matches the exact location
in the page from where the version information is extracted. The default
regexp looks for line that says "The latest version ...is.. 1.4.2". The
regexp must return submatch 2 for the version number.

To put all together, an example shows more this in action. The following
example should all be PUT ON ONE LINE, while it has been splitted to
separate lines for legibility. The presented configuration line is
explaind in next paragraphs.

=over 4

Contact absolute B&lt;page:&gt; at http://www.example.com/package.html and
search A HREF urls in the page that match B&lt;pregexp:&gt;. In addition, do
another scan and search the version number in the page from thw
position that match B&lt;vregexp:&gt; (submatch 2). The (?i) makes the search
case insensitive in regexp.

After all the pieces have been found, use template B&lt;file:&gt; to
make the retrievable file using the version number found from
&lt;vregexp:&gt;. The actual download location is combination of
B&lt;page:&gt; and A HREF B&lt;pregexp:&gt; location.

=back

    http://www.example.com/~foo/package.html
    page:
    pregexp: package.tar.gz
    vregexp: ((?i)latest.*?version.*?\b([\d][\d.]+).*)
    file: package-1.3.tar.gz
    new:
    x:


Still not clear? Let's throw in a complete HTML page where the above would
apply

    &lt;HTML&gt;
    &lt;BODY&gt;

    The latest version of package is &lt;B&gt;2.4.1&lt;/B&gt; It can be
    downloaded in several forms:

	&lt;A HREF="download/files/package.tar.gz"&gt;Tar file&lt;/A&gt;
	&lt;A HREF="download/files/package.zip"&gt;ZIP file

    &lt;/BODY&gt;
    &lt;/HTML&gt;

For this example it is assumed that package.tar.gz is actually a symbolic
link to the latest standard release file package-2.4.1.tar.gz. From this
page the actual download location would have been
http://www.example.com/~foo/download/files/package-2.4.1.tar.gz So why not
simply download package.tar.gz? Because then the program can't decide if
the version at the page is newer than one stored on disk from the previous
download. With version numbers in the file names, it can.

FURTHER EXAMPLE

It is possible to add B&lt;rename:&gt; directive to change the final name
of the saved file to the above cases. Sometimes people put version number
to "plain" files, that are not archives, like

    file.el-1.1
    file.el-1.2

the .el files are Emacs editor packages files and it woudl be very
inconvenient for Emacs users to refer to those with any other name than
plain "file.el". To write a complete line to find such files from
a page and save them in plain name, see below. Lines have been broken
again for legibility:

    http://example.com/files/
    page:
    pregexp:\.el-\d
    vregexp:(file.el-([\d.]+))
    file:file.el-1.1
    new:
    rename:s/-[\d.]+//

It effectively says "See if there is new version of something that
looks like file.el-1.1 and save it under name file.el".


=item B&lt;page:find&gt;

THIS IS NOT FOR FTP directories. Use directive B&lt;regexp:&gt; for FTP.

This is more general instruction than the B&lt;page:&gt; and B&lt;vregexp:&gt;
explained above.

Instruct to download every URL on HTML page matching B&lt;pregexp:RE&gt;. In
typical situation the page maintainer lists his software in the development
page. This example would download every tar.gz file mentined in a page.
Note, that the REGEXP is matched against the A HREF link content, not
the actual text that you see on the page:

    http://www.example.com/index.html page:find pregexp:\.tar.gz$

You can also use additional B&lt;regexp-no:&gt; directive if you want to exclude
files after the B&lt;pregexp:&gt; has matched a link.

    http://www.example.com/index.html page:find pregexp:\.tar.gz$ regexp-no:this-packet

=item B&lt;pass:PASSWORD&gt;

For FTP logins. Default value is C&lt;nobody@example.com&gt;.

=item B&lt;rename:PERL-CODE&gt;

Rename each file using PERL-CODE. The PERL-CODE must be full perl program
with no spaces anywhere. Following variables are available during the
eval() of code:

    $ARG = current file name
    $url = complete url for the file

For example, if page contains links to .html file that are in fact
text files, this statement would store the filenames as .txt

    http://example.com/dir/ page:find pregexp:\.html rename:s/html/txt/

=item B&lt;regexp:REGEXP&gt;

Get all files in ftp directory matching regexp. Directive B&lt;save:&gt; is ignored.

=item B&lt;regexp-no:REGEXP&gt;

After the regexp: directive has matched, explude files that match
directive B&lt;regexp-no:&gt;

=item B&lt;save:LOCAL-FILE-NAME&gt;

Save file under this name to local disk.

=item B&lt;tagN:NAME&gt;

Downloads can be grouped under C&lt;tagN&gt; so that e.g. option B&lt;--Tag1&gt; would
start downloading files from that point on until next C&lt;tag1&gt; is found.
There are currently unlimited number of tag levels: tag1, tag2 and tag3, so
that you can arrange your downlods hierarchially in the configuration file.
For example to download all Linux files rhat you monitor, you would give
option B&lt;--Tag linux&gt;. To download only the NT Emacs latest binary, you
would give option B&lt;--Tag emacs-nt&gt;. Notice that you do not give the
C&lt;level&gt; in the option, program will find it out from the configuration
file after the tag name matches.

The downloading stops at next tag of the C&lt;same level&gt;. That is, tag2 stops
only at next tag2, or when upper level tag is found (tag1) or or until end of
file.

    tag1: linux		    # All Linux downlods under this category

	tag2: sunsite    tag2: another-name-for-this-spot

	#   List of files to download from here

	tag2: ftp.funet.fi

	#   List of files to download from here

    tag1: emacs-binary

	tag2: emacs-nt

	tag2: xemacs-nt

	tag2: emacs

	tag2: xemacs

=item B&lt;x:&gt;

Extract (unpack) file after download. See also option B&lt;--unpack&gt; and
B&lt;--no-extract&gt; The archive file, say .tar.gz will be extracted the file in
current download location. (see directive B&lt;lcd:&gt;)

The unpack procedure checks the contents of the archive to see if
the package is correctly formed. The de facto archive format is

    package-N.NN.tar.gz

In the archive, all files are supposed to be stored under the proper
subdirectory with version information:

    package-N.NN/doc/README
    package-N.NN/doc/INSTALL
    package-N.NN/src/Makefile
    package-N.NN/src/some-code.java

C&lt;IMPORTANT:&gt; If the archive does not have a subdirectory for all files, a
subdirectory is created and all items are unpacked under it. The defualt
subdirectory name in constructed from the archive name with currect date
stamp in format:

    package-YYYY.MMDD

If the archive name contains something that looks like a version number,
the created directory will be constructed from it, instead of current date.

    package-1.43.tar.gz    =&gt;  package-1.43

=item B&lt;xx:&gt;

Like directive B&lt;x:&gt; but extract the archive C&lt;as is&gt;, without
checking content of the archive. If you know that it is ok for the archive
not to include any subdirectories, use this option to suppress creation
of an artificial root package-YYYY.MMDD.

=item B&lt;xopt:rm&gt;

This options tells to remove any previous unpack directory.

Sometimes the files in the archive are all read-only and unpacking the
archive second time, after some period of time, would display

    tar: package-3.9.5/.cvsignore: Could not create file: Permission denied
    tar: package-3.9.5/BUGS: Could not create file: Permission denied

This is not a serious error, because the archive was already on disk and
tar did not overwrite previous files. It might be good to inform the
archive maintainer, that the files have wrong permissions. It is customary
to expect that distributed kits have writable flag set for all files.

=back

=head1 ERRORS

=over 4

Here is list of possible error messages and how to deal with them.
Turning on  B&lt;--debug&gt; will help to understand how program has
interpreted your configuration file options.

=item ** ERROR /pub/foo/file.el Bad file descriptor

This is "file not found error". You have written the filename incorrectly.
Double check the configuration file line.

=back

=head1 ENVIRONMENT

Variable C&lt;MYWEBGET_PL_CFG&gt; can point to the default configuration file.
The configuration file is read if it exists by default.

=head1 SEE ALSO

C program wget(1) http://www.ccp14.ac.uk/mirror/wget.htm and
Old Perl 4 program webget(1) http://www.wg.omron.co.jp/~jfriedl/perl/
From the the Libwww Perl library you find scripts
lwp-download(1) lwp-mirror(1) lwp-request(1) lwp-rget(1)

Win32 Cygwin unix utilities at http://www.cygwin.com/

=head1 AVAILABILITY

Latest version of this file is at CPAN
http://www.perl.com/CPAN-local//scripts/ Reach author at
jari.aalto@poboxes.com

=head1 SCRIPT CATEGORIES

CPAN/Administrative

=head1 PREREQUISITES

Modules C&lt;LWP::UserAgent&gt; and C&lt;use Net::FTP&gt; are required.

=head1 COREQUISITES

HTML::Parse
HTML::TextFormat

These modules are dynamically loaded only if directive B&lt;cnv:text&gt;
is used. Otherwise these modules are not loaded.

=head1 OSNAMES

C&lt;any&gt;

=head1 VERSION

$Id: mywebget.pl,v 1.10 2000/12/30 03:30:49 jaalto Exp $

=head1 AUTHOR

Copyright (C) 1996-2001 Jari Aalto. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself or in terms of Gnu General Public Licence v2 or later.

=cut

sub Help (;$ $)
{
    my $id   = "$LIB.Help";
    my $msg  = shift;  # optional arg, why are we here...
    my $type = shift;  # optional arg, type

    if ( $type eq -html )
    {
	pod2html $PROGRAM_NAME;
    }
    else
    {
	pod2text $PROGRAM_NAME;
    }

    exit 1;
}


# ************************************************************** &amp;args *******
#
#   DESCRIPTION
#
#       Read and interpret command line arguments
#
#   INPUT PARAMETERS
#
#       none
#
#   RETURN VALUES
#
#       none
#
# ****************************************************************************

sub HandleCommandLineArgs ()
{
    # ............................................... local variables ...

    my $id = "$LIB.HandleCommandLineArgs";

    my ( $version, $help, $helpHTML, $selfTest );

    # .......................................... command line options ...

    use vars qw
    (
	$CHECK_NEWEST

	$debug
	$DIR_DATE

	@CFG_FILE
	$FIREWALL

	$LCD_CREATE

	$NO_SAVE
	$NO_LCD
	$NO_EXTRACT

	$OVERWRITE
	$OUT_DIR

	$PREFIX
	$PREFIX_DATE
	$PREFIX_WWW

	$POSTFIX
	$PROXY
	$STDOUT

	$SKIP_VERSION

	$URL_REGEXP
	$EXTRACT

	$TAG_REGEXP
	@TAG_LIST
	$verb
	$test

	$MYWEBGET_PL_CFG
    );

    $FIREWALL  = "";
    $OVERWRITE = 0;

    # .................................................... read args ...

    Getopt::Long::config( qw
    (
        require_order
        no_ignore_case
        no_ignore_case_always
    ));


    GetOptions      # Getopt::Long
    (
	  "Version"	    =&gt; \$version

	, "config:s"	    =&gt; \@CFG_FILE
	, "Create-paths"    =&gt; \$LCD_CREATE

	, "debug:i"	    =&gt; \$debug

	, "Firewall=s"	    =&gt; \$FIREWALL

        , "help"            =&gt; \$help
        , "help-html"       =&gt; \$helpHTML
        , "test"            =&gt; \$test


	, "n"		    =&gt; \$CHECK_NEWEST
	, "new"		    =&gt; \$CHECK_NEWEST
	, "no-lcd"	    =&gt; \$NO_LCD
	, "no-save"	    =&gt; \$NO_SAVE
	, "no-extract"	    =&gt; \$NO_EXTRACT

	, "overwrite"	    =&gt; \$OVERWRITE
	, "skip--version"   =&gt; \$SKIP_VERSION
	, "Output:s"	    =&gt; \$OUT_DIR

	, "prefix:s"	    =&gt; \$PREFIX
	, "D|prefix-date"   =&gt; \$PREFIX_DATE
	, "W|prefix-www"    =&gt; \$PREFIX_WWW

	, "Postfix:s"	    =&gt; \$POSTFIX
	, "Proxy=s"	    =&gt; \$PROXY

	, "regexp=s"	    =&gt; \$URL_REGEXP
	, "stdout"          =&gt; \$STDOUT

	, "selftest"	    =&gt; \$selfTest
	, "Tag=s"	    =&gt; \@TAG_LIST
	, "extract"	    =&gt; \$EXTRACT

	, "verbose"	    =&gt; \$verb

    );

    if ( defined $debug   and  $debug == 0 )
    {
	$debug = 1
    }

    $version	and die "$VERSION $PROGNAME $CONTACT $URL\n";
    $helpHTML	and Help( undef, -html );
    $help       and Help();
    $debug	and $verb = 1;

    $selfTest	and SelfTest();


    $NO_LCD     = 0   unless defined $NO_LCD;
    $NO_SAVE    = 0   unless defined $NO_SAVE;
    $NO_EXTRACT = 0   unless defined $NO_EXTRACT;


    if ( defined $URL_REGEXP  and  @TAG_LIST )
    {
	die "You can't use both --Tag and --regexp options.";
    }

    if ( defined $PROXY )
    {
	$ARG = $PROXY;



	if ( not m,^http://, )
	{
	    $debug  and  print "$id: Adding http:// to proxy $PROXY\n";
	    $ARG = "http://" . $ARG;
	}

	if ( not m,/$, )
	{
	    $debug  and  print "$id: Adding trailing / to proxy $PROXY\n";
	    $ARG .= "/";
	}

	$PROXY = $ARG;
	$debug  and  print "$id: PROXY $PROXY\n";
    }


    if ( defined @TAG_LIST )
    {
	#   -s -t -n tag   --&gt; whoopos....


	if ( grep /^-/ , @TAG_LIST )
	{
	    die "$id: You have option in TAG_LIST: @TAG_LIST\n";
	}

	$TAG_REGEXP = '\btag(\d+):\s*(\S+)';
    }




    if	(
	    not @CFG_FILE
	    and ( @TAG_LIST or $URL_REGEXP )
	)
    {

	unless ( defined $MYWEBGET_PL_CFG )
	{
	    die "$id: No environment variable MYWEBGET_PL_CFG defined."
		, " Need --config"
		;
	}

	my $file = $MYWEBGET_PL_CFG;

	unless ( -r $file )
	{
	    die "$id: MYWEBGET_PL_CFG is not readable [$file]";
	}

	$verb  and  print "$id: Using default config file $file\n";

	push @CFG_FILE, $file;
    }



    $debug  and   @CFG_FILE  and  print "$id: Config file [@CFG_FILE]\n";
}


#font-lock * s/*/

# ****************************************************************************
#
#   DESCRIPTION
#
#       Find out the temporary directory
#
#   INPUT PARAMETERS
#
#	none
#
#   RETURN VALUES
#
#	$	temporary directory
#
# ****************************************************************************

sub TempDir ()
{
    my $id 	   = "$LIB.TempDir";

    local $ARG;

    if ( defined $TEMPDIR  and  -d $TEMPDIR)
    {
	$ARG = $TEMPDIR;
    }
    elsif ( defined $TEMP  and  -d $TEMP)
    {
	$ARG = $TEMP;
    }
    elsif ( -d "/tmp" )
    {
	$ARG = "/tmp";
    }
    elsif ( -d "c:/temp" )
    {
	$ARG = "c:/temp"
    }
    elsif ( -d "$HOME/temp" )
    {
	$verb and
	    print "$id: WARNING using HOME/tmp, make sure you have disk space";

	$ARG = "$HOME/temp";
    }
    else
    {
	die "$id:  Can't find temporary directory. Please set TEMPDIR."
    }

    if ( $ARG  and not -d  )
    {
	die "$id: Temporary directory found is invalid: [$ARG]";
    }

    s,[\\/]$,,;		# Delete trailing slash
    s,\\,/,g;		# Unix slashes in this Perl code


    $debug  and  print "$id: $ARG\n";

    $ARG;
}



# ****************************************************************************
#
#   DESCRIPTION
#
#       Return temporary process file
#
#   INPUT PARAMETERS
#
#	none
#
#   RETURN VALUES
#
#	$	temporary filename
#
# ****************************************************************************

sub TempFile ()
{
    my $id  = "$LIB.TempFile";

    my $ret = TempDir() . basename($PROGRAM_NAME) . "-" . $PROCESS_ID;

    $debug  and  print "$id: $ret\n";

    $ret;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#       Write file to stdout
#
#   INPUT PARAMETERS
#
#	$file
#
#   RETURN VALUES
#
#	none
#
# ****************************************************************************

sub Stdout ( $ )
{
    my $id    = "$LIB.Stdout";
    my($file) = @ARG;

    local *FILE;

    unless ( open FILE, "&lt; $file" )
    {
	warn "$id: Can't STDOUT $file $ERRNO";
    }
    else
    {
	print &lt;FILE&gt;;
	close FILE;
    }
}



# ****************************************************************************
#
#   DESCRIPTION
#
#       Fix the filename to correct OS version ( win32 /Cygwin / DOS )
#       This is needed when calling external programs that take file arguments.
#
#   INPUT PARAMETERS
#
#	$file
#
#   RETURN VALUES
#
#	$file	Converted file
#
# ****************************************************************************

sub MakeOSfile ( $ )
{
    my $id      = "$LIB.MakeOSfile";
    local($ARG) = @ARG;

    if ( $WIN32 )
    {
	if ( defined $SHELL  )
	{
	    $debug  and  print "$id: SHELL = $SHELL\n";

	    if ( $SHELL =~ /sh/i )  # bash.exe
	    {
		#	This is Win32/Cygwin, which needs c:/  --&gt; /cygdrive/c/

		if ( /^(.):(.*)/ )  #font s/
		{
		    $ARG = "/cygdrive/$1/$2";
		    s,\\,/,g;
		    s,//,/,g;
		}

	    }
	}
	else
	{
	    s,/,\\,g;		# Win32 likes backslashes more
	}
    }

    $debug  and  print "$id: $ARG\n";

    $ARG;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#       Return ISO 8601 date YYYY-MM-DD
#
#   INPUT PARAMETERS
#
#	$format	    [optional] If "-version", return in format YYYY.MMDD
#
#   RETURN VALUES
#
#	$str	    Date string
#
# ****************************************************************************

sub DateYYYY_MM_DD (; $)
{
    my $id       = "$LIB.DateYYYY_MM_DD";
    my ($format) = @ARG;


    my (@time)    = localtime(time);
    my $YY        = 1900 + $time[5];
    my ($DD, $MM) = @time[3,4];
#   my ($mm, $hh) = @time[1,2];

    $debug  and  print "$id: @time\n";

    #   Month(MM) counts from zero

    my $ret;

    if ( defined $format  and  $format eq -version )
    {
	$ret = sprintf "%d.%02d%02d", $YY, $MM + 1, $DD;
    }
    else
    {
	$ret = sprintf "%d-%02d-%02d", $YY, $MM + 1, $DD;
    }

    $debug  and  print "$id: RET $ret\n";

    $ret;

}


# ****************************************************************************
#
#   DESCRIPTION
#
#	Print varaibles in hash
#
#   INPUT PARAMETERS
#
#	$name	    name of the hash
#	%hash	    content of hash
#
#   RETURN VALUES
#
#	none
#
# ****************************************************************************

sub PrintHash ( $ % )
{
    my $id 	       = "$LIB.PrintHash";
    my ($name, %hash ) = @ARG;

    print "$id: hash [$name] contents\n";

    for my $key ( sort keys %hash )
    {
	my $val = $hash{ $key };
	printf "%-20s = %s\n", $key, $val;
    }

}

# ****************************************************************************
#
#   DESCRIPTION
#
#	Print download progress
#
#   INPUT PARAMETERS
#
#	$url	    Site from where to download
#	$prefix	    String to print
#	$index	    current count
#	$total	    total
#
#   RETURN VALUES
#
#	string	    Expanded path.
#
# ****************************************************************************

{
    my %staticDone;

sub DownloadProgress ($$ $$ $)
{
    my $id	    = "$LIB.DownloadProgress";
    my ( $site, $url, $prefix, $index, $total ) = @ARG;

    if ( $verb )
    {
	if ( $total &gt; 1 )
	{
	    printf $prefix .  " %3d%% (%2d/%d) "
		, int ( $index * 100 / $total )
		, $index
		, $total
		;
	}
	else
	{
	    unless ( exists $staticDone{$site}  )
	    {
		$staticDone{$site} = 1;
		$verb  and  print $prefix;
	    }
	}
    }

}}


# ****************************************************************************
#
#   DESCRIPTION
#
#	Expand given PATH by substituting any Environment variables in it.
#
#   INPUT PARAMETERS
#
#	$string	    Path information, like $HOME/.example
#
#   RETURN VALUES
#
#	string	    Expanded path.
#
# ****************************************************************************

sub ExpandVars ($)
{
    my $id	    = "$LIB.ExpandVars";
    local ( $ARG )  = @ARG;

    my ( $key, $value );
    my $orig = $ARG;

    #	We must substitute environment variables so that the
    #	longest are handled first: $FTP_DIR_THIS/here, is substituted /
    #	in wong order:
    #
    #	    FTP_DIR	 = one
    #	    FTP_DIR_THIS = two
    #
    #	    --&gt; one_THIS/here                 /

    my @keys = sort { length $b &lt;=&gt; length $a } keys %ENV;

    for $key ( @keys )
    {
	$value = $ENV{$key};

	if ( /$key/  and  $value ne "" )		#font s/
	{
	    $debug  and print  "$id $ARG substituting $value\n";

	    s/\$$key/$value/;                         #font s/;
	}
    }

    #	The env variables may contain leading slashes, get rid of them
    #
    #	[$ENV = /dir/ ]
    #
    #	$ENV/path   --&gt; /dir//path
    #

    s,//+,/,;

    $debug  and warn "$id:\t\t$orig ==&gt; $ARG\n";

    if ( /\$/ )
    {
	PrintHash( "ENV", %ENV  );
	die "$id: Expansion did not find variable for '${ARG}'\n";
    }


    $ARG;
}

# ****************************************************************************
#
#   DESCRIPTION
#
#	Evaluate perl code and return result.
#
#   INPUT PARAMETERS
#
#	$url	    text to put variable $url
#	$text       The text to be placed to variable $ARG
#	$code	    Perl code that can manipulate $ARG
#	$flag	    non-empty: Do not return empty values, if the perl
#		    code didn]t set ARG at all, then return original TEXT
#
#   RETURN VALUES
#
#	$text
#
# ****************************************************************************

sub EvalCode ($ $ ; $)
{
    my $id      = "$LIB.EvalCode";
    my ($url, $text, $code, $flag ) = @ARG;

    #	Variable $url is seen to CODE if it wants to use it

    local $ARG  = $text;
    eval $code;

    if ( $EVAL_ERROR )
    {
	warn "$id: eval-fail ARG [$ARG] CODE [$code] $EVAL_ERROR";
	$ARG = $text;
    }

    if ( not $ARG  and $flag )
    {
	$debug  and  print "$id: ARG [$ARG] is empty [$code]\n";
	$ARG = $text;
    }

    $ARG;
}

# ****************************************************************************
#
#   DESCRIPTION
#
#       Check if HTML::Parse and HTML::FormatText libraries are available
#
#   INPUT PARAMETERS
#
#       none
#
#   RETURN VALUES
#
#       0       Error
#       1       Ok, support present
#
# ****************************************************************************

sub IsLibHTML ()
{
    my $id       = "$LIB.IsLibHTML";
    my $error    = 0;
    $EVAL_ERROR  = '';

    local *LoadLib = sub ($)
    {
	my $lib = shift;

	eval "use $lib";

	if ( $EVAL_ERROR )
	{
	    warn "$id: $lib not available [$EVAL_ERROR]\n";
	    $error++;
	}
    };

    LoadLib( "HTML::Parse");
    LoadLib( "HTML::FormatText");


    return 0 if $error;
    1;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#       convert html into ascii
#
#   INPUT PARAMETERS
#
#       @lines
#
#   RETURN VALUES
#
#       @txt
#
# ****************************************************************************

{

    my $staticLibCheck = 0;
    my $staticLibOk    = 0;

sub Html2txt (@)
{
    my $id        = "$LIB.Html2txt";
    my (@list)    = @ARG;


    my @ret       = @list;

    unless ( $staticLibCheck )
    {
	$staticLibOk    = IsLibHTML();
	$staticLibCheck = 1;

	unless ( $staticLibOk )
	{
	    warn "$id: No HTML to TEXT conversion available.";
	}
    }

    if ( not @list )
    {
	$verb  and  print "$id: Empty content";
    }
    elsif ( $staticLibCheck )
    {
	my $formatter = new HTML::FormatText
			( leftmargin =&gt; 0, rightmargin =&gt; 76);

	# my $parser = HTML::Parser-&gt;new();
	# $parser-&gt;parse( join '', @list );
	# $parser-eof();

	# $HTML::Parse::WARN = 1;

	my $html = parse_html( join '', @list );

	$verb  and  print "$id: Making conversion\n";

	@ret = ( $formatter-&gt;format($html) );

	$html-&gt;delete();	# mandatory to free memory
    }

    @ret;
}}


# ****************************************************************************
#
#   DESCRIPTION
#
#	Return File content
#
#   INPUT PARAMETERS
#
#	$file
#
#   RETURN VALUES
#
#	(\@lines, $status)
#
# ****************************************************************************

sub FileRead ( $ )
{
    my $id   = "$LIB.FileRead";
    my $file = shift;

    my $status = 0;
    my @ret;
    local *FILE;

    unless ( open FILE, "&lt; $file" )
    {
	$status = $ERRNO;
	warn "$id: FILE [$file] $ERRNO";
    }
    else
    {
	@ret = &lt;FILE&gt;;
	close FILE;
    }

    $debug  and  print "$id: [$file] status [$status]\n";


    \@ret, $status;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#	Write File content
#
#   INPUT PARAMETERS
#
#	$file
#	@lines
#
#   RETURN VALUES
#
#	$status	    true, ERROR
#
# ****************************************************************************

sub FileWrite ( $ @)
{
    my $id              = "$LIB.FileWrite";
    my ($file, @lines ) = @ARG;

    my $status = 0;


    local *FILE;

    unless ( open FILE, "&gt; $file" )
    {
	$status = $ERRNO;
	warn "$id: FILE [$file] $ERRNO";
    }
    else
    {
	print FILE @lines;
	close FILE;
    }

    $debug  and  print "$id: [$file] status [$status]\n";

    $status;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#	Convert HTML file to text
#
#   INPUT PARAMETERS
#
#	$file
#
#   RETURN VALUES
#
#	$status
#
# ****************************************************************************

sub FileHtml2txt ($)
{
    my $id   = "$LIB.FileHtml2txt";
    my $file = shift;

    my( $lineArrRef, $status ) = FileRead $file;

    if ( $status )
    {
	$debug  and  print "$id: Can't convert\n";
    }
    else
    {
	my @text = Html2txt @$lineArrRef;
	$status = FileWrite $file, @text;
    }

    $debug  and  print "$id: [$file] status [$status]\n";

    $status;
}



# ****************************************************************************
#
#   DESCRIPTION
#
#	Append slash to the end. Optionally remove
#
#   INPUT PARAMETERS
#
#	$path		Add slash to path
#	$flag		[optional] Remove slash
#
#   RETURN VALUES
#
#	$path
#
# ****************************************************************************

sub Slash ($; $)
{
    my $id      = "$LIB.Slash";
    local $ARG  = shift;
    my $remove  = shift;

    if ( $remove )
    {
	s,/$,,;
    }
    {
	$ARG .= '/'  unless m,/$,;
    }

    $ARG;
}

# ****************************************************************************
#
#   DESCRIPTION
#
#	Split url to components. http://some.com/1/2page.html would be seen as
#
#	    http  some.com 1/2 page.html
#
#   INPUT PARAMETERS
#
#	$url
#
#   RETURN VALUES
#
#	@list	Component list
#
# ****************************************************************************

sub SplitUrl ($)
{
    my $id     = "$LIB.SplitUrl";
    local $ARG = shift;

    my($protocol, $site, $dir, $file ) = ("") x 4;

    $protocol = lc $1	    if m,^([a-z][a-z]+):/,i;
    $site     = lc $1	    if m,://?([^/]+),i;
    $dir      = lc $1	    if m,://?[^/]+(/.*/),i;
    $file     = lc $1	    if m,^.*/(.*),i;

    if ( $file  and  $file !~ /[.]/ )
    {
	$debug  and  print "$id: WARNING ambiguous [$ARG], dir or file?\n";

	unless ( $dir )
	{
	    $dir  = $file;
	    $file = "";
	}
    }

    $debug  and	 print "$id:"
	    , " PROTOCOL &lt;$protocol&gt;"
	    , " SITE &lt;$site&gt;"
	    , " DIR &lt;$dir&gt;"
	    , " FILE &lt;$file&gt;"
	    , "\n"
	    ;

    $protocol, $site, $dir, $file;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#	Return basename from URL. This drops the possible
#	filename from the end. The extra file is dtected
#	from the file extension, perriod(.)
#
#	http://some.com/~foo	    ok
#	http://some.com/foo	    ok treated as directory
#	http://some.com/page.html   nok
#
#   INPUT PARAMETERS
#
#	$base
#
#   RETURN VALUES
#
#	$string	    The url will not contain trailing slash
#
# ****************************************************************************

sub BaseUrl ($)
{
    my $id     = "$LIB.BaseUrl";
    local $ARG = shift;

    if ( m,/~[^/]+$, )
    {
	$debug  and  print "$id: ~foo\n";
	# ok
    }
    elsif ( m,^(.*/)([^/]+)$, )
    {
	my ( $base, $rest ) = ( $1, $2 );

	$debug  and  print "$id: [$base] [$rest]\n";

	$ARG = $base   if  $rest =~ /[.]/;
    }

    s,/$,,;

    $ARG;
}

# ****************************************************************************
#
#   DESCRIPTION
#
#	Return basename of the archive.
#
#	    file.tar,gz		=&gt; file
#	    file-1.2.tar.gz	=&gt; file-1.2
#	    file-1_2.tar.gz	=&gt; file-1.2
#
#   INPUT PARAMETERS
#
#	$file
#
#   RETURN VALUES
#
#	$string
#
# ****************************************************************************

sub BaseArchive ($)
{
    my $id     = "$LIB.BaseArchive";
    local $ARG = shift;

    if ( /^(.*-\d+[-_.]\d+[-_.\d]*)/ )
    {
	# delete last trailing - or . or _

	( $ARG = $1 ) =~ s/[-_.]$//;
    }

    s/_/-/g;

    $ARG;
}

# ****************************************************************************
#
#   DESCRIPTION
#
#	Return list of files recursing to ROOT directories.
#
#   INPUT PARAMETERS
#
#	$format	    -unix  or -win32, the Filename slash format
#	@roots	    List of roots to search.
#
#   RETURN VALUES
#
#	@list	    list of files
#
# ****************************************************************************

sub FileListRecursive ($@)
{


}


# ****************************************************************************
#
#   DESCRIPTION
#
#	Try to make sense of relative paths when Base is known.
#	This function is very simplistic.
#
#   INPUT PARAMETERS
#
#	$base
#	$relative
#
#   RETURN VALUES
#
#	$path
#
# ****************************************************************************

sub RelativePath ($ $)
{
    my $id     = "$LIB.RelativePath";
    my $base   = shift;
    local $ARG = shift;

    $base = Slash $base;

    my $ret = $base;

    unless ( $ARG )
    {
	$debug  and  print "$id: second arg is empty [$base]";
    }
    else
    {
	if ( m,^/.*, )	    # /root/somewhere/file.txt
	{
	    my ($proto, $site, $dir, $file) = SplitUrl $base;

	    $ret = "$proto://$site$ARG";

	}
	elsif ( m,^\./(.*), )	    # ./somewhere/file.txt
	{
	    $ret = $base . $1;
	}
	elsif ( m,^[^/\\#?=], )  # this/path/file.txt
	{
	    $ret = $base . $ARG;
	}
	else
	{
	    chomp;	# make warn display line number, remove \n
	    warn "$id:  ERROR Can't resolve relative $base + $ARG";
	}
    }

    $debug  and  print "$id: BASE $base ARG $ARG RET $ret\n";

    $ret;
}



# ****************************************************************************
#
#   DESCRIPTION
#
#	Return decompress command for file.
#
#   INPUT PARAMETERS
#
#	$file
#	$type	    -list	return listng command
#		    -extract	return unpack command
#
#   RETURN VALUES
#
#       lines as listed in file
#
# ****************************************************************************

sub FileDeCompressedCmd ($; $)
{
    my $id = "$LIB.FileDeCompressedCmd";

    local $ARG  = shift;
    my    $type = shift;

    $type = '-extract'	    unless defined $type;



    my $cmd;
    my $decompress;

    if ( /\.rar$/ )
    {
	 die "$id: $ARG Can't handle. Please contact maintainer $CONTACT";
    }

    if ( $type eq -extract )
    {
	if ( /\.(tar|tgz)/ )
	{
	    /\.(gz|tgz)$/i	and  $decompress = "gzip -d -c";
	    /\.(bzip|bz2)$/i	and  $decompress = "bzip -d -c";

	    $cmd = "$decompress $ARG | tar xvf -";
	}
	elsif ( /\.gz$/ )
	{
	    $cmd = "gzip -f -d $ARG";
	}
	elsif ( /\.(bz2|bzip)$/ )
	{
	    $cmd = "bzip -f -d $ARG";
	}
	elsif ( /\.zip$/ )
	{
	    $cmd = $decompress = "unzip -o $ARG";
	}
    }
    else
    {
	if ( /tar/ )
	{
	    SWITCH:
	    {
		/\.(gz|tgz)$/i	    and  $decompress = "gzip -d -c", last;
		/\.(bzip|bz2)$/i    and  $decompress = "bzip -d -c", last;
	    }

	    if ( defined $decompress )
	    {
		$cmd = "$decompress $ARG | tar tvf -";
	    }
	    else
	    {
		$cmd = "tar tvf $ARG";
	    }
	}
	elsif ( /\.zip$/ )
	{
	    $cmd = "unzip -l $ARG";
	}
	elsif ( /\.(bzip|bz2)$/ )
	{
	    $cmd = "bzip - $ARG";
	}
    }

    $debug  and  print "$id:\n\tARG = $ARG\n"
	    , "\tTYPE $type\n"
	    , "\tRET [$cmd]\n"
	    ;

    $cmd;
}



# ****************************************************************************
#
#   DESCRIPTION
#
#	Return decompress file listing
#
#   INPUT PARAMETERS
#
#	$file
#
#   RETURN VALUES
#
#	\@files	    Files from the archive
#	$error	    If contains "-noarchive" , then file is not archive.
#
# ****************************************************************************

sub FileDeCompressedListing ( $ )
{
    my $id   = "$LIB.FileDeCompressedListing";
    my $file = shift;

    $debug  and  print "$id: BEGIN $file CWD ", cwd(), "\n";


    my ($cmd, @result, $status);

    if ( -f $file )
    {
	$cmd    = FileDeCompressedCmd $file, -list ;

	$debug  and  print "$id: running [$cmd] CWD ", cwd(), "\n";

	@result = `$cmd`   if $cmd;

	$debug  and  print "$id: CMD [$cmd] =&gt; \n[@result]\n";
    }
    else
    {
    	$verb  and  warn "ERROR file not found ", cwd(), "$file";
	$status = -file-not-found;
    }



    my @ret	= ();
    local $ARG;

    if ( $status )
    {
	# Nothing to do, here was error
    }
    elsif  ( $file =~ /tar/ )
    {
	#   Get last elements in the line
	#
	#  ..  	   0 2000-11-18 16:18 semantic-1.3.2/
	#  ..  23688 2000-11-18 16:18 semantic-1.3.2/semantic-bnf.el
	#  ..  50396 2000-11-18 16:18 semantic-1.3.2/semantic.el
	#  ..  36176 2000-11-18 16:18 semantic-1.3.2/semantic-util.el
	#  ..  29717 2000-11-18 16:18 semantic-1.3.2/document.el

	for ( @result )
	{
	    my $file = (reverse split)[0];
	    chomp $file;

	    push @ret,  (reverse split)[0];
	}

	$debug  and  print "$id: TAR [@result]\n";

    }
    elsif ( $file =~ /zip/ )
    {
	 #  Length    Date    Time    Name
	 #  ------    ----    ----    ----
	 #    4971  03-22-00  21:14   1/gnus-ml.el
	 #  	 0  10-03-99  01:33   tmp/1/tpu/
	 #  ------                    -------
	 #   25036                    8 files

	for ( @result )
	{
	    my @split = reverse split;
	    chomp $split[0];

	    push @ret,  $split[0]    if   @split == 4;
	}

	$debug  and  print "$id: ZIP [@result]\n";
    }
    else
    {
	$debug  and  print "$id: -noarchive $file\n";
	$status = -noarchive;
    }

    $debug  and  print "$id: RET $file [@ret]\n";


    \@ret, $status;
}



# ****************************************************************************
#
#   DESCRIPTION
#
#	Return the subdirectory where the files are in compressed archive.
#	There may not be any directory or there may be several direcotries
#	that do not share one ROOT directory.
#
#   INPUT PARAMETERS
#
#	$file
#
#   RETURN VALUES
#
#	$dir	    The topmost COMMON root directory. If not all files
#		    have common root, return nothing.
#
#	$status	    -noarchive	    The file was not archive.
#	\@file	    reference to file list
#
# ****************************************************************************

sub FileDeCompressedRootDir ( $ )
{
    my $id   = "$LIB.FileDeCompressedRootDir";
    my $file = shift;

    $debug  and  print "$id: BEGIN $file CWD ", cwd(), "\n";


    my ( $fileArrRef, $status ) = FileDeCompressedListing $file;

    #	If there is directory it must be in front of every file


    local $ARG;
    my %seen  = ();
    my @nodir = ();

    for ( @$fileArrRef  )
    {
	if (  m,^([^/]+)/, )
	{
	    $seen{ $1 } = 1;
	}
	else
	{
	    push @nodir, $ARG;
	}
    }


    my @roots  = keys %seen;
    my $ret;


    if ( @roots == 1  and  @nodir == 0 )
    {
	$ret = $roots[0]
    }


    $debug  and  print "$id: ROOT DIR LIST [@roots] no-dirs [@nodir]\n";

    $ret, $status, $fileArrRef ;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#	If archive does not have root directory, return the
#	filename which is bet used for archive root dir.
#
#	    package.tar.gz --&gt; package-YYYY.MMDD
#
#   INPUT PARAMETERS
#
#	$file
#
#   RETURN VALUES
#
#	$root	    Returned, If archive does not have natural ROOT
#
# ****************************************************************************

sub FileRootDirNeedeed ( $ )
{
    my $id   = "$LIB.FileRootDirNeedeed";
    my $file = shift;

    $debug  and  print "$id: BEGIN $file CWD ", cwd(), "\n";


    my ($root, $status, $fileArrRef) = FileDeCompressedRootDir $file;

    local $ARG;


    if ( $status eq -noarchive )	    # Single file.txt.gz, not package
    {
	$debug  and  print "$id: -noarchive $file\n";
	$ARG = '';
    }
    elsif ( @$fileArrRef == 0 )
    {
	$debug  and  print "$id: EMPTY $file\n";
	$ARG = '';
    }
    elsif ( @$fileArrRef == 1 )
    {
	$debug  and  print "$id: SINGLE FILE $file\n";
	$ARG = '';
    }
    elsif ( $root eq '' )
    {
	$ARG      = basename $file;
	my $base  = BaseArchive $ARG;


	#   If there is no numbers left, assume that we got barebones
	#   and not name like "package-1.11". Add date postfix

	unless ( $base =~ /\d/ )
	{
	    $base .= "-" . DateYYYY_MM_DD -version ;
	}

	$ARG = $base;
    }

    $debug  and  print "$id: $file --&gt; need dir [$ARG]\n";

    $ARG;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#	Create root directory if it is necessary in order to unpack
#	the file. If the archive does not contain ROOT, contruct one
#	from the filename and current date.
#
#	If directory was created or it already exists, return full path
#
#   INPUT PARAMETERS
#
#	$file
#	$path	    Under this directory the creation
#	$opt	    -rm    Delete previous unpack directory
#
#   RETURN VALUES
#
#	$path	    If directory was created
#
# ****************************************************************************

sub FileRootDirCreate ( $ $; $ )
{
    my $id   = "$LIB.FileRootDirCreate";
    my ($file, $path, $opt) = @ARG;

    not defined $opt  and  $opt = '';



    $debug  and  print "$id: BEGIN $file PATH $path\n";

    local $ARG = FileRootDirNeedeed $file;

    my $ret = '';

    if ( $ARG )
    {
	$ARG = "$path/$ARG";

	if ( -e )
	{
	    $verb  and  print "$id: Unpack dir already exists $ARG\n";

	    if ( $opt =~ /rm/i )
	    {
		$verb  and  print "$id: deleting old unpack dir\n";

		unless ( rmtree($ARG, $debug) )
		{
		    warn "$id: Could not rmtree() $ARG\n";
		}
	    }
	}


	unless ( -e )
	{
	    unless ( $test )
	    {
		mkpath( $ARG )  or  die "$id: mkdir() fail $ARG $ERRNO";

		$verb  and  warn "$id: WARNING archive $file"
			, " has no root-N.NN directory."
			, " Report this to archive maintainer. CREATED $ARG"
			, "\n"
			;
	    }
	}

	$ret = $ARG;
    }

    $debug  and  print "$id:\n\tFILE $file\n"
	, "\tPATH $path\n"
	, "\tRET --&gt; created [$ret]\n"
	;

    $ret;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#	Unpack list of files recursively (If package contains more
#       archives)
#
#   INPUT PARAMETERS
#
#	\@array	    List of files
#	\%hash	    Unpack command hash table: REGEXP =&gt; COMMAND, where
#		    %s is substituted for filename
#	$check	    "-noroot", will not check the archive content
#	$opt	    "-rm", will remove any existing unpack dir
#
#   RETURN VALUES
#
#       none
#
# ****************************************************************************

sub Unpack($ $; $ $);    # must be introdced due to recursion

sub Unpack ($ $; $ $)
{
    my $id = "$LIB.Unpack";
    my ( $filesArray, $cmdHash, $check, $opt ) = @ARG;

    $check = 1	 if  not defined $check;
    $check = 0   if  $check eq -noroot;
    $opt   = ''  if  not defined $opt;


    local $ARG;
    my $origCwd = cwd();

    $debug  and  print "$id: entry cwd = $origCwd OPT [$opt]\n";




    my @array = sort { length $b &lt;=&gt; length $a } keys %$cmdHash;
    $debug  and  print "$id: SORTED decode array @array\n";


    for ( @$filesArray )
    {
	$debug  and warn "$id: unpacking $ARG\n";

	if ( -d )
	{
	    $verb  and  print "$id: $ARG is directory, skipped.\n";
	    next;
	}
	elsif ( not -f )
	{
	    $verb and  print "$id: $ARG is not a file (not exist), skipped.\n";
	    next;
	}



	#   The filename may look lik test/tar.gz

	my $gocwd = dirname($ARG)  || '.' ;
	chdir $gocwd or  die "$id: [for] Can't chdir [$gocwd] $ERRNO";


	#   Check only archives that do not contains some kind
	#   of numbering for missing ROOT directories.

	my $cwd   = cwd();
	my $chdir = 0;
	my $newDir;

	my $file = basename $ARG;

	# ............................................ check ...
	# Must contain root directory in archive
	# We check every archive. Regexp \d would have
	# skipped names looking like package-1.34.tar.gz

	if ( $check  )  #    and  not /-[\d]/ )    #font s/
	{
	    $debug  and  print "##\n";

	    $newDir = FileRootDirCreate basename($ARG), $cwd, $opt;

	    $debug  and  print "## $newDir\n";

	    if ( $newDir )
	    {
		$debug  and  print "$id: cd newdir $newDir\n";

		unless ( chdir $newDir )
		{
		    print "$id: ERROR chdir $newDir $ERRNO\n";
		    next;
		}

		$file = "../$file";
		$chdir = 1;
	    }
	}

	# ........................................... unpack ...

	$debug  and   print "&gt;&gt;\n";

	my $cmd = FileDeCompressedCmd $file;

	$debug  and  print "$id: unpacking CWD ", cwd(), " [$cmd]\n";

	my @response;
	@response = `$cmd`    unless $test;

	print "@response\n"   if $verb;

	# ........................................ recursive ...

	for my $entry ( @response )  # Make this recursive
	{
	    local $ARG = $entry;
	    chomp;

	    if ( /\.(bz2|gz|z|zip)$/i )  # s/
	    {
		$debug  and  print "$id: &gt;&gt; RESCURSIVE [$ARG]\n";

		Unpack( [ $ARG ], $cmdHash, -noroot, $opt );
	    }
	}


	chdir $cwd    if  $chdir;   # Get back to original

    }

    $debug  and  print "EXIT chdir $origCwd\n";

    chdir $origCwd  or  die "$id: [exit] Can't chdir [$origCwd] $ERRNO";

}



# ****************************************************************************
#
#   DESCRIPTION
#
#	Read directory content
#
#   INPUT PARAMETERS
#
#	$path
#
#   RETURN VALUES
#
#	@	list of files
#
# ****************************************************************************

sub DirContent ($)
{
    my $id	 = "$LIB.DirContent";
    my ( $path ) = @ARG;

    $debug and warn "$id: $path\n";

    local *DIR;

    unless ( opendir DIR, $path )
    {
	print "$id: can't read $path $ERRNO\n";
	next;
    }

    my @tmp = readdir DIR;
    closedir DIR;

    $debug &gt; 1 and warn "$id: @tmp";

    @tmp;
}




# ****************************************************************************
#
#   DESCRIPTION
#
#	Scan until valid tag line shows up. Return line if it is under the
#	TAG
#
#   INPUT PARAMETERS
#
#	$line		    line content
#	$tag		    Tag name to look for
#	$reset		    If set, do nothing but reset state variables.
#			    You should call with this if you start a new round.
#
#   RETURN VALUES
#
#	($LINE, $stop)	    The $LINE is non-empty if it belongs to the TAG.
#			    The $stop flag is non-zero if TAG has ended.
#
# ****************************************************************************

{
    my
    (
	  $staticTagLevel
	, $staticTagName
	, $staticTagFound
    );

sub TagHandle ($$ ; $)
{
    my $id 	    = "$LIB.TagHandle";

    local $ARG		    = shift;
    my ( $tag , $reset)	    = @ARG;

    # ........................................................ reset ...

    if ( $reset )
    {
	$debug   and  print "$id: RESET\n";
	$staticTagLevel = $staticTagName = $staticTagFound = "";
	return $ARG;
    }

    # ...................................................... tag ...

    my $stop;

    #	The line may have multiple tags and the $1 is number, second
    #	is the tag name. However we can't put them in that order
    #	to the hash, because the number is "key". Use reverse here
    #
    #	    tag2: A  tag2: B
    #
    #	    2 =&gt; A
    #	    2 =&gt; B
    #	    |
    #	    The key, only last would be in hash

    my %choices = reverse /$TAG_REGEXP/go;

    if( $debug  and  keys %choices &gt; 0   )
    {
	print "$id: TAG CHOICES: ", join( ' ', %choices), "\n"
    }

    unless ( $staticTagFound )
    {
        while ( my($tagN, $tagNbr) = each %choices )
        {
	    if ( $debug and $tagNbr )
	    {
		print "$id: [$tagNbr] $tagN eq $tag\n";
	    }

	    if ( $tagNbr  and   $tagN eq $tag )
	    {
		$staticTagLevel  = $tagNbr;
		$staticTagName   = $tagN;
		$staticTagFound  = 1;

		$debug and warn "$id: TAG FOUND [$staticTagName] $ARG\n"
	    }
	}

	$ARG = ""  unless $staticTagFound;	# Read until TAG
    }
    else
    {
	#   We're reading lines after the tag was found.
	#   Terminate teminate on next found tag name

        while ( my($tagN, $tagNbr) = each %choices )
        {
	    if ( $tagNbr  and  $tagNbr &lt;= $staticTagLevel )
	    {
		$debug and print "$id: End at [$staticTagName] $ARG\n";
		$stop = 1;
	    }
	}
    }

    $ARG, $stop;

}}



# ****************************************************************************
#
#   DESCRIPTION
#
#	Handle Local directory change and die if can't checnge to
#	directory.
#
#   INPUT PARAMETERS
#
#	$dir	    Where to chdir
#	$make	    Flag, if allowed to create directory
#
#   RETURN VALUES
#
#       none
#
# ****************************************************************************

sub DirectiveLcd ($;$)
{
    my $id 	  = "$LIB.DirectiveLcd";
    my ( $dir , $mkdir ) = @ARG;

    my $lcd  = ExpandVars $dir;

    unless ( -d $lcd )
    {
	not $mkdir  and  die "$id: [$dir] =&gt; lcd [$lcd] is not a directory";

	$verb  and  warn "$id: Creating directory $lcd";

	mkpath( $lcd, $verb) or die "$id: mkpath $lcd failed $ERRNO";
    }


    $debug	    and  print "$id: chdir $lcd\n";
    chdir $lcd	    or   die   "$id: chdir $lcd $ERRNO";

}


# ****************************************************************************
#
#   DESCRIPTION
#
#	Examine list of files and return the newest file that match FILE
#	the idea is that we divide the filename into 3 parts
#
#	    PREFIX VERSION REST
#
#	So that for example filename
#
#	    emacs-20.3.5.1-lisp.tar.gz
#
#	is exploded to parts
#
#	    emacs -20.3.5.1- lisp.tar.gz
#
#	After this, the VERSION part is examined and all the numbers from
#	it are read and converted to zero filled keys, so that sorting
#	between versions is possible:
#
#	    (20 3 5 1) --&gt; "0020.0003.0005.0001"
#
#	A hash table for each file is build according to this version key
#
#	    VERSION-KEY =&gt; FILE-NAME
#
#	When we finally sort the has by key, we get the latest version number
#	and the associated file.
#
#   INPUT PARAMETERS
#
#	$file	    file to use as base
#	\@files	    list of files
#
#   RETURN VALUES
#
#	$file	    File that is newest, based on version number.
#
# ****************************************************************************

sub LatestVersion ( $ $ )
{
    my $id 		  = "$LIB.LatestVersion";
    my ( $file , $array ) = @ARG;

    #	APACHE project stupidly uses underscores in filenames:
    #	apache_1_3_9_win32.exe
    #

    local $ARG = $file;
    my $ret    = $file;

    # ................................................ write regexps ...

    #	NN.NN   YYYY-MM-DD
    #	1.2beta23
    #	1.1-beta1
    #	1.1a
    #
    #	Prevent 1.1.tar.gz --&gt; "1.1.t" with negative lookahead

    my $comp    = '(?!(?i)tar|gz|bzip|bz2|tgz|zip|rar|z$)';
    my $add     = '(?:-?(?:alpha|beta)\d*|' . $comp . '[a-z])';
    my $regexp  = '^(\\D+)([-_][-_\\d.]*\\d' . $add . '?)(\\S+)';

    $debug   and
	print "$id: file [$file] array [@$array] REGEXP /$regexp/\n";

    # .......................................................... sub ...

    my ( %hash, %hash2, $max );

    local *VersionPush = sub ( $ $ )
    {
	local $ARG   = shift;	    # filename
	my $verStr   = shift;

	my $key = "";
	my @v   = /(\d+)/g ;

	if ( $verStr =~ /([a-z])$/ )	#   "1.1a"
	{
	    #  1.1a	 =&gt; 1.1.97  ,use ascii code
	    #  1.1   =&gt; 1.1.0

	    push @v, ord $1;	# get character ASCII code
	}


	$debug  and  print "$id: [Version] \@v = @v\n";

	#	Record how many separate digits we find.

	$max = @v	    if @v &gt; $max;

	#	fill until 8 version digit elements in array

	push @v, 0	    while @v &lt; 8 ;

	for my $version ( @v )
	{
	    #	1.0 --&gt; 0001.0000.0000.0000.0000.0000
	    $key .= sprintf "%015d.", $version;
	}

	$hash  { $key  } = $ARG;
	$hash2 { $v[0] } = $ARG;
    };

    # .......................................................... sub ...

    local *DebugHash = sub ()
    {
	if ( $debug &gt; 1 )
	{
	    while ( my($key, $val) = each %hash )
	    {
		printf "$id: HASH1 $key =&gt; $val\n";
	    }

	    while ( my($key, $val) = each %hash2 )
	    {
		printf "$id: HASH2 $key =&gt; $val\n";
	    }
	}
    };

    # .......................................................... sub ...

    local *ParseVersion = sub ($ $ $)
    {
	my ( $pfx, $post, $ver) = @ARG;
	my $ret;

	#   If there were date based versions:
	#
	#	wemi-199802080907.tar.gz
	#	wemi-19980804.tar.gz
	#	wemi-199901260856.tar.gz
	#	wemi-199901262204.tar.gz
	#
	#   Then sort directly by the %hash2, which only contains direct
	#   NUMBER key without prefixed zeroes. For multiple numbers we
	#   sort according to %hash

	my @try;

	if ( $max == 1 )
	{
	    @try  = sort  { $b &lt;=&gt; $a } keys %hash2;
	    %hash = %hash2;
	}
	else
	{
	    @try = sort { $b cmp $a } keys %hash;
	}


	if ( $debug )
	{
	    warn "$id: Choices: $ver $pfx.*$post\n";

	    for my $arg ( @try )
	    {
		print "\t$hash{$arg}\n";
	    }
	}

	#   If SINGLE answer, then use that. Or if we grepped versioned
	#   files, take the sorted one from the beginning

	if ( @try  )
	{
	    $ret = $hash{ $try[0] };
	}

	$ret;
    };

    # ........................................... search version [1] ...


    if ( /$regexp/o  )
    {
	my $pfx	 = $1;
	my $ver	 = '[-_]([-_\d.]+ ' . $add . '?)';
	my $post = "$3\$";		    #   Add anchor too

	$debug  and  print "$id: PFX: $pfx POSTFIX: $post\n";

        # .................................................. arrange ...
	# If there is version numbers, then sort all according
	# to version.

	for ( @$array )
	{
	    unless ( /$pfx.*$post/  and  /$regexp/o )
	    {
		$debug  and  print "$id: REJECTED\t\t$ARG\n";
		next;
	    }

	    my ($BEG, $vver, $END) = ($1, $2, $3);

	    $debug  and  print "$id: MATCH: $BEG $vver $END\n";

	    VersionPush( $ARG, $vver);

	}

	DebugHash();
	$ret = ParseVersion( $pfx, $post, $ver );

    }
    elsif ( /(.*)-[\d.]+$/ )
    {
	$debug  and  print "$id: plan B, non-standard version-N.NN";

	my $pfx	 = $1;
	my $ver	 = '(-[\d.]+)$';
	my $post = "";

	$debug  and  print "$id: PFX: $pfx POSTFIX: $post\n";

	for ( @$array )
	{
	    unless ( /$pfx.*$ver/ )
	    {
		$debug  and  print "$id: REJECTED\t\t$ARG\n";
		next;
	    }

	    my ($BEG, $vver) = ($1, $2);

	    $debug  and  print "$id: MATCH: $BEG $vver\n";

	    VersionPush( $ARG, $vver);
	}

	DebugHash();
	$ret = ParseVersion( $pfx, $post, $ver );

    }
    else
    {
	$debug  and  print "$id: Unknown file version format. Cannot parse.\n";
    }


    $debug  and  warn "$id: RETURN $file --&gt; [$ret]\n";

    $ret eq ''	    and die "$id: Internal error, Run with debug on.";

    $ret;
}

# ****************************************************************************
#
#   DESCRIPTION
#
#	Make latest filename with possible version numbers
#
#   INPUT PARAMETERS
#
#	$file	    Template, how the file looks like
#	@	    Array of possible verion numbers
#
#   RETURN VALUES
#
#	@	    Versioned files
#
# ****************************************************************************

sub MakeLatestFiles ( $ @ )
{
    my $id       = "$LIB.MakeLatestFiles";
    local $ARG   = shift;
    my @versions = @ARG;

    my @ret;

    if ( /^(.*?)-([\d.]+[\d])(.*)/ )
    {
	my ( $pre, $middle, $rest ) = ( $1, $2,  $3 );

	$debug  and  print "$id: Exploded [$pre] [$middle] [$rest]\n";

	for my $ver ( @versions )
	{
	    my $file = $pre . "-" . $ver . $rest;
	    push @ret, $file;
	}
    }
    else
    {
	$verb  and  print "$id:  Can't parse version from FILE $ARG\n";

	#   Suppose that all the files in @versions are versioned
	#
	#   file.txt-1.2  file.txt-1.3   and the model file was
	#   file.txt


	@ret = ( LatestVersion $versions[0], \@versions );
    }

    $debug  and  print "$id: FILE $ARG RET =&gt; [@ret]\n";

    @ret;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#       Seelct file or files from LIST. GETFILE and REGEXP are
#	mutually exclusive
#
#   INPUT PARAMETERS
#
#	$regexp	    Select files according to regexp.
#	$regexpNo   Files not to match after REGEXP
#
#	$getFile    If newest file is wanted, here is sample.
#		    If this variable is empty; then no newest file is searched.
#
#	@	    candidate file list
#
#   RETURN VALUES
#
#	@	    List of selected files
#
# ****************************************************************************

sub FileListFilter ( $ $ @)
{
    my $id 			    = "$LIB.FileListFilter";
    my ( $regexp, $regexpNo, $getFile, @list ) = @ARG;

    $debug  and  print "$id: INPUT REGEXP [$regexp]"
	, " REGEXPNO [$regexpNo]"
	, " GETFILE  [$getFile]"
	, " LIST     [@list]"
	, "\n"
	;

    # ......................................................... args ...

    if ( $regexp )
    {
	@list = sort grep /$regexp/, @list;
    }
    else
    {
	my $name = basename $getFile;
	my $file = LatestVersion $name, \@list;

	if ( $verb )
	{
	    print "$id: ... Getting latest version: $file DIR: ", cwd(), "\n";
	}

	@list = ( $file );
    }


    if ( $regexpNo  and  @list )
    {
	my @new = grep ! /$regexpNo/, @list;

	$debug  and  print "$id: [$regexpNo] FILTERED "
		, join(' ', grep /$regexpNo/, @list), "\n"
		;


	if ( $verb  and  not @new )
	{
	    print "$id: WARNING regexpNo [$regexpNo] rejected everything\n";
	}

	@list = @new;
    }


    $debug  and  print "$id: RET [@list]\n";

    @list;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#       Get file via FTP
#
#   INPUT PARAMETERS
#
#	$site	    Dite to connect
#	$path	    dir in SITE
#
#	$getFile    File to get
#	$saveFile   File to save on local disk
#	$regexp
#	$regexpNo
#
#	$firewall
#
#	$new	    Flag, Should only the newest file retrieved?
#	$stdout	    Print to stdout
#
#   RETURN VALUES
#
#	()	RETURN LIST whose elements are:
#
#	$stat   Error reason or "" =&gt; ok
#	@	list of retrieved files
#
# ****************************************************************************

sub UrlFtp( % )
{
    my $id                = "$LIB.UrlFtp";

    my %arg = @ARG;

    # ......................................................... args ...

    #	check mandatory

    not exists $arg{site}		    and  die "$id: SITE missing";
    not exists $arg{path}		    and  die "$id: PATH missing";
    not exists $arg{getFile}		    and  die "$id: FILE missing";
    not exists $arg{saveFile}		    and  die "$id: SAVE missing";

    #	Defaults. Note: login 'ftp' is still not known to every
    #	FTP server.

    not $arg{login}	and  $arg{login} = 'anonymous';
    not $arg{pass}	and  $arg{pass}  = 'nobody@example.com';

    #	Read values

    my $url			= $arg{url};
    my $site			= $arg{site};
    my $path			= $arg{path};
    my $getFile			= $arg{getFile};
    my $saveFile		= $arg{saveFile};
    my $regexp			= $arg{regexp};
    my $regexpNo		= $arg{regexpNo};
    my $firewall		= $arg{firewall};
    my $login			= $arg{login};
    my $pass			= $arg{pass};
    my $new			= $arg{new}           || 0;
    my $stdout			= $arg{stdout}        || 0 ;
    my $conversion		= $arg{conversion}    || '';
    my $rename			= $arg{rename}        || '';

    # ............................................ private functions ...

    my @files;

    local *PUSH = sub ($)
    {
	local ( $ARG ) = @ARG;

	if ( $stdout )
	{
	    Stdout $ARG;
	}
	else
	{
	    unless ( m,[/\\], )
	    {
		$ARG = cwd() . "/" . $ARG ;
	    }

	    push @files, $ARG   if not $stdout;
	}
    };

    # ............................................ private variables ...


    my $timeout	       = 120;
    my $singleTransfer;

    if ( (not defined $regexp  or  $regexp eq '') and ! $new )
    {
	$singleTransfer = 1;
    }

    local $ARG;


    $stdout   and  $saveFile = TempFile();

    if ( $debug )
    {
	print "$id:\n"
	    , "\tsingleTransfer: $singleTransfer\n"
	    , "\tSITE        : $site\n"
	    , "\tPATH        : $path\n"
	    , "\tLOGIN       : $login PASS $pass\n"
	    , "\tgetFile     : $getFile\n"
	    , "\tsaveFile    : $saveFile\n"
	    , "\trename      : $rename\n"
	    , "\tconversion  : $conversion\n"
	    , "\tregexp      : $regexp\n"
	    , "\tregexp-no   : $regexpNo\n"
	    , "\tfirewall    : $firewall\n"
	    , "\tnew         : $new\n"
	    , "\tcwd         : ", cwd(), "\n"
	    , "\tOVERWRITE   : $OVERWRITE\n"
	    , "\tSKIP_VERSION: $SKIP_VERSION\n"
	    , "\tstdout      : $stdout\n"
	    ;
    }

    $verb  and print
	   "$id: Connecting to ftp://$site$getFile --&gt; $saveFile\n";

    $debug and print "$id:\n"
	   , "REGEXP: $regexp \n"
	   , "LOGIN : $login\n"
	   , "PASSWD: $pass\n"
	   , "SITE  : $site\n"
	   , "PATH  : $path\n"
	   ;

    #	One file would be transferred, but it already exists and
    #	we are not allowed to overwrite --&gt; do nothing.

    if ( $singleTransfer  and  -e $saveFile
	 and  not $OVERWRITE
	 and  not $stdout
       )
    {
	$verb and print "$id: [ignored, exists] $saveFile\n";
	return;
    }

    # .................................................. make object ...

    my $ftp;

    if ( $firewall ne '' )
    {
        $ftp = Net::FTP-&gt;new
        (
            $site,
            (
                Firewall =&gt; $firewall,
                Timeout  =&gt; $timeout
            )
        );
    }
    else
    {
        $ftp = Net::FTP-&gt;new
        (
            $site, ( Timeout  =&gt; $timeout )
        );
    }

    unless ( defined $ftp )
    {
	print "$id: Cannot make route to $site $ERRNO\n";
	return;
    }

    # ........................................................ login ...

    $debug  and print "$id: Login to $site ..\n";

    unless ( $ftp-&gt;login($login, $pass) )
    {
        print  "$id: Login failed $login, $pass\n";
	goto QUIT;
    }

    $ftp-&gt;binary();


    my $cd = $path;
    $cd = dirname $path	    unless $path =~ m,/$, ;

    if ( $cd ne '' )
    {
	unless ( $ftp-&gt;cwd($cd) )
	{
	    print "$id: Remote cd $cd failed [$path]\n";
	    goto QUIT;
	}
    }

    # .......................................................... get ...

    my $stat;

    $ftp-&gt;binary();
    $ftp-&gt;hash( $verb ? "on" : undef );     # m"

    if ( $singleTransfer )
    {
	$verb  and  print "$id: Getting file... $getFile\n";   # m:

	unless ( $ftp-&gt;get($getFile, $saveFile) )
	{
	    warn  "$id: ** ERROR $getFile $ERRNO";
	}
	else
	{
	    PUSH ($saveFile);
	}
    }
    else
    {
	my (@list, $i);

	$verb  and print "$id: Getting list of files $site ...\n";

	$i    = 0;

	$debug  and warn "$id: Running ftp dir ls()\n";

	@list = $ftp-&gt;ls();
	@list = FileListFilter $regexp, $regexpNo, $getFile, @list;

	$debug  and  warn "$id: List length ", scalar @list, " --&gt; @list\n";


	if ( $verb  and not @list )
	{
	    print "$id: No files to download."
		, " Run with debug to investigate the problem.\n"
		;
	}

	for ( @list )
	{
	    $i++;

	    DownloadProgress $site . $cd, $ARG, "$id: ...", $i, scalar @list;

	    my $saveFile = $ARG;
	    $saveFile    = TempFile()   if $stdout;


	    if ( $rename )
	    {
		$saveFile = EvalCode $url, $saveFile, $rename
	    }


	    $verb  and  print " $ARG [$saveFile]\n";


	    unless ( $stdout )
	    {

		$debug and  print "$id: file on disk? [$ARG] [$saveFile] .. "
		    , -e($ARG) ? "[yes]" : "[no]"
		    , " empty? .. "
		    , -z($ARG) ? "[yes]" : "[no]"
		    , "\n"
		    ;

		if ( -e  and  not -z )
		{
		    if ( $SKIP_VERSION  and  /-\d[\d.]*\D+/ )
		    {
			$verb and print "$id: [already on disk] $ARG\n";
			next;
		    }
		    elsif ( not $OVERWRITE )
		    {
			$verb and print "$id: [already on disk] $ARG\n";
			next;
		    }
		}
	    }


	    unless ( $stat = $ftp-&gt;get($saveFile) )
	    {
		print "$id: ... ** error $ARG $ERRNO $stat\n";
	    }
	    else
	    {
		PUSH ($saveFile);
	    }
	}
    }


    QUIT:
    {
	$ftp-&gt;quit() if defined $ftp;
    }

    ($stat, @files);
}



# ****************************************************************************
#
#   DESCRIPTION
#
#       Try to find the latest version bumber from the page.
#	Normally indicated by "The latest version of XXX is N.N.N"
#
#   INPUT PARAMETERS
#
#	$	String, The Url page
#	$	[optional] regexp, what words to lok for
#
#   RETURN VALUES
#
#	%	ver =&gt; string, List of versions and text matches
#
# ****************************************************************************

sub UrlHttPageParse ( $ ; $ )
{
    my $id	= "$LIB.UrlHttpPageParse";
    local $ARG	= shift;
    my $regexp  = shift;

    my %hash;

    if ( defined $regexp  and  $regexp ne '' )
    {

	while ( /$regexp/g )
	{
	    $hash{ $2 } = $1
	}
    }
    elsif ( /(latest.*?version.*?\b([\d][\d.]+).*)/ )
    {
	$debug   and  print "$id: Using DEFAULT REGEXP\n";
	$hash{ $2 } = $1;
    }

    unless ( scalar(keys %hash) )
    {
	print "$id: ERROR version regexp didn't find versions [$regexp].",
	    "Please define or check &lt;vregexp:&gt;\n";
    }

    $debug  and  print "$id: RET regexp = [$regexp] HASH = ["
	, join ( ' =&gt; ', %hash)
	, "]\n"
	;

    %hash;
}

# ****************************************************************************
#
#   DESCRIPTION
#
#	Parse all HREFs in the page and return the locations.
#
#   INPUT PARAMETERS
#
#	$content    The html page
#	$regexp	    [optional] Return only HREFs matching regexp.
#
#   RETURN VALUES
#
#	@urls
#
# ****************************************************************************

sub UrlHttpParseHref ($ ; $)
{
    my $id     = "$LIB.UrlHttpParseHref";
    local $ARG = shift;
    my $regexp = shift;

    my @ret;

    while ( /HREF\s*=\s*\"([^\"&gt;]+)\"/ig )
    {
	my $file = $1;

	if ( $file =~ /^#/ )
	{
	    $debug  and  print "$id:  FILTERED [#] $file\n";
	    next;
	}

	if ( $regexp ne ''  and  $file !~ /$regexp/ )
	{
	    $debug  and  print "$id:  FILTERED REGEXP $file\n";
	    next;
	}

	if ( $file =~ m,^\?|/$|mailto, )
	{
	    $debug  and  print "$id:  FILTERED OTHER  $file\n";
	    next;
	}

	push @ret, $file;
    }

    $debug  and  print "$id: EXIT, REGEXP = [$regexp] RET = [@ret]\n";

    @ret;
}

# ****************************************************************************
#
#   DESCRIPTION
#
#       If you connect to http page, that shows directory, this
#	Function tries to parse the HTML and extract the filenames
#
#   INPUT PARAMETERS
#
#	$	String, The Url page
#	$	[optional] boolean, if non-zero, filter out
#		non-interesting files like directories.
#
#   RETURN VALUES
#
#	@	List of files
#
# ****************************************************************************

sub UrlHttpDirParse ( $ ; $ )
{
    my $id	= "$LIB.UrlHttpDirParse";
    local $ARG	= shift;
    my $filter	= shift;


    $debug  and  print "$id: $filter\n";

    my @files;

    if ( /Server:\s+apache/i )
    {
	#   Date: Wed, 16 Feb 2000 16:26:08 GMT
	#   Server: Apache/1.3.11 (Win32)
	#   Connection: close
	#   Content-Type: text/html   m:
	#
	# &lt;IMG SRC="/icons/folder.gif" ALT="[DIR]"&gt; &lt;A HREF="/"&gt;
	# &lt;IMG SRC="/icons/image2.gif" ALT="[IMG]"&gt; &lt;A HREF="apache_pb.gif"&gt;
	# &lt;IMG SRC="/icons/text.gif" ALT="[TXT]"&gt; &lt;A HREF="index.html.ca"&gt;

	#  Anything special to know? No?
    }

    #	Filter out directories and non interesting files
    #
    #   ?N=D ?M=A
    #   manual/

    @files = UrlHttpParseHref $ARG, '' ;

    @files;
}



# ****************************************************************************
#
#   DESCRIPTION
#
#	Get content of URL
#
#   INPUT PARAMETERS
#
#	$url			    The URL pointer
#	$file
#	$regexp
#	$regexpNo
#	$proxy
#	\%errUrlHashRef		    Hahs where to store the URL-ERROR_CODE
#	\%errExplanationHashRef	    Hash  where to store ERROR_CODE-EXPLANATION
#	$new			    Get never file
#	$stdout			    Write to stdout
#	$versionRegexp		    How to find the version number from page
#
#   RETURN VALUES
#
#	()	RETURN LIST whose elements are
#
#	$stat   Error reason or "" =&gt; ok
#	@	list of retrieved files
#
# ****************************************************************************

sub UrlHttp ( % )
{

    my $id = "$LIB.UrlHttp";
    my %arg = @ARG ;

    # .............................................. input arguments ...

    #  check mandatory

    not exists $arg{url}		    and  die "$id: URL missing";
    not exists $arg{file}		    and  die "$id: FILE missing";
    not exists $arg{errUrlHashRef}	    and  die "$id: HashRef missing";
    not exists $arg{errExplanationHashRef}  and  die "$id: errHashRef missing";

    #  Read values

    my $url			= $arg{url};
    my $file			= $arg{file};
    my $errUrlHashRef		= $arg{errUrlHashRef};
    my $errExplanationHashRef	= $arg{errExplanationHashRef};


    my $proxy			= $arg{proxy}	      || '';
    my $regexp			= $arg{regexp}	      || '';
    my $regexpNo		= $arg{regexpNo}      || '';
    my $new			= $arg{new}	      || 0;
    my $stdout			= $arg{stdout}	      || 0;;
    my $versionRegexp		= $arg{versionRegexp} || '';
    my $thisPage                = $arg{plainPage}     || 0;
    my $thisPageRegexp		= $arg{pageRegexp}    || '';
    my $conversion		= $arg{conversion}    || '';
    my $rename                  = $arg{rename}        || '';


    my $find = $thisPage eq -find ? 1 : 0;

    # ............................................ private functions ...

    my @files;

    local *PUSH = sub ($)
    {
	local ( $ARG ) = @ARG;

	if ( $stdout )
	{
	    Stdout $ARG;
	}
	else
	{
	    unless ( m,[/\\], )
	    {
		$ARG = cwd() . "/" . $ARG ;
	    }
	    push @files, $ARG   if not $stdout;
	}
    };


    # ......................................................... code ...

    if ( $debug )
    {
	print "$id:\n"
	    , "\tURL       : $url\n"
	    , "\tFILE      : $file\n"
	    , "\trename    : $rename\n"
	    , "\tconversion: $conversion\n"
	    , "\tregexp    : $regexp\n"
	    , "\tregexp-no : $regexpNo\n"
	    , "\tthis page : $thisPage\n"
	    , "\tfind      : $find\n"
	    , "\tvregexp   : $versionRegexp\n"
	    , "\tpregexp   : $thisPageRegexp\n"
	    , "\tproxy     : $proxy\n"
	    , "\tnew       : $new\n"
	    , "\tstdout    : $stdout\n"
	    , "\tcwd       : ", cwd(), "\n"
	    , "\toverwrite : $OVERWRITE\n"
    }


    $verb and print "$id: $url --&gt; $file\n";

    my $ua = new LWP::UserAgent;


    if ( defined $proxy )
    {
	  $debug  and $proxy  and  print "$id: Using PROXY $proxy\n";
	  $ua-&gt;proxy( "http", "$proxy" );
    }

    my ($baseUrl, $getFile) = ($url,"");

    unless ( $thisPage )
    {
	($baseUrl, $getFile)    = ( $url =~ m,^(.*/)(.*), );
    }


    if (      $getFile eq ''
	 and  ($regexp eq '' or $thisPageRegexp eq '')
	 and  not $thisPage
       )
    {
	  die "$id: ERROR: invalid URL $url. No file name part found."
	    , " Did you forgot to use &lt;page:&gt; ?"
	    ;
    }


    my @list = ( $getFile );








    if ( $new  )	# Directory lookup
    {
	my $getPage = $thisPage ? $url : $baseUrl ;

	$debug  and print "$id: Getting list of files $getPage ...\n";

	my $request = new HTTP::Request( 'GET' =&gt; $getPage );
	my $obj     = $ua-&gt;request($request);
	my $stat    = $obj-&gt;is_success;

	unless ( $stat )
	{
	    print "  ** error: $baseUrl ",  $obj-&gt;message, "\n";
	}
	else
	{
	    my $content = $obj-&gt;content();
	    my $head    = $obj-&gt;headers_as_string();

	    if ( $thisPage )
	    {
		$getFile  = $file;

		my %hash  = UrlHttPageParse $content, $versionRegexp;
		my @keys  = keys %hash;
		my @urls  = UrlHttpParseHref $content, $thisPageRegexp;
		my ( @files );

		$debug  and  print "$id: [Vre] urls [@urls] keys [@keys]\n";


		if ( @keys )
		{
		    $debug  and  print "$id: &lt;page&gt; if-case\n";

		    @files = MakeLatestFiles $file, keys %hash ;

		    if ( @files == 1 )
		    {
			@list = ( RelativePath dirname($urls[0]), $files[0] );
#			 for my $path ( @urls )
#			 {
#			     push @list, RelativePath
#				 ( dirname($path), $files[0] );
#			 }
#
		    }
		    else
		    {
			@list = ( LatestVersion $file, \@urls ) ;
			$file = '';
		    }
		}
		else
		{
		    # Try old fashioned. The filename contains the
		    # version information

		    $debug  and  print "$id: &lt;page&gt; else\n";

		    @list = ( LatestVersion $file, \@urls ) ;
		    $file = '';
		}

		$debug  and print "$id: FILES [@files] URLS [@urls]\n";

		unless ( @urls == 1 )
		{
		    warn "$id: Cant parse precise location [@urls] ";
		}
	    }
	    else
	    {
		$debug  and  print "$id: NOT &lt;page&gt; else\n";
		@list	= UrlHttpDirParse $head . $content, "clean";
		$file   = '';
	    }

	    @list   = FileListFilter $regexp, $regexpNo, $getFile, @list;
	}
    }

    # ............................................ search HTML page ...

    elsif ( $find )
    {
	my $request = new HTTP::Request( 'GET' =&gt; $url );
	my $obj     = $ua-&gt;request($request);
	my $stat    = $obj-&gt;is_success;

	unless ( $stat )
	{
	    print "  ** error: $baseUrl ",  $obj-&gt;message, "\n";
	}
	else
	{
	    my $content = $obj-&gt;content();
	    my $head    = $obj-&gt;headers_as_string();

	    my %hash  = UrlHttPageParse $content, "." ;
	    @list     = UrlHttpParseHref $content, $thisPageRegexp;

	    if ( $regexpNo ne '' )
	    {
		@list = grep ! /$regexpNo/, @list;
	    }

	    $debug  and  print "$id: [-find] @list\n";
	}
    }


    # ............................................ get list of files ...

    my ( $i, $ret );
    local $ARG;

    $debug   and  print "$id: FILE LIST [@list] REGEXP [$regexp]\n";

    $verb   and  !@list and  print "$id: No matching files [$regexp]\n";

    #	Filter out duplicates  (multiple links to the same source)

    my %seen;
    @seen{ @list } = (1) x @list;
    @list = keys %seen;


    @list = sort @list;

    for ( @list )
    {
	$i++;

	#   sometimes the file has version number, which
	#   is instructed to be removed by user in configuration tag.
	#   Respect it. But if there are many files then we do not
	#   have a choice.
	#
	#	save: this-name.txt

	my $saveFile = $file;


	if ( $stdout )
	{
	    $saveFile = TempFile();
	}
	elsif ( @list &gt; 1  or $file eq ''  or $find )
	{
	     $saveFile = basename $ARG;
	}


	my $relative = $ARG || $baseUrl;


	$debug  and  print "$id: SAVEFILE $saveFile RELATIVE $relative\n";



	if ( $ARG  and  not m,://, )
	{
	    #	If the ARG is NOT ABSOLUTE reference ftp:// or http://
	    #	Then glue together the base site + relative reference found
	    #	from page

	    $debug  and  print "$id: glue [$baseUrl] + [$ARG]\n";

	    $relative  = RelativePath BaseUrl($baseUrl), $ARG;
	}

	unless ( $relative )
	{
	    warn "$id: ERROR Can't resolve relative $baseUrl + [$ARG]";
	    next;
	}


	unless ( $stdout )
	{
	    $debug and  print "$id: file on disk? .. "
		, -e($saveFile) ? "[yes]" : "[no]"
		, " empty? .. "
		, -z($saveFile) ? "[yes]" : "[no]"
		, "\n"
		;

	    if ( -e $saveFile and  not -z  $saveFile )
	    {
		#   If the filename contains version number
		#   AND use has skipping on, the ignore downoad

		if ( $SKIP_VERSION  and  /-\d[\d.]*\D+/ )
		{
		    $verb  and  print "$id: [already on disk] $ARG\n";
		    next;
		}
		elsif ( not $OVERWRITE )
		{
		    $verb  and  print "$id: [already on disk] $ARG\n";
		    next;
		}
	    }
	}

	$url = $relative;

	DownloadProgress $baseUrl, $ARG, "$id: ...", $i, scalar @list;

	if ( $rename )
	{
	    $saveFile = EvalCode $url, $saveFile, $rename
	}

	$verb and print " downloading $url [savefile $saveFile]\n";


	my $request = new HTTP::Request( 'GET' =&gt; $url );

	my $obj     = $ua-&gt;request( $request , $saveFile );
	my $stat    = $obj-&gt;is_success;

	if ( $debug )
	{
	    print "$id: content-type:\n\t", $obj-&gt;content_type, "\n"
		, "\tsuccess status ", $stat, "\n"
		, map { $ARG = "\t$ARG\n"  } $obj-&gt;headers_as_string
		;
	}

        # ........................................... file downloaded ...

	if ( $stat )
	{
	    PUSH ($saveFile);
	}
	else
	{
	    $errUrlHashRef-&gt;{ $url } = $obj-&gt;code;

	    #  There is new error code, record it.

	    if ( not defined $errUrlHashRef-&gt;{ $obj-&gt;code }  )
	    {
		  $errExplanationHashRef-&gt;{ $obj-&gt;code } = $obj-&gt;message;
	    }

	    $ret = $errUrlHashRef-&gt;{ $obj-&gt;code };

	    print "  ** error: $url ",  $obj-&gt;message, "\n";
	}
    }


    $ret, @files;

}



# ****************************************************************************
#
#   DESCRIPTION
#
#	Copy content of PATH to FILE.
#
#   INPUT PARAMETERS
#
#	$path	    From where to read. If this is directory, read files
#		    in directory. If this is file, copy file.
#
#	$file	    Where to put resuts.
#	$prefix	    [optional] Filename prefix
#	$postfif    [optional] postfix
#
#   RETURN VALUES
#
#	()	RETURN LIST whose elements are:
#
#	$stat   Error reason or "" =&gt; ok
#	@	list of retrieved files
#
#
# ****************************************************************************

sub UrlFile ($ $ ; $$)
{
    my $id = "$LIB.UrlFile";
    my ( $path, $file , $prefix, $postfix ) = @ARG;

    my ( $stat, @files );

    $debug and warn "$id: PATH $path, FILE $file\n";

    if ( -f $path  and  not -d $path )
    {
	if ( $CHECK_NEWEST )
	{
	    my @dir = DirContent dirname( $path );

	    if ( @dir )
	    {
		my $base = dirname($path);
		$file = LatestVersion basename($path) , \@dir;
    		$path = $base . "/" . $file;
	    }
	    else
	    {
		$verb and print "$id: Can't set newest $file";
	    }
	}

	$file = $prefix . $file . $postfix;

	$debug and warn "$id: FileCopy $path =&gt; $file\n";

	unless ( copy($path, $file)  )
	{
	    print "$id: FileCopy $path =&gt; $file $ERRNO";
	}
	else
	{
	    push @files, $file;
	}
    }
    else
    {
	my @tmp = DirContent $path;

	local *FILE;

	$file =~ s,/,!,g;

	if ( -e $file and not $OVERWRITE )
	{
	    print "$id: [ignored, exists] $file\n";
	    return;
	}

	unless ( open FILE, "&gt; $file" )
	{
	    print "$id: can't write $file $ERRNO\n";
	    return;
	}

	print FILE join "\n", @tmp;
	close FILE;

	push @files, $file;
    }
    ( $stat, @files );
}


# ****************************************************************************
#
#   DESCRIPTION
#
#	Run Some self tests. This is for developer only
#
#   INPUT PARAMETERS
#
#	none
#
#   RETURN VALUES
#
#       none
#
# ****************************************************************************

sub SelfTest ()
{
    my $id = "$LIB.SelfTest";

    $debug = 1   unless $debug;

    my (@files, $file, $i);
    local $ARG;

    # ............................................................ X ...
    $i++;

    $file = "artist-1.1-beta1.tar.gz",

    print "$id: [$i] LatestVersion ", "." x 40, "\n"  ;

    @files = qw
    (
	mailto:tab@lysator.liu.se
	emacs-shapes.gif
	emacs-shapes.html
	emacs-a.gif
	emacs-a.html
	emacs-rydmap.gif
	emacs-rydmap.html
	COPYING
	artist-1.2.3.tar.gz
	artist.el
	mailto:kj@lysator.liu.se
	mailto:jari.aalto@poboxes.com
	http://st-www.cs.uiuc.edu/~chai/figlet.html
	artist-1.2.1.tar.gz
	artist-1.2.tar.gz
	artist-1.1.tar.gz
	artist-1.1a.tar.gz
	artist-1.1-beta1.tar.gz
	artist-1.0.tar.gz
	artist-1.0-11.tar.gz
	mailto:tab@lysator.liu.se
    );

    LatestVersion $file, \@files;

    # ............................................................ X ...
    $i++;

    $file = "irchat-980625.tar.gz";

    print "$id: [$i] LatestVersion ", "." x 40, "\n"  ;

    @files = qw
    (
	./dist/irchat/irchat-20001203.tar.gz
	./dist/irchat/irchat-19991105.tar.gz
	./dist/irchat/irchat-980625-2.tar.gz
	./dist/irchat/irchat-980128.tar.gz
	./dist/irchat/irchat-971212.tar.gz
	./dist/irchat/irchat-3.04.tar.gz
	./dist/irchat/irchat-3.03.tar.gz
	./dist/irchat/irchat-3.02.tar.gz
	./dist/irchat/irchat-3.01.tar.gz
	./dist/irchat/irchat-3.00.tar.gz
    );

    LatestVersion $file, \@files;

    # ............................................................ X ...
    $i++;

    print "$id: [$i] FileDeCompressedCmd ", "." x 40, "\n"  ;

    for ( qw
    (
	1.tar 1.tar.gz 1.tgz
	2.bz2 2.tar.bz2
	3.zip
	3.rar
    ))
    {
	eval { FileDeCompressedCmd $ARG };
	print $EVAL_ERROR  if $EVAL_ERROR;
    }

    exit;
}

# ****************************************************************************
#
#   DESCRIPTION
#
#
#
#   INPUT PARAMETERS
#
#	\@data	    Configuration file content
#
#
#   RETURN VALUES
#
#       none
#
# ****************************************************************************

sub Main ($ $)
{
    my $id = "$LIB.Main";

    my ( $TAG_NAME, $data ) = @ARG;

    $debug and warn "$id  ********** $TAG_NAME\n";

    my $date = DateYYYY_MM_DD();

    my ( %URL_ERROR_HASH , %URL_ERROR_REASON_HASH  );
    my ( $type, $url, $path, $site, $stat , $file , $line);
    my ( $origFile, $login, $pass , $sitePath, $lcd, $new, $stop );
    my ( $regexp, $regexpNo, $overwrite, $vregexp, $fileName );
    my ( $plainPage, $pageRegexp, $xopt, $saveopt , $conversion );
    my ( $rename );

    my ( $count, $var, $val , @files , $unpack);
    my %variables;

    my $prefix 	= "";
    my $postfix = "";
    local $ARG;


    my %EXTRACT_HASH =
    (
	  '\.tar\.gz$'  =&gt; "gzip -d -c %s | tar xvf -"
	, '\.gz$'	=&gt; "gzip -f -d %s"
	, '\.bz2$'	=&gt; "bzip -f -d %s"
	, '\.tar$'	=&gt; "tar xvf %s"
	, '\.tgz$'	=&gt; "tar -zxvf %s"		# GNU TAR
	, '\.zip$'	=&gt; "unzip %s"
    );




    # ............................................... prepare output ...

    if ( $OUT_DIR )
    {
	$verb		and  print "$id: chdir $OUT_DIR\n";
	chdir $OUT_DIR	or   die   "$id: chdir $OUT_DIR $ERRNO";
    }


    for ( @$data )
    {
	chomp;
	$line = $ARG;


	#   All the paseable directives must be cleared each time so
	#   that they don't affect next download.

	$pass = $login = $regexp = $regexpNo = '' ;
	$new = $unpack = $lcd = $overwrite = $vregexp = '' ;
	$fileName = $plainPage = $pageRegexp = $xopt = $saveopt = '';
	$conversion =  $rename = '';


	s/^\s*[#].*$//;				# Kill comments
	next if /^\s*$/;			# ignore empty lines


        # ............................................ Variable defs ...
	# todo: should be removed, this was for gz = 'command'

	%variables = ();
	%variables =  /'(\S+)'\s*=\s*(.*)/g;

	while ( ($var, $val) = each %variables )
	{
	    $debug  and  warn "$id:\t\t$var = $val\n";
	    $EXTRACT_HASH{ $var } = $val;
	}

        # ............................................... directives ...

	my $LINE = $ARG;	# make a secure copy


	$new       = $CHECK_NEWEST;
	$unpack    = $EXTRACT;
	$overwrite = $OVERWRITE;

	$pass	    = $1    if /\bpass:\s*(\S+)/;
	$login	    = $1    if /\blogin:\s*(\S+)/;
	$regexp	    = $1    if /\bregexp:\s*(\S+)/;
	$regexpNo   = $1    if /\bregexp-no:\s*(\S+)/;
	$new	    = 1	    if /\bnew:/;

	$unpack	    = 1		    if /\bx:/;
	$unpack	    = -noroot	    if /\bxx:/;
	$xopt       = $1	    if /\bxopt:\s*(\S+)/;

	$lcd	    = $1    if /lcd:\s*(\S+)/;
	$overwrite  = 1	    if /\bo(verwrite)?:/;
	$vregexp    = $1    if /\bvregexp:\s*(\S+)/;
	$fileName   = $1    if /\bfile:\s*(\S+)/;
	$pageRegexp = $1    if /\bpregexp:\s*(\S+)/;
	$rename     = $1    if /\brename:\s*(\S+)/;

	$conversion = -text if /\btext:/;

	if ( /\bcnv:\s*(\S+)/ )
	{
	    local $ARG = $1;

	    if ( /te?xt/i )
	    {
		$conversion = -text
	    }
	    else
	    {
		warn "$id: Unknown conversion [$ARG] [$line]";
	    }
	}

	if ( /\bpage:/ )
	{
	    $plainPage  = 1;

	    if ( /\bpage:\s*find/i )
	    {
		$plainPage  = -find;
	    }
	}

	#   "lcd-ohio" is valid tag name, whle the word "lcd" is our
	#   directive.. Accept word names after OUR directives.

	if ( $verb and  /(?:^|\s)(:[-a-z]+)\b/ )
	{
	    print "$id: WARNING directive, leading colon? [$1] $ARG\n";
	}

	if ( $lcd )
	{
	    $debug  and  print "$id: LCD $lcd\n";
	    DirectiveLcd $lcd, $LCD_CREATE   unless $NO_LCD;
	}

        # ................................................... regexp ...

	if ( defined $URL_REGEXP )
	{
	    if ( not /$URL_REGEXP/o )
	    {
		$debug  and  warn "$id: [regexp ignored] $ARG\n";
		next;
	    }
	}

	if ( defined $TAG_REGEXP )
	{
	    ($ARG, $stop ) = TagHandle $ARG, $TAG_NAME;
	    last  if  $stop;
	    next  if  $ARG eq '';
	}


        # ................................................. grab url ...

	m,^\s*((http|ftp|file):/?(/([^/\s]+)(\S*))),;

	unless ( defined $1 and defined $2 )
	{
	    $debug and warn "$id: [skipped] $line\n";
	    next;
	}

        # ............................................... components ...

	$url	    = $1;
	$type	    = $2;
	$path	    = $3;
	$site	    = $4;
	$sitePath   = $5;

	#   Remove leading slash if we log with real username.
	#   The path is usually relative to the directory under LOGIN.
	#
	#   For anonymous, the path is absolute.

	$sitePath =~ s,^/,,	if $login;

	$origFile = $sitePath;

	#   The page:find command may instruct to search
	#
	#   http://some.com/~foo
	#   http://some.com/	#
	#
	#   Do not consider those to contain filename part

	if (
	     $plainPage ne -find
	     or ( $url !~ m,/$, )
	     or ( $url !~ m,/[~][^/]+$, )
	   )
	{
	    ( $file  = $url ) =~ s,^\s*\S+/,,;

	    $file = $fileName		    if $fileName ne '';
	}

	if ( /http/  and  $file eq ''   and  not($plainPage) )
	{
	    $file = $path . "000root-file";
	}

        $debug and print "$id: VARIABLES\n"
            , "\tURL        = $url\n"
            , "\tFILE       = $file\n"
            , "\tFILE_NAME  = $fileName\n"
            , "\tTYPE       = $type\n"
            , "\tPATH       = $path\n"
            , "\tSITE       = $site\n"
            , "\tSITE_PATH  = $sitePath\n"
	    , "\tCONVERSION = $conversion\n"
            ;


	if ( $NO_SAVE == 0  and /save:\s*(\S+)/ )
	{
	    $saveopt = $1;
	    $file    = $1;
	}

	$postfix = $POSTFIX		    if  defined $POSTFIX;
	$prefix	 = $PREFIX . $prefix	    if  defined $PREFIX;
	$prefix  = $site . "::" . $prefix   if  $PREFIX_WWW;
	$prefix  = $date . "::" . $prefix   if  $PREFIX_DATE;

	$file = $prefix . $file . $postfix;


        # .................................................... do-it ...

	$debug and warn "$id: &lt;$type&gt; &lt;$site&gt; &lt;$path&gt; &lt;$url&gt; &lt;$file&gt;\n";

	$ARG   = $type;
	@files = ();


	$verb  and  print "$id: DIRECTORY ", cwd(), "\n";

	if ( /http/ )
	{
	    $count++;

	    if ( $plainPage eq -find   and  not $pageRegexp )
	    {
		die  "$id: no &lt;pregexp:&gt; directive"
		    , " LINE =&gt; [$line]"
		    ;
	    }

	    if ( $pageRegexp  and not $plainPage )
	    {
		$debug  and  print "$id:  Forgot &lt;page:find&gt; [$line]";
		$plainPage = -find;
	    }


	    if ( ($plainPage ne -find)  and  $pageRegexp  and not $file )
	    {

		$debug and print "$id: Expecting [page:find]",
		    , " for non-named download file"
		    , " [$url]"
		    , " LINE =&gt; [$line]"
		    ;

		$plainPage = -find;
	    }
	    elsif ( $plainPage ne -find and $pageRegexp )
	    {
		$plainPage = -find;
	    }

	    if ( $saveopt  and  $pageRegexp )
	    {
		chomp;
		die "$id: ERROR can't mix &lt;save:&gt; and &lt;pregexp:&gt;"
		    , " Use absolute filename URL with &lt;save:&gt;"
		    , " LINE =&gt; [$line]"
		    ;
	    }


	    if ( $pageRegexp  and not $plainPage )
	    {
		warn "$id: WARNING no page: directive [$ARG]\n";
	    }


	    if ( $pageRegexp  and not $file  and ($plainPage ne -find))
	    {
		warn "$id: WARNING no file: directive. [$ARG]\n";
	    }

	    if ( $pageRegexp  and not $file  and ($plainPage ne -find))
	    {
		warn "$id: WARNING no file: directive. [$ARG]\n";
	    }


	    ($stat, @files) = UrlHttp
	          url           =&gt; $url
		, file		=&gt; $file
		, regexp	=&gt; $regexp
		, regexpNo	=&gt; $regexpNo
		, proxy		=&gt; $PROXY
		, errUrlHashRef	=&gt; \%URL_ERROR_HASH
		, errExplanationHashRef =&gt; \%URL_ERROR_REASON_HASH
		, new		=&gt; $new
		, stdout	=&gt; $STDOUT
		, versionRegexp =&gt; $vregexp
		, plainPage	=&gt; $plainPage
		, pageRegexp	=&gt; $pageRegexp
		, conversion	=&gt; $conversion
		, rename	=&gt; $rename
		;
	}
	elsif ( /ftp/ )
	{
	    $count++;

	    my ($pproto, $ssite, $ddir, $ffile) = SplitUrl $url;

	    if ( $ffile  and  $ffile !~ /[.]/ )
	    {
		#   ftp://some.com/dir/dir
		warn "$id: Did you forgot trailing slash? [$line]";
	    }

	    if ( $regexp )
	    {
		#   There can't be serched "file" if regexp is used.
		$origFile = '';
		$file     = '';
		$sitePath = Slash $sitePath;
	    }



	    #	Directory path given, so reset the file
	    $origFile = ''  if  $origFile =~ m,/$,;

	    ($stat, @files ) = UrlFtp
		      site       =&gt; $site
		    , url        =&gt; $url
		    , path       =&gt; $sitePath
		    , getFile    =&gt; $origFile
		    , saveFile   =&gt; $file
		    , regexp     =&gt; $regexp
		    , regexpNo   =&gt; $regexpNo
		    , firewall   =&gt; $FIREWALL
		    , login      =&gt; $login
		    , pass       =&gt; $pass
		    , new        =&gt; $new
		    , stdout     =&gt; $STDOUT
		    , conversion =&gt; $conversion
		    , rename     =&gt; $rename
		    ;
	}
	elsif ( /file/ )
	{
	    ($stat, @files) = UrlFile $path, $origFile, $prefix, $postfix;
	}

        # .............................................. conversion ...

	if ( $conversion eq -text )
	{
	    for my $file ( @files )
	    {
		FileHtml2txt $file;
	    }
	}
	elsif ( $conversion )
	{
	    warn "$id: Unknown conversion [$conversion]";
	}


        # .................................................. &amp;unpack ...

	if ( $unpack and not $NO_EXTRACT )
	{
	    $debug   and  print "$id: extracting [@files]\n";

	    @files   and  Unpack \@files, \%EXTRACT_HASH, $unpack, $xopt;
	}
    }

    if ( not $count  and  $verb)
    {
	$URL_REGEXP
	    and printf "$id: No labels matching regexp [%s]\n",
		$URL_REGEXP;

	@TAG_LIST
	    and printf "$id: No tags matching [%s]\n",
		join(' ', @TAG_LIST);

	@CFG_FILE == 0
	    and print "$id: Nothing. Use config file or give URL?\n";
    }


}



# ****************************************************************************
#
#   DESCRIPTION
#
#	Parse VAR = VALUE statements. The values are put to %ENV
#
#   INPUT PARAMETERS
#
#	@lines
#
#   RETURN VALUES
#
#	none
#
# ****************************************************************************

sub ConfigVariableParse (@)
{
    my $id   = "$LIB.ConfigVariableParse";
    my @data = @ARG;

    local $ARG;

    for ( @data )
    {
	s/#.*//;

	next unless /\S/;

# print "+++ $ARG";

	my %variables = /(\S+)\s*=\s*(\S+)/g;

	while ( my($var, $val) = each %variables )
	{
	    #  put values to "environment"

	    $debug  and  print "$id:\t\t[$var] = [$val] , [$ARG]\n";
	    $ENV{ $var } = ExpandVars $val;
	}
    }
}


# ****************************************************************************
#
#   DESCRIPTION
#
#	Read Configuration file contents
#
#   INPUT PARAMETERS
#
#	$file
#
#   RETURN VALUES
#
#	@lines
#
# ****************************************************************************

{
    my %staticInclude;	# already included files, do not read again

sub ConfigRead ( $ );	# Recursive call needs prototyping

sub ConfigRead ( $ )
{
    my $id   = "$LIB.ConfigRead";
    my $file = shift;

    $verb  and  print "$id: Reading config [$file]\n";

    if ( $debug )
    {
	print "$id: !! FILE $file "
	    , ExpandVars $file
	    , " ["
	    , join(' ', %staticInclude)
	    , "]\n"
	    ;
    }

    # .............................................. already included ...
    # In windows c:/dir  is same as C:/DIR

    my $check = $file;
    $check    = lc $file  if $WIN32;

    if ( exists $staticInclude{$check} )
    {
	$debug  and   print "$id: skipped, already included $file\n";
	return;
    }

    # .......................................................... read ...


    my ($lineArrRef, $status) = FileRead $file;

    $staticInclude{ $file } = 1;


    if ( @$lineArrRef )
    {
	ConfigVariableParse @$lineArrRef;

	local $ARG;
	my @lines;

	for my $line ( @$lineArrRef )
	{
	    push @lines, $line;

	    #	Skip INCLUDE statements that have been commented out.

	    $ARG  = $line;

	    s/#.*//;

	    next unless /[a-z]/i;

# print "--- $ARG\n";

	    if ( /include\s+&lt;(\S+)&gt;/i )
	    {
		my $inc  = $1;

		$staticInclude{ $inc } = 1;


		my $path = ExpandVars $inc;

		$debug  and  print "$id: RECURSIVE INCLUDE [$path] [$inc]\n";

		unless ( exists $staticInclude{$path} )
		{

		    push @lines, ConfigRead $path;

		    $path  = lc $path   if $WIN32;

		    $staticInclude{ $path } = 1;
		}
	    }
	}
	@$lineArrRef = @lines;
    }
    else
    {
	$debug  and  print "$id: Nothing found from $file";
    }

    @$lineArrRef;
}}


# ****************************************************************************
#
#   DESCRIPTION
#
#	Start, the start of the program.
#
#   INPUT PARAMETERS
#
#	None
#
#   RETURN VALUES
#
#	None
#
# ****************************************************************************

sub Start ()
{
    Initialize();
    HandleCommandLineArgs();


    my ( @data);
    my $id = "$LIB.Start";


    # ......................................................... args ...

    if (  @CFG_FILE )
    {
	local $ARG;

	for ( @CFG_FILE )
	{
	    my @lines = ConfigRead $ARG;

	    $debug &gt; 1  and  print "$id: READ config\n\n"
				, "!!== $ARG\n@lines\n\n";

	    push @data, @lines;
	}
    }


    if ( $debug &gt; 1 )
    {
	print "$id: CONFIG-FILE-CONTENT-BEGIN\n"
	    , @data
	    , "$id: CONFIG-FILE-CONTENT-END\n"
	    ;

	PrintHash( "ENV", %ENV );
    }



    push @data, @ARGV	if @ARGV;	# Add command line URLs


    if ( @TAG_LIST )
    {
        local $ARG;

	for ( @TAG_LIST )
	{
	    TagHandle undef, undef, "1-reset";
	    Main $ARG, \@data;
	}
    }
    else
    {
	Main "", \@data;
    }
}

Start();




0;
__END__
</pre></body></html>