# This is a shell archive.  Save it in a file, remove anything before
# this line, and then unpack it by entering "sh file".  Note, it may
# create directories; files and directories will be owned by you and
# have default permissions.
#
# This archive contains:
#
#	Changes
#	Makefile
#	README
#	batch-fetch-recursive.in
#	configure
#
echo x - Changes
sed 's/^X//' >Changes << 'END-of-Changes'
X                  Batch-Fetch-Recursive 改訂履歴
X
X## Last modified: Sun Mar 23 08:01:09 1997 JST ##
X
X1.80 Mar 23 1997: is_htmlfile の中で .phtml も HTML ファイルとした. 
X                  <!-- で始まるコメントの終了を > だけで判定することにした. 
X                  <img の代わりに <image と書いてあってもよいことにした. 
X
X     Mar 17 1997: _cgiN.html というファイルを作るときのファイル名の
X                  決め方に関するバグ修正.
X                  encode_url_unsafe というサブルーチンを用意した.
X                  ファイル取得の間に休眠を入れられるようにした.
X                  $fetch_opt 変数でファイル取得時のコマンドライン
X                  オプションを追加できるようにした. 
X
X     Mar  1 1997: ヘッダ情報の Content-Length が得られた場合には, 
X                  実際に取得されたファイルのサイズと比較して
X                  完全なファイルが得られたかどうかを判定する
X                  オプションを追加した.
X
X     Feb 26 1997: lynx -mime_header を使う場合の注意書き追加.
X     Feb 18 1997: 若干のバグ修正.
X
X     Feb 16 1997: 最初の検索に使う URL が HTML ファイルかディレクトリか
X                  の判定は棚上げして, とにかくそのままの URL で検索を
X                  開始することにした. 
X
X                  -u http://foo/bar で処理を開始したとき, $prefix が
X                  明示的に指定されていないと $prefix=http://foo が
X                  仮定される. この場合, http://foo/bar への参照が
X                  http://foo/bar/ に移動したら, $prefix を http://foo/bar
X                  に変更するようにした.
X
X                  ヘッダ情報の Content-Type が得られた場合は, 
X                  is_htmlfile サブルーチンの判定によらず, 
X                  Content-Type: text/html のものを HTML ファイルと
X                  みなすようにした. 
X
X     Feb 12 1997: URL からファイルを取得するとき, ヘッダ情報も
X                  合わせて取得できるようにした. 
X
X     Feb 11 1997: URL に関するヘッダ情報を取得するかどうかを
X                  $use_header_info で指定できるようにした.
X
X     Feb 10 1997: URL に関するヘッダ情報を取得して Last-Modified を
X                  調べ, ローカルファイルの日付と比較して新しければ
X                  $local_file_cache によらず新しい内容を取得にいく
X                  機能を追加した. 
X
X     Feb  9 1997: HTML ファイルのファイル名が .shtml であるものに対応.
X                  <meta, <embed, <form, <bgsound に対応.
X
X                  取得要求発行時 URL をアポストロフィで囲むようにした
X                  (CGI のパラメタなどに含まれる特殊な文字が shell に
X                  解釈されるのを防ぐため). また, CGI の要求と思われる
X                  URL の格納先のファイル名は _cgiN.html (N=1,2,...) と
X                  変更するようにした.
X
X                  $allow_rm_and_mkdir の初期値を 1 とした. 
X
X     Jan 26 1997: ローカルファイルキャッシュ機能を使うかどうかの
X                  判定を「サイズが 0 より大きいファイルがある」から
X                  「ファイルが存在する」に変更した.
X
X                  ローカルファイルキャッシュ機能を使う場合でも, 
X                  特定の URL またはファイルに対してこの機能を
X                  無効にできる $ignore_local_file_cashe 設定を
X                  追加した.
X
X     Jan 25 1997: 取得しようとしたファイルがディレクトリとして既存で
X                  あった場合は取得を抑止する.
X
X                  外部コマンドの標準エラー出力もファイルに取り込める
X                  ようにした. FreeBSD の fetch を使う場合に有効. 
X
X     Jan 24 1997: URL がディレクトリを指している場合に得られた情報を
X                  格納するファイルの名前を, 従来の "index.html" 固定から
X                  変数 $dirinfo_file で設定可能にした. 
X
X     Jan 22 1997: Nov 01 1996 の「ファイル名に空白を含むものができてしまう
X                  バグを修正」が不完全であったので修正した. 正規表現の
X                  "." が改行にはマッチしないことが考慮されていなかった. 
X
X     Jan 18 1997: 取得前に既存ファイルのバックアップをとって, ファイルの
X                  取得に失敗した場合 (サイズが 0 より大きいファイルが
X                  できなかった場合), もとのファイルを復元するオプションを
X                  設けた.
X
X                  $allow_rm_and_mkdir 指定により既存のファイルを
X                  ディレクトリに変更するとき, もとのファイルを
X                  新設のディレクトリの下に移動するオプションを
X                  設けた.
X
X                  HTML ファイルかどうかを判定する is_htmlfile
X                  サブルーチンを新設し, .html で終わらないファイル名
X                  でも HTML ファイルとみなすオプション $force_html を
X                  設けた.
X
X     Jan 17 1997: -p 1 のときに -n の処理が不完全に終ってしまう
X                  場合があるバグを修正
X
X                  $targetdir の先頭の '~' は $ENV{'HOME'} に置き換える
X                  ことにした.
X
X1.71 Nov 22 1996: 1.70 で各種変数の説明を configure から削除して
X                  しまったのを復活した. 
X
X1.70 Nov 18 1996: Nov 01 1996 の「ファイル名に空白を含むものができてしまう
X                  バグを修正」が不完全であったので修正した.
X
X     Nov 16 1996: インストール時設定項目のほとんどすべてを実行時
X                  指定可能にした. 
X
X                  URL の変更規則を perl で書いて実行時に指定できる
X                  ようにした. 
X
X                  $get_image および $prefix に関する処理を select_url
X                  サブルーチンに移動した. 従来のバージョンで $select_url
X                  を使って独自の URL 選択処理を行なっていた場合は, 
X                  これらの処理が欠落するおそれがあるので注意が必要である.
X
X                  Makefile のバグを修正し, 無駄な for を使わないように
X                  書き直した. 
X
X                  引用符にアポストロフィが使われている場合に対応した. 
X                  
X1.61 Nov 10 1996: \w で始まらないファイル名の参照 (/ や . で始まるもの)
X                  が無視されてしまうバグの修正 (未公開). 
X
X1.60 Nov 03 1996: ファイル名の変更規則と URL の取捨選択規則を perl で
X                  書いて実行時に指定できるようにした.
X                  初期化処理中に任意の perl スクリプトを実行できる -e
X                  オプションを追加した. 
X     Nov 02 1996: <area href=...> に対応.
X     Nov 01 1996: ファイル名に空白を含むものができてしまうバグを修正.
X     Oct 25 1996: ローカルファイルキャッシュ機能の追加. 
X                  libwww-perl を使おうという実験的な試みがお荷物に
X                  なってきたのでやめた.
X                  同時並行処理数が 1 の場合は無駄な fork を行なわない
X                  ようにした. 
X
X1.52 Oct 15 1996: $change_filename で指定したファイル名の書換えが
X                  格納される HTML ファイルの内容に反映されない
X                  バグの修正.
X
X1.51 Oct 15 1996: 複数個の batch-fetch-recursive を同時並行処理させると
X                  作業用の一時ファイルが競合するバグを修正.
X
X                  インストール時に $change_filename でファイル名書き換えの
X                  追加処理ができるようにした. 
X
X1.50 Oct 10 1996: 入手したファイル内容全体を変数に格納していたのを,
X                  HTML ファイル以外は 1024 バイトずつ読み込んで出力
X                  ファイルに書くようにして, 無駄なメモリ消費を避けた.
X
X                  入手した HTML ファイルの中に <base href=...> の
X                  設定があったり, / で始まるファイル名の参照が
X                  あったりしても, ローカルな参照関係が正しくなるよう
X                  HTML ファイルを修正できるオプションを追加した.
X
X1.41 Oct 10 1996: 正規表現の中で, \. や \.\. の代わりに . や .. を
X                  書いてしまうという, とても恥しいバグの修正.
X
X1.40 Oct  6 1996: <base href=...> に対応し, これが設定されている場合でも
X                  正しい URL で GET できるようにした. 
X
X                  ローカルに格納するファイルの格納位置を, 
X                      URL: protocol://server/path
X                  に対応して
X                      格納先ディレクトリ/protocol/server/path
X                  に変更した. これにより -r, -b, +b というオプションは
X                  意味を失うので廃止した.
X
X                  $prefix 指定により, もとの URL で指定されたディレクトリの
X                  範囲を越えてファイルを入手できるようにした.
X
X                  これらの仕様変更のアイデアは, lwp-rget および httpdown を
X                  参考にした. 
X
X1.32 Oct  2 1996: ファイル名が '..' でも取得しようとしたバグの修正
X
X                  インストール時の make で ./configure が実行可能に
X                  なっていないバグを修正.
X
X                  +b, -a オプション追加. -r, -b, +b, -a の省略時
X                  仮定値をインストール時指定事項とする.
X
X                  中間作業ファイルが残ってしまうことがあるバグを修正.
X
X1.31 Oct  1 1996: -d に指定されたディレクトリへの chdir が失敗しても
X                  チェックせずに続行して, カレントディレクトリに
X                  ファイルを作ってしまうバグを修正した.
X
X                  ファイル名の先頭が / のものの取得および, -d で
X                  指定されたディレクトリの範囲外のファイルの取得を
X                  抑止するオプションを追加した.
X
X1.30 Sep 30 1996: 大幅にアルゴリズムを改訂して性能向上を図った (けれども
X                  期待したほどの効果はなかった). 1.23 までは, 入手済み
X                  ファイルを情報源として, その中で参照されているものを
X                  次に入手する方式であったが, 1.30 からは, ファイルを
X                  入手しながら, 入手対象 URL をリストに追加していく
X                  方式とした. これに伴い, 1.23 までにあった, 格納先
X                  ディレクトリにあらかじめ入っているファイルを最初に
X                  調べるという, あまり自然でない仕様は廃止した. 
X
X                  linwww-perl を使えるようにした (けれども性能が
X                  出ないので使わないほうがよい). 
X
X                  Perl5 でしか動かなくなった. 
X
X1.23 Sep 26 1996: 1.21 以降 Perl4 では正しく動かなくなってしまったのを
X                  動くようにした. 
X                  mkdirhier を system で呼び出していたのを, mkdirhier を
X                  参考に sub mkdirhier を書いて do で呼び出すようにした. 
X1.22 Sep 25 1996: "<frame src=" に対応した. 
X1.21 Sep 25 1996: HTML の解釈を比較的まじめにやるようにした. 
X                  (注釈部分の削除や, 冗長な空白・改行への対応). 
X1.20 Sep 22 1996: これまで system を使っていたのを, fork を使って
X                  %FETCH を子プロセスで走らせるように改めた. 将来的には, 
X                  ファイルを取得しながら解析してファイル参照を拾い出す
X                  ようにしたいと思うが, 今回の改訂はそのための準備でもある. 
X1.10 Sep 14 1996: 出発点とするファイルの決定方法を変更. 
X                  出力先ディレクトリ指定が相対的なパスの場合, 
X                  foo/bar/foo/bar/... という果てしないディレクトリが
X                  できてしまうバグの修正. 
X1.02 Sep 11 1996: 稚拙なコーディングを改良する. 
X1.01 Sep 10 1996: The Poor Man's Internet Utility Package より独立. 
END-of-Changes
echo x - Makefile
sed 's/^X//' >Makefile << 'END-of-Makefile'
X################################################################
X## Makefile for Batch-Fetch-Recursive
X## Last modified: Sat Nov 16 15:39:33 1996 JST ##
X##      by Ito Kazumitsu
X################################################################
X
XGENCOMMAND = ./configure
XRM = rm -f
XCHMOD = chmod
X
XSCRIPTS = batch-fetch-recursive
X
Xall:
X	@$(CHMOD) +x $(GENCOMMAND)
X	@echo make $(SCRIPTS)...
X	$(GENCOMMAND) $(SCRIPTS).in > $(SCRIPTS)
X	$(CHMOD) +x $(SCRIPTS)
Xclean:
X	@echo rm $(SCRIPTS) *~...
X	$(RM) $(SCRIPTS) *~
X
END-of-Makefile
echo x - README
sed 's/^X//' >README << 'END-of-README'
X       Batch-Fetch-Recursive
X
X         Version 1.80
X
X## Last modified: Mon Mar 31 06:22:20 1997 JST ##
X
X                                             伊藤一光
X                                        kaz@maczuka.hitachi.ibaraki.jp
X1. 概要
X
Xbatch-fetch-recursive はお決まりの WWW の内容取得をバッチ処理で
Xやらせることのできるプログラムです.
X
Xたとえば, 
X
X   batch-fetch-recursive -u http://foo.bar.com/hogehoge/ -d ./hogehoge -n 3
X
Xという感じのコマンドで, http://foo.bar.com/hogehoge/ 以下のファイルを
X./hogehoge 以下にコピーでき, これをバックグラウンドで走らせたり, 夜中に
X走らせたりしておいて, あとでゆっくり内容を見るようにすると便利です. 
X
Xbatch-fetch-recursive のほかにの同様の機能を持つツールがいくつか
Xあります. それらの比較を
X
X  http://www.jsdi.or.jp/~maczuka/programs/compare-tools.txt
X
Xに置きましたので御覧ください. 
X
X
X2. 動作環境
X
XUNIX または UNIX like な OS のもとで動きます. 
X
Xbatch-fetch-recursive は Perl5 のスクリプトです. Perl4 では
X動きません. 
X
XURL からファイルを取得するコマンドとして次のいずれか, もしくは
X同等の機能をもつものが必要です. 
X
X   ・lwp-request (libwww-perl に付属のもの)
X   ・伊藤私家版 fetch
X     (FreeBSD のある時点の current の fetch に対して私が
X      少しだけ手を入れたものです. 
X      http://www.jsdi.or.jp/~maczuka/programs/fetch-e.tar.gz
X      に置いてあります.)
X   ・lynx
X     (lynx の -mime_header オプションを使うと GIF ファイルを
X      取得する場合にファイルの一部が欠落するという現象が, 
X      lynx version 2.6, 2.7 で確認されていますので御承知おきください.
X      この問題に関する lynx 2.7 に対するパッチを
X      http://www.jsdi.or.jp/~maczuka/programs/lynx2-7-patch.txt
X      に置きましたのでお試しください.)
X
Xコマンドの機能としては, URL のファイルの内容に加えて, ヘッダの
X情報も得られるがことが望まれます. 以下のものも使えますが
X(私の知るかぎり) ヘッダ情報を得ることはできそうもありません. 
X
X   ・fetch (FreeBSD 2.1.5 以降に含まれるもの)
X         ただし, FreeBSD 2.1.5-RELEASE の fetch は怪しいので
X         current のソースからコンパイルしなおしたほうがよいでしょう. 
X   ・url_get (http://uts.cc.utexas.edu/~zippy/url_get.html)
X         ただし, 今この URL は無効らしいので, 
X         http://www.jsdi.or.jp/~maczuka/programs/url_get.tar.gz および
X         http://www.jsdi.or.jp/~maczuka/programs/url_get.tgz.uuencoded.txt
X         にコピーを置きました. 
X
X
X3. インストール
X
X適当なディレクトリの下にこのパッケージを展開し, configure  という
Xファイル (configure は perl スクリプトになっています) を編集して
X必要事項を設定したあと make とタイプすれば, 
X
Xbatch-fetch-recursive
X
Xというファイルができます. これを適当なディレクトリの下にコピーして
Xお使いください. 
X
Xconfigure では, 実行時オプションを規定する変数の初期値を与えます.
Xそれらの変数の意味は configure の中に記述してあります. 
X
X
X4. 実行
X
X    batch-fetch-recursive [ オプション指定 ] ...
X
X       指定された URL の内容を入手してローカルの出力先ディレクトリの
X       下のファイルに書き出す. 書き出されたファイルのうち, HTML ファイル
X       と判定されるものの中で参照されているファイルも入手して同じように
X       ローカルのファイルに書く. 
X
X       こうして, ファイルの参照関係が完結するか, または指定された
X       深さに達するまでファイルの入手を繰り返す. 
X
X       このとき, 第 1回目のファイルの入手方法は, 指定された URL そのものを
X       使う. 第 2回目以降での HTML ファイルかどうかの判定は, インストール時
X       または実行時に設定可能な is_htmlfile サブルーチンで行なう. ただし, 
X       URL に関するヘッダ情報の取得が可能な場合は, Content-Type: text/html
X       の有無の判定を優先する.
X
X       ディレクトリに対する参照の結果は, インストール時または実行時に
X       指定した名称 (デフォルトは index.html) のファイルに格納する.
X
X       オプション
X         batch-fetch-recursive の実行時オプションは, 変数に値を設定する
X         ことで指定する. 変数に値を設定するのは -a または -e で行なう. 
X         いくつかの変数は, コマンドラインのオプションでも設定できる. 
X
X         -a '変数=値; ...'
X            batch-fetch-recursive の中で使われる変数に値を設定する. 
X            設定可能な変数については後述および configure ファイルを
X            参照.
X
X         -e ファイル名
X            -a オプションではコマンドラインが繁雑になる場合, perl
X            スクリプトをファイルに書いて -e オプションで指定することに
X            より, そのスクリプトを実行させることができる.
X
X         -u 情報源URL  ($starting_url="情報源URL";)
X            情報源の URL を指定する. 
X
X         -d 出力先ディレクトリ  ($targetdir="出力先ディレクトリ";)
X            入手したファイルは, protocol://server/path という URL に
X            応じて, -d で指定されたディレクトリの下に
X                protocol/server/path
X            として格納される.
X
X            指定されたディレクトリが存在しない場合は, 自動的に生成される.
X
X         -n 探索の深さ  ($depth=探索の深さ;)
X            1回めの探索で最初に入手されるファイルを 第 0 レベルの
X            ファイルとする. 
X
X            入手した 第 (r-1) レベルのファイルのうち, HTML ファイルを
X            調べ, その中で参照されているファイルのうち, 未入手のものを
X            入手して第 r レベルのファイルとする. 
X
X            このような探索の r の最大値を -n 探索の深さ で指定する. 
X
X         -i  ($get_image=0;)
X            イメージファイルを入手しないことを指定する. 
X
X            なお, 実際にイメージファイルを入手するかどうか, 何をもって
X            イメージファイルとするかは, select_utl サブルーチンの中で
X            決定される.
X
X         -p 並行処理数  ($max_fetch_proc=並行処理数;)
X            ファイルの取得は, $fetch_command で指定したコマンドを
X            子プロセスで走らせることによって行なわれるが, 最大
X            いくつまで同時に走らせるかを指定する. 
X
X         -v  ($debug=1;)
X            デバッグ用の情報を表示する. 
X
X         変数 $prefix
X            $prefix に指定された文字列と前方一致する URL だけが
X            ファイル入手の対象となる. デフォルトでは, -u で指定
X            された URL のディレクトリ部分までが $prefix となる. 
X
X            $prefix='' を指定すると, -u で指定されたサーバに
X            限らず, 参照されているファイルはすべて取得にいく.
X
X            ただし, $prefix と URL の照合を行なうのは select_url
X            サブルーチンの中であり, 独自の select_url ルーチンを
X            使う場合は注意が必要である.
X
X         変数 $fetch_opt
X            ファイルの取得のためのコマンドを起動するときの
X            コマンドラインオプションを追加したいとき $fetch_opt に
X            指定する. 
X
X              (例) lynx を使い, -auth=id:passwd というオプションを
X                   使いたい場合 -a '$fetch_opt="-auth=id:passwd"'
X                   とする.
X
X         その他の設定可能な変数の使い方は configure ファイルを
X         参照のこと. 
X
X       注意事項
X
X         (1) ディレクトリの情報を入手したとき, その内容は $dirinfo_file に
X             指定したファイルに格納する. デフォルトでは index.html と
X             している. これは
X
X                ・先方に index.html というファイルがある場合, 
X                  ディレクトリの情報を得ようとすると, たいていの
X                  場合は index.html の内容が返されるはずだ. 
X                ・先方に index.html がない場合は, 返された内容を
X                  こちらで勝手に index.html に格納してもとりあえず
X                  問題ないであろう. 
X
X             という想定に基づいている. 
X
X         (2) HTML ファイルの中で参照されているファイルが実は
X             ディレクトリであったという場合, つまり, <A HREF="foo">
X             とあっても, 実は <A HREF="foo/"> の意味であったという
X             場合, 以下の方法で適宜対応していただきたい. 
X
X                 foo の情報をいったん foo というファイルに取得し,
X                 それを HTML ファイルとして扱わせる. 
X
X                    $force_html=1;
X                    $allow_rm_and_mkdir=1;
X                    $change_dir_to="index.html";
X
X                 というオプションを指定しておけば, foo のディレクトリ
X                 情報がいったん foo というファイルに格納され, それが
X                 HTML ファイルとして解釈され, foo の下のファイルを
X                 取得するときに, foo が foo/index.html に変更される
X                 はずである. 
X
X                 なお, URL に関するヘッダ情報が入手可能な場合
X                 ($include_heder_info を指定した場合) は, 自動的に
X                 foo の情報が HTML ファイルとして扱われるはずである.
X
X                 FreeBSD の fetch を使う場合は, foo の取得要求に
X                 対する応答が, 標準エラー出力に出力されてしまうので, 
X
X                     $fetch_stderr="2>&1";
X
X                 を合わせて指定するとよい.
X
X         (3) 参照関係の完結したローカルファイル群に対してローカル
X             ファイルキャッシュ機能をを使っても無意味であるが,
X             最新のものを取得したいファイルはあらかじめ削除して
X             おいたり, 不要なファイルはダミーのファイルをあらかじめ
X             作っておいたりすれば, 意味のある使い方ができる.
X             また, $ignore_file_cache の設定で, 特定のファイルに
X             対してローカルファイルキャッシュ機能を無効にする
X             ことができる. 
X
X         (4) $max_fetch_proc (または -p オプション) に 2以上を
X             指定することは推奨しない. 理由は
X
X               ・接続先のサーバに負荷をかける行為はつつしむべきである.
X               ・複数のプロセスで同じファイルを書きにいく可能性が
X                 あり, 排他制御をまじめに行なっていないので結果が
X                 保証できない.
X
X         (5) http 以外のプロトコル (主にftp) に関しては動作を
X             保証しないし, 正しく動作するよう改善する予定もない. 
X             理由は
X
X               ・そもそも ftp サイトに対してこのようなツールを
X                 使うべきではない. これはミラーリングのための
X                 ツールではない. ftp をバッチ処理でやりたければ
X                 簡単な shell スクリプトでできる.
X
X               ・lynx で ftp://foo/bar/ の情報を得ると, <A HREF="bar/file">
X                 のような結果が得られる. lynx 内部ではこれで良いのかも
X                 しれないが, batch-fetch-recursive では ftp://foo/bar/bar/file
X                 を取りにいってしまう.
X
X謝辞
X
XBatch-Fetch-Recursive を御利用いただき, バグレポートや改善の御提案を
X寄せられた皆様のお名前を以下に記し, 感謝を申し上げます.
X
X  待山 昌寛 さん
X  Yasunari Momoi さん
X  Hideyuki Shibuya さん
X  布施田 忠幸 さん
X  佐藤 大輔 さん
X  藤井 哲也 さん
X  Kazunari Haratake さん
X  なかしま まもる さん
X  Nobuhiro Otsu さん
X  野田健一 さん
X  渕野 暢昭 さん
X  原武 一成 さん
X
X過去のメイルから目視でお名前を拾ったものですので, 遺漏等の失礼が
Xありましたらお許しください. 
END-of-README
echo x - batch-fetch-recursive.in
sed 's/^X//' >batch-fetch-recursive.in << 'END-of-batch-fetch-recursive.in'
X#!?PERL
X
X$version="1.80";
X## Last modified: Tue Apr  1 23:14:17 1997 JST ##
X
X$this_pid=$$;
X$prefix=" undef ";
X$fetch_opt="";
X
X?INIT
X
Xwhile($a=shift) {
X    if($a eq "-u") {
X            $starting_url=shift;
X    }
X    elsif($a eq "-d") {
X            $targetdir=shift;
X    }
X    elsif($a eq "-n") {
X            $depth=shift;
X    }
X    elsif($a eq "-i") {
X            $get_image=0;
X    }
X    elsif($a eq "-p") {
X            $max_fetch_proc=shift;
X    }
X    elsif($a eq "-v") {
X            $debug=1;
X    }
X    elsif($a eq "-a") {
X            $a=shift;
X            eval "$a;";
X    }
X    elsif($a eq "-e") {
X            $a=shift;
X            do $a;
X    }
X}
X
Xif(!$starting_url) {
X     die "This is batch-fetch-recursive Ver $version\nUsage: batch-fetch-recursive [-i] -u URL [-d DIR] [-n DEPTH][-p MAX-FORK ][-v]\n";
X}
X
Xeval $change_filename;
Xeval $select_url;
Xeval $change_url;
Xeval $is_htmlfile;
Xeval $ignore_local_file_cache;
X
Xif(!($depth > 0)) {
X     $depth=1;
X}
X
Xrequire 'timelocal.pl' if $use_header_info;
X
X# Local directories  must be fully specified. Otherwise, an endless
X# directory foo/bar/foo/bar/... will be created.
X
Xchop($cwd=`pwd`);
X
Xif($targetdir=~m|^[^/]|) {
X     if($targetdir=~/^~/) {
X         $targetdir=~s/^~/$ENV{'HOME'}/;
X     }
X     else {
X         $targetdir="$cwd/$targetdir";
X     }
X}
X
X# Parse URL
X
Xif ($starting_url=~m#^\s*(\w+://[\w-\.]+:?\d*)([^ \t]*)$#) {
X    $urlhost = $1;
X    $urlpath = ( $2 ? $2 : '/');
X}
Xelse {
X    die "URL: $starting_url seemes to be incorrect\n";
X}
X
X$urlpath=~m#^(.*)/([^/]*)$#;
X$urldir=$1;
X$urlfile=$2;
X
X# if(!$force_html) {
X#      # Let's assume that a non-HTML file is a directory.
X#      if($urlfile && (!(&is_htmlfile($urlfile)))) {
X#          $urldir.="/$urlfile";
X#          $urlfile="";
X#      }
X# }
X
X$urlbase=$urlhost.$urldir;
X$urlroot=$urlhost;
X
Xprint "## urlbase=$urlbase urlfile=$urlfile\n" if $debug;
X
X$original_prefix=$prefix;
X$prefix=$urlbase if $prefix eq " undef ";
X
Xchdir $targetdir or
X    do {
X        &mkdirhier($targetdir);
X        chdir($targetdir) or die "cannot cd to $targetdir\n";
X    };
Xchop($cwd=`pwd`);
X
X# If an HTML file is specified by the URL,
X#   then get that file first
X# else
X#   get the index of the URL and save it as index.html
X
Xif($urlfile) {
X    @fetchlist=($starting_url,0);
X}
Xelse {
X    $u="$urlbase/";
X    @fetchlist=($u,0);
X}
X
X@history=($fetchlist[0]);
X$forkcnt=0;
Xfor($i=0;$i<$max_fetch_proc;$i++) {
X    $childstat[$i]=0;
X}
X
X$fetch_first_time=1;
X
Xif($max_fetch_proc>1) {
X    while(1) {
X        while(! $fetchlist[0]) {
X            if (&wait_fetch()<0) {
X                &clean_tmpfiles();
X                exit;
X            }
X        }
X        if($forkcnt>=$max_fetch_proc) {
X            &wait_fetch();
X        }
X        else {
X            &fork_fetch();
X        }
X    }
X}
Xelse {
X    &fork_fetch();
X    while(1) {
X        &wait_fetch();
X        exit unless $forkcnt;
X    }
X}
X        
X
Xsub fork_fetch {
X    my($u,$p,$f,$d,$l,$pid,$i,$childid,$n,$newlistname);
X
X    $u=shift(@fetchlist);
X    $l=shift(@fetchlist);
X
X    ($p,$f)=($u=~m#(\w+)://(.*)$#);
X    $f=$p."/".$f;
X    if($f=~m#/$#) {
X          $f.="$dirinfo_file";
X    }
X    elsif($f=~m#/\.\.$#) {
X          $f.="/$dirinfo_file";
X    }
X
X    $f=&change_filename($f);
X
X    if(-d $f) {
X        print "## $u was ignored because $f was a directory\n" if $debug;
X        if($max_fetch_proc==1) {
X             $forkcnt++;
X        }
X        return;
X    }
X
X    ($d)=($f=~m#^(.*)/[^/]+$#);
X    if($d && (! -d $d)) {
X#        print "## calling mkdirhier for $d\n" if $debug;
X        &mkdirhier($d);
X    }
X
X    if(($l==1) && ($u=~m#^$starting_url/#)) {
X#       http://foo/bar was moved to http://foo/bar/
X        $prefix=$starting_url if $original_prefix eq " undef ";
X    }
X
X    $childid=-1;
X    for($i=0;$i<$max_fetch_proc;$i++) {
X        if($childstat[$i]==0) {
X           $childid=$i;
X           $childstat[$i]=1;
X           last;
X        }
X    }
X    die "All children are busy, this must not be the case\n" if $childid<0;
X    $n="sourceurl$childid";
X    ${$n}=$u;
X    $n="childlevel$childid";
X    ${$n}=$l;
X    $n="newlist$childid";
X#    $newlistname=((&is_htmlfile($f)) ? "$tmpfile_dir/$this_pid$n" : "");
X    $newlistname="$tmpfile_dir/$this_pid$n";
X    ${$n}=$newlistname;
X
X    if($max_fetch_proc>1) {
X         $pid=fork;
X    }
X    else {
X         $pid=0;
X    }
X    if($pid == 0) {
X         print "## pid $$ fetching $u --> $f\n";
X         my($fetch_in_opened,$fetch_out_opened)=(0,0);
X         my($fetch_cmdline,$expect_header,$content_type,
X            $expected_size,$received_size,$make_newlist);
X         $expect_header=0; $content_type=""; $make_newlist=0;
X         $expected_size=0;
X
X         if(($local_file_cache==0) || (! -e $f) ||
X               &ignore_local_file_cache($u,$f)) {
X            $fetch_cmdline="$fetch_command ";
X            if($include_header_info && $u=~/^http:/i) {
X                 $expect_header=1;
X                 $fetch_cmdline.="$include_header_info ";
X            }
X            $fetch_cmdline.="$fetch_opt " if $fetch_opt;
X            $fetch_cmdline.="\'$u\' $fetch_stderr |";
X            if($sleep) {
X                 sleep $sleep unless $fetch_first_time;
X                 $fetch_first_time=0;
X            }
X            open(FETCH_IN,$fetch_cmdline) ||
X                 die "$fetch_command $u | cannot be opened\n";
X            $fetch_in_opened=1;
X            $make_newlist=&is_htmlfile($f);
X            $backup_old_file && -e $f && rename($f,$f.$tmp_rename);
X            open(FETCH_OUT,"> $f") || die "> $f cannot be opened\n";
X            $fetch_out_opened=1;
X         }
X         elsif(&is_htmlfile($f)) {
X            print "## using local file $f as cache\n" if $debug;
X            open(FETCH_IN,$f) || die "$f cannot be opened\n";
X            $fetch_in_opened=1;
X            $make_newlist=1;
X         }
X         else {
X            print "## local file $f has been kept\n" if $debug;
X         }
X
X         if($fetch_in_opened && $expect_header) {
X            print "## checking header info of $u\n" if $debug;
X            $/="\n";
X            while(($_=<FETCH_IN>) && ($_!~/^[\r\n]*$/)) {
X               if($_=~/^content-type:[\s\t]*(.*)[\s\t\r\n]*$/i) {
X                   $content_type=$1;
X               }
X               elsif($_=~/^content-length:[\s\t]*(\d+)/i) {
X                   $expected_size=$1;
X               }
X            }
X            print "## content-type of $u is $content_type\n" if $debug;
X            $make_newlist=($content_type=~/text\/html/ ? 1 : 0) if $content_type;
X         }
X              
X         if($make_newlist) {
X            undef $/;
X            $_=<FETCH_IN>;
X            $received_size=length($_);
X            my($modbuf,@newlist)=&extract_html_ref($_,$u,$l);
X            if($max_fetch_proc>1) {
X                open(NEWLIST,">$newlistname") ||
X                     die "$newlistname cannot be opened\n";
X                for (@newlist) {
X                     print NEWLIST "$_\n";
X                }
X                close(NEWLIST);
X            }
X            else {
X                @global_newlist=@newlist;
X            }
X            if($fetch_out_opened) {
X                 print FETCH_OUT $modbuf;
X            }
X         }
X         elsif($fetch_in_opened && $fetch_out_opened) {
X            my($l);
X            while($l=read(FETCH_IN,$_,1024)) {
X               $received_size+=$l;
X               print FETCH_OUT $_;
X            }
X         }
X
X         unless($make_newlist) {
X            if($max_fetch_proc>1) {
X                open(NEWLIST,">$newlistname") ||
X                     die "$newlistname cannot be opened\n";
X                close(NEWLIST);
X            }
X            else {
X                @global_newlist=();
X            }
X         }
X
X         close(FETCH_IN) if $fetch_in_opened;
X
X         if($fetch_out_opened) {
X              close(FETCH_OUT);
X              if($backup_old_file) {
X                 if(($received_size>0) &&
X                    ((!$check_file_size) ||
X                         (!($expected_size>0)) ||
X                             ($expected_size==$received_size))) {
X                      -e $f.$tmp_rename && unlink($f.$tmp_rename);
X                 }
X                 else {
X                      print "## failed to fetch $f\n" if $debug;
X                      ! -e $f.$tmp_rename ||
X                         (unlink($f) && rename($f.$tmp_rename,$f));
X                 }
X              }
X         }
X         
X         if ($max_fetch_proc>1) {
X            exit 0;
X         }
X         else {
X            $forkcnt++;
X         }
X    }
X    elsif($pid>0) {
X         print "## chiled process $pid was forked - $u $f\n" if $debug;
X         $forkcnt++;
X         $childstat[$childid]=$pid;
X    }
X    else {
X         die "cannot fork\n";
X    }
X}
X
Xsub encode_url_unsafe {
X    my($u)=@_;
X    my($u1,$x);
X    $u1="";
X    while($u) {
X      $x=substr($u,0,1); $u=substr($u,1);
X      if(index(" <>\"#%{}|\\^~[]`\@:\033",$x) >=0) {
X         $u1.="%";
X         $u1.=sprintf("%X",ord($x));
X      }
X      else {
X         $u1.=$x;
X      }
X    }
X    $u1;
X}
X
Xsub extract_html_ref {
X  my($url,$level);
X  ($_,$url,$level)=@_;
X  my(@l,$tag,$tag1,$ref,$refgarbage,$garbage,$quote,$type,$modbuf,$end_with_lf);
X  @l=();
X  
X  $modbuf="";
X  $end_with_lf=1 if $_=~/\n$/;
X
X  while($_) {
X     $_=~/(<a[\s\t\r\n]+)|(<ima*ge*[\s\t\r\n]+)|(<frame[\s\t\r\n]+)|(<body[\s\t\r\n]+)|(<base[\s\t\r\n]+)|(<area[\s\t\r\n]+)|(<meta[\s\t\r\n]+)|(<form[\s\t\r\n]+)|(<embed[\s\t\r\n]+)|(<applet[\s\t\r\n]+)|(<bgsound[\s\t\r\n]+)|(<!--)|$/i;
X     $modbuf.=$`.$&;
X     if($&) {
X          $tag=$&;
X          $_=$';
X          if($tag=~/<!--/) {
X#              $_=~/(-->)|$/;
X              $_=~/>|$/;
X              $modbuf.=$`.$&;
X              $_=$';
X              next;
X          }
X          $type="F";
X          $_=~/^[^>]*/;
X          $tag1=$&; $_=$';
X          if($tag=~/<a/i) {
X              $tag1=~/(href[\s\t\r\n]*=[\s\t\r\n]*)|$/i;
X              $modbuf.=$`.$&;
X              $ref=$';
X          }
X          elsif($tag=~/(<ima*ge*)|(<frame)/i) {
X              $tag1=~/(src[\s\t\r\n]*=[\s\t\r\n]*)|$/i;
X              $modbuf.=$`.$&;
X              $ref=$';
X          }
X          elsif($tag=~/<body/i) {
X              $tag1=~/(background[\s\t\r\n]*=[\s\t\r\n]*)|$/i;
X              $modbuf.=$`.$&;
X              $ref=$';
X          }
X          elsif($tag=~/<base/i) {
X              $tag1=~/(href[\s\t\r\n]*=[\s\t\r\n]*)|$/i;
X              $modbuf.=$`.$&;
X              $ref=$';
X              $type="U";
X          }
X          elsif($tag=~/<meta/i) {
X#         <META HTTP-EQUIV="refresh" CONTENT="2;URL=main.htm">
X              $tag1=~/(url[\s\t\r\n]*=[\s\t\r\n]*)|$/i;
X              $modbuf.=$`.$&;
X              $ref=$';
X              if($ref =~/(.*)(["\s\t\r\n].*$)/s) {
X                  $ref=$1;
X                  $_=$2.$_;
X              }
X          }
X          elsif($tag=~/<embed/i) {
X              $tag1=~/(src[\s\t\r\n]*=[\s\t\r\n]*)|$/i;
X              $modbuf.=$`.$&;
X              $ref=$';
X          }
X          elsif($tag=~/<applet/i) {
X              $tag1=~/(code[\s\t\r\n]*=[\s\t\r\n]*)|$/i;
X              $modbuf.=$`.$&;
X              $ref=$';
X          }
X          elsif($tag=~/<form/i) {
X              $tag1=~/(action[\s\t\r\n]*=[\s\t\r\n]*)|$/i;
X              $modbuf.=$`.$&;
X              $ref=$';
X          }
X          elsif($tag=~/<bgsound/i) {
X              $tag1=~/(=[\s\t\r\n]*)|$/i;
X              $modbuf.=$`.$&;
X              $ref=$';
X          }
X          else {
X              next;
X          }
X          if($ref) {
X              $garbage="";
X              if($ref=~/^"?mailto:/) {
X                  $garbage=$ref;
X                  $ref="";
X              }
X              else {
X                  if($ref=~/^([^\s\t\r\n]+)([\s\t\r\n].*)$/s) {
X                        $ref=$1;
X                        $garbage=$2.$garbage;
X                  }
X                  $quote="";
X                  if($ref=~/^["']/) {
X                     $quote=substr($ref,0,1);
X                     $ref=~/^$quote[^$quote]+$quote/;
X                     if($&) {
X                         $ref=$&; $garbage=$'.$garbage;
X                         $ref=substr($ref,1,-1);
X                     }
X                     else {
X                         $garbage=$ref.$garbage; $ref="";
X                     }
X                  }
X                  if($ref!~m#^[\w./]#) {
X                     $refgarbage=$ref;
X                     $ref="";
X                  }
X                  elsif($ref=~m/[\s\t\#].*$/) {
X                     $ref=$`; $refgarbage=$&.$';
X                  }
X                  else {
X                     $refgarbage="";
X                  }
X                  if($ref) {
X                        push(@l, ("$type\t$ref"));
X                  }
X                  $ref=&modify_local_links($ref,$url,$level,$type) if $modify_local_links;
X                  $modbuf.=$quote.$ref.$refgarbage.$quote;
X              }
X              $modbuf.=$garbage;
X          }
X     }
X     else {
X          $_="";
X     }
X  }
X  $modbuf.="\n" if ($end_with_lf && $modbuf!~/\n$/); # I don't know why I do this
X  return ($modbuf,@l);
X}
X
Xsub modify_local_links {
X     my($ref,$url,$level,$type)=@_;
X     my($protocol,$server,$path,$f);
X     if($type eq "U") {
X         return $ref if $level >= $depth;
X         return $ref if $ref!~/^$prefix/;
X         ($protocol,$server,$path)=($ref=~m#^\s*(\w+)://([\w-\.]+:?\d*)([^ \t]*)$#);
X         $f=$protocol."/".$server.$path;
X         $f=&change_filename($f);
X         $ref="file:".$cwd."/".$f;
X         return $ref;
X     }
X     if($ref=~m#^/#) {
X         ($protocol,$server)=($url=~m#^\s*(\w+)://([\w-\.]+:?\d*)#);
X         $f=$protocol."/".$server.$ref;
X         $f=&change_filename($f);
X         $ref="file:".$cwd."/".$f;
X         return $ref;
X     }
X     if($ref=~m#^\w+://#) {
X         return $ref if $level >= $depth;
X         return $ref if $ref!~/^$prefix/;
X         ($protocol,$server,$path)=($ref=~m#^\s*(\w+)://([\w-\.]+:?\d*)([^ \t]*)$#);
X         $f=$protocol."/".$server.$path;
X         $f=&change_filename($f);
X         $ref="file:".$cwd."/".$f;
X         return $ref;
X     }
X     $f=$ref;
X     $f=&change_filename($f);
X     return $f;
X}
X
Xsub wait_fetch {
X    my($pid,$i,$j,$u,$f,$childid,$n,$newlistname,@newlist,$l);
X
X    if($max_fetch_proc>1) {
X        $childid=-1;
X        while(1) {
X           $pid=wait;
X           last if $pid<0;
X           for($i=0;$i<$max_fetch_proc;$i++) {
X               if($childstat[$i] == $pid) {
X                  print "## child process $pid ended\n" if $debug;
X                  $forkcnt--;
X                  $childid=$i;
X                  $childstat[$i]=0;
X                  last;
X               }
X           }
X           last if $childid >= 0;
X        }
X    }
X    else {
X       $pid=-1;
X       $forkcnt--;
X       $childid=0;
X       $childstat[0]=0;
X    }
X
X    if($childid>=0) {
X       $n="newlist$childid";
X       $newlistname=${$n};
X       if($newlistname) {
X           $n="childlevel$childid";
X           $l=${$n};
X           if($l<$depth) {
X               $l++;
X               if($max_fetch_proc>1) {
X                   open(NEWLIST,$newlistname) ||
X                         die "$newlistname cannot be opened\n";
X                   while(<NEWLIST>) {
X                       chop;
X                       push(@newlist,($_));
X                   }
X                   close(NEWLIST);
X               }
X               else {
X                   @newlist=@global_newlist;
X               }
X               $n="sourceurl$childid";
X               $u=${$n};
X               &append_fetchlist($u,$l,@newlist);
X           }
X       }
X       if($fetchlist[0]) {
X             &fork_fetch();
X       }
X    }
X
X    return $pid;
X}
X
Xsub clean_tmpfiles {
X    my($i,$n);
X    for($i=0;$i<$max_fetch_proc;$i++) {
X       $n="$tmpfile_dir/${this_pid}newlist$i";
X       -f $n && unlink($n);
X    }
X}
X
Xsub append_fetchlist {
X     my($sourceurl,$level,@flist)=@_;
X     my($f,$u,$h,$a,$type,$baseurl);
X     $baseurl="";
X     foreach $f (@flist) {
X        ($type,$f)=split(/\t/,$f);
X        if($type eq "U") {
X           $baseurl=$f;
X           $baseurl=~s|/$||;
X           next;
X        }
X        print "## append_fetchlist: $f of $sourceurl\n" if $debug;
X        if($get_image || !($f=~/(\.jpe*g$)|(\.gif$)/i)) {
X           if($f=~/\w+:/) {
X                $u=$f;
X           }
X           else {
X               if($f=~/^\//) {
X                    $u=($baseurl ? "$baseurl$f" : "$urlroot$f");
X               }
X               else {
X                   if($baseurl) {
X                       $a=$baseurl;
X                   }
X                   else {
X                       $a=$sourceurl;
X                       $a=~s|/[^/]*$||;
X                   }
X                   $u="$a/$f";
X               }
X           }
X           while($u=~s|/\./|/|) {}
X           while($u=~s|/[^/]+/\.\./|/|) {}
X
X           if(&select_url($u)) {
X               $u=&change_url($u);
X               $h=1;
X               for(@history) {
X                   if($_ eq $u) {
X                       $h=0;
X                       last;
X                   }
X               }
X               if($h) {
X                    push(@history,($u));
X                    print "## appending ($u, $level)\n" if $debug;
X                    push(@fetchlist,($u,$level));
X               }
X           }
X        }
X     }
X}
X
Xsub mkdirhier {
X      my($directory)=@_;
X      my($prefix,@filename,$filename,$path,$renamed);
X      $directory || return;
X
X      $directory=~m#^/*#;
X      $prefix=$&; $directory=$';
X
X      @filename=split(/\/+/,$directory);
X      while($filename=shift(@filename)) {
X           $path="$prefix$filename";
X           $prefix="$path/";
X           -d "$path" ||
X                do {
X#                       print "## making directory $path\n" if $debug;
X                        $renamed=0;
X                        if($allow_rm_and_mkdir && (-f $path)) {
X                            print "## mkdirhier: changing file $path to directory\n" if $debug;
X                            if($change_dir_to_file) {
X                                $renamed=rename($path,$path.$tmp_rename);
X                            }
X                            unlink($path) unless $renamed;
X                        }
X                        mkdir($path,$mkdir_mode);
X                        if($renamed) {
X                           rename($path.$tmp_rename,"$path/$change_dir_to_file");
X                        }
X                        while($filename=shift(@filename)) {
X                             if("$filename" ne ".") {
X                                  $path="$path/$filename";
X                                  mkdir($path,$mkdir_mode);
X                             }
X                        }
X                        last;
X      		}
X      }
X      
X}
X
Xsub get_last_modified {
X    my($u)=@_;
X    my($cmd,$u_time);
X    $cmd="$get_header_command \'$u\' |";
X    open(HEAD,$cmd) || die "$cmd cannot be opened\n";
X    $/="\n";
X    while(<HEAD>) {
X       if(/^last-modified:[\s\t]*(.*)[\r\n]*$/i) { 
X          $u_time=&timeexpr2time($1);
X          last;
X       }
X    }
X    close(HEAD);
X    ($u_time ? $u_time : time());
X}
X
Xsub timeexpr2time {
X    my($date)=@_;
X    my($yy,$mm,$dd,$hh,$mn,$ss,$tz,$time,@a,$i,$mmp,$timep,$x);
X    @a=split(/[-\s\t\r\n,]+/,$date);
X    $mmp=-1; $timep=-1;
X    for($i=0;$i<=$#a;$i++) {
X        $x=$a[$i];
X        if($x=~/^\D+$/) {
X           if($mmp<0) {
X              $mm=index("JanFebMarAprMayJunJulAugSepOctNovDec",$x);
X              if($mm>=0) {
X                  $mm/=3; $mmp=$i;
X              }
X           }
X        }
X        elsif($x=~/^(\d\d):(\d\d):(\d\d)$/) {
X           $hh=$1; $mn=$2; $ss=$3; $timep=$i;
X        }
X        elsif($x=~/^\d\d\d\d$/) {
X           $yy=$x;
X        }
X        else {
X        }
X    }
X    return undef unless $mmp>=0;
X    if($mmp>0) {
X       if($a[$mmp-1]=~/^\d\d*$/) {
X           $dd=$a[$mmp-1];
X           if($a[$mmp+1]=~/^\d+$/) {
X              $yy=$a[$mmp+1] unless $yy;
X           }
X       }
X       else {
X           $dd=$a[$mmp+1] if $a[$mmp+1]=~/^\d+$/
X       }
X    }
X    else {
X       $dd=$a[$mmp+1] if $a[$mmp+1]=~/^\d+$/;
X    }
X    return undef unless $yy && $mm && $dd && ($timep>=0);
X    $tz=$a[$timep+1]; $tz=~tr/a-z/A-Z/;
X
X    $yy > 99 && ($yy -= 1900);
X    $time = &timegm($ss,$mn,$hh,$dd,$mm,$yy);
X    $time-=(3600*9) if $tz eq 'JST';
X    # I know only JST as time zone other than GMT
X    $time;
X}
END-of-batch-fetch-recursive.in
echo x - configure
sed 's/^X//' >configure << 'END-of-configure'
X#! /usr/local/bin/perl
X#  ^^^^^^^^^^^^^^^^^^^ ここは perl が動くように書き換えてください
X#
X## Batch-Fetch-Recursive Configuration
X## Last modified: Sun Mar 23 07:48:49 1997 JST ##
X
X# -------------------------------------------------------------------
X# Where is your perl?
X#
X# perl のパスを指定する. 
X
X$perl="/usr/local/bin/perl";
X
X# -------------------------------------------------------------------
X# Which command to use to fetch a file
X#
X# $fetch_command には URL を指定してファイルを入手するためのコマンドに
X# 何を使うかを指定する. コマンドとしては, 入手したデータを標準出力に
X# 書き出すものを指定する. 
X#
X# 私の知るかぎり, 次のようなものが使える. 
X#       lynx    を使う場合: lynx -source
X#       lwp-request を使う場合: lwp-request
X#       url_get を使う場合: url_get -b
X#       fetch   を使う場合: fetch -q -o -
X# 
X# $include_header_info には, ファイル本体と同時にヘッダ情報を
X# 取得するためのコマンドラインオプションを指定する.
X#       lynx の場合: -mime_header
X#                    ただし, lynx version 2.6, 2.7 において,
X#                    -mime_header オプションを使うと, GIF ファイルなどを
X#                    取得する場合にファイルの一部が欠落する不具合が
X#                    確認されているので注意されたい. 
X#       lwp-request の場合:     -e
X#       伊藤私家版 fetchの場合: -e
X#       その他の場合: "" (私の知るかぎり対応機能なし)
X#
X# fetch を使う場合など, コマンドの標準エラー出力を標準出力に
X# マージしたい場合は $fetch_stderr="2>&1" を指定する. 
X
X$fetch_command="lynx -source";
X$include_header_info="-mime_header";
X$fetch_stderr="";
X
X# $fetch_command="fetch -q -o -";
X# $include_header_info="";
X# $fetch_stderr="2>&1";
X
X# -------------------------------------------------------------------
X# Depth of the search
X#
X# 最初に入手されるファイルを 第 0 レベルのファイルとする. 
X#
X# 入手した 第 (r-1) レベルのファイルのうち, HTML ファイルと判定される
X# ものを調べ, その中で参照されているファイルのうち, 未入手のものを
X# 入手して第 r レベルのファイルとする. 
X#
X# このような探索の r の最大値を $depth で指定する. 
X
X$depth=1;
X
X# -------------------------------------------------------------------
X# Whether or not to fetch image files
X#
X# イメージファイルを入手する ($get_image=1) かしない ($get_image=0) かを
X# 指定する. 
X# 
X# なお, 実際にイメージファイルを入手するかどうか, 何をもって
X# イメージファイルとするかは, select_utl サブルーチンの中で
X# 決定される.
X
X$get_image=1;
X
X# -------------------------------------------------------------------
X# Target directory where fetched files are saved
X
X# 入手したファイルは, protocol://server/path という URL に
X# 応じて, $targetdir で指定されたディレクトリの下に
X#        protocol/server/path
X# として格納される.
X#
X# 指定されたディレクトリが存在しない場合は, 自動的に生成される.
X
X$targetdir=".";
X
X# -------------------------------------------------------------------
X# How many fetch processes run at the same time
X#
X# ファイルの取得は, $fetch_command で指定したコマンドを
X# 子プロセスで走らせることによって行なわれるが, 最大
X# いくつまで同時に走らせるかを指定する. 
X# ただし, $max_fetch_proc=1 にした場合は子プロセスを
X# 生成しない. 
X# 
X# Ver 1.80 未満では, $max_fetch_proc の初期値を 5 に
X# していたが, 好ましくないと思うので 1 にした.
X
X$max_fetch_proc=1;
X
X# -------------------------------------------------------------------
X# Sleep before fetching the next document
X#
X# サーバの負荷に配慮して, ひとつのファイルの取得後, 次のファイルの
X# 取得前に休眠をいれたいとき, 休眠する秒数を指定する.
X
X$sleep=5;
X
X# -------------------------------------------------------------------
X# Whether or not to print messages for debugging
X#
X# デバッグ用の情報を表示する ($debug=1) か表示しない ($debug=0) かを
X# 指定する. 
X
X$debug=0;
X
X# -------------------------------------------------------------------
X# Permissions of new directories
X#
X# 新しいディレクトリを作るときのモードを 10進数で指定する. 
X
X$mkdir_mode=64*7+8*5+5;
X
X# -------------------------------------------------------------------
X# Whether or not to allow to make a directory after removing an exising
X# file of the same name.
X#
X# $allow_rm_and_mkdir=1
X#   mkdir を行なおうとしたときに同じ名前のファイルが既存で
X#   あった場合, そのファイルを削除して mkdir を行なう.
X# $allow_rm_and_mkdir=0
X#    mkdir を行なおうとしたときに同じ名前のファイルが既存で
X#    あった場合, mkdir を失敗させる.
X# $change_dir_to_file
X#   $allow_rm_and_mkdir が真のときだけ意味を持つ.
X#   もとのファイルを新たに作られたディレクトリの下のファイルに
X#   変更したい場合は, そのファイル名を指定する. たとえば, foo と
X#   いうファイルがディレクトリに変更されるときに, もとの foo を
X#   foo/index.html に変更させるには, 
X#          $change_dir_to_file="index.html"
X#   とする. 
X#   単に削除するだけの場合は, $change_dir_to_file="" とする. 
X
X$allow_rm_and_mkdir=1;
X$change_dir_to_file="index.html";
X
X# -------------------------------------------------------------------
X# Temporary working directory
X#
X# 中間作業用ファイルを書くディレクトリを指定する. 
X
X$tmpfile_dir="/tmp";
X
X# -------------------------------------------------------------------
X# Whether or not to allow to modify local links.
X#
X# $modify_local_links=1
X#   入手した HTML ファイルの中で <base href=...> が
X#   設定されていたり, / で始まるファイル名が参照されたり
X#   している場合, 入手した HTML ファイルの内容を修正して
X#   ローカルな参照関係が正しくなるようにする. 
X# $modify_local_links=0
X#   入手した HTML ファイルの内容は修正しない.
X
X$modify_local_links=1;
X
X# -------------------------------------------------------------------
X# Whether or not to use local file cache
X#
X# $local_file_cache=0
X#   ローカルファイルキャッシュ機能を使わない. 入手しようと
X#   するファイルが既存であっても新たにファイルを入手する.
X# $local_file_cache=1
X#   ローカルファイルキャッシュ機能を使う. 入手しようと
X#   するファイルが既存の場合はファイルの入手は行なわない.
X#   HTML ファイルであればローカルなファイルを読んで, 
X#   そこからリンクをたどる.
X# $ignore_local_file_cache
X#   $local_file_cache==1 の場合に, ファイルが既存であっても
X#   無視してファイルの入手を行なうかどうかを判定する perl スクリプトを
X#   指定する. 入手元の URL と格納先のファイル名を引数として, 
X#   $local_file_cache を無視して入手を行なう場合は真, さもなければ
X#   偽を返すサブルーチンを指定する.
X#   下のサンプルでは, $get_header_command によって, 入手元 URL の
X#   ヘッダ情報を入手し, Last-Modified が, ローカルに存在する
X#   ファイルの日付より新しければ真を返すようにしている. 
X# $use_header_info
X#   ignore_local_file_cache サブルーチンの中で, URL に関する
X#   ヘッダ情報 (Last-Modified など) を取得して利用するか
X#   どうかを指定する.
X# $get_header_command
X#   $use_header_info が真のときに, 指定された URL に関するヘッダ情報を
X#   取得するためのコマンドを指定する. たとえば次のようなものが使える.
X#       lynx -head -dump
X#       lwp-request -m HEAD
X#       (lwp-request は CPAN から入手できる libwww-perl に付属) 
X# $update_dirinfo
X#   ignore_local_file_cache サブルーチンが, ディレクトリ情報の
X#   参照の場合に真を返すようにするには $update_dirinfo=1 とする. 
X#   下のサンプルでは, $use_header_info の指定が優先. 
X
X$local_file_cache=0;
X
X$ignore_local_file_cache=<<'END_IGNORE_LOCAL_FILE_CACHE';
X     sub ignore_local_file_cache {
X        my($u,$f)=@_;
X        if($use_header_info) {
X           my($u_time,$f_time,@f_stat);
X           $u_time=&get_last_modified($u);
X           @f_stat=stat($f);
X           $f_time=$f_stat[9];
X           print "## ignore_local_file_cache: u_time=$u_time, f_time=$f_time\n" if $debug;
X           $u_time > $f_time;
X        }
X        elsif($update_dirinfo) {
X           ($u=~m#/$# ? 1 : 0);  # renew directory info
X        }
X        else {
X           0;
X        }
X     }
X     1;
XEND_IGNORE_LOCAL_FILE_CACHE
X
X$use_header_info=1;
X$get_header_command="lynx -head -dump";
X$update_dirinfo=0;
X
X# -------------------------------------------------------------------
X# Whether or not to assume that a file name without .extension is a
X# directory name.
X#
X#  change_url サブルーチンの中で参照されて, $dir_if_noext が
X#  真のときは, 拡張子のつかないファイル名はディレクトリで
X#  あるとみなすことを指示する. 
X
X$dir_if_noext=0;
X
X# -------------------------------------------------------------------
X# How to change a file name
X#
X# ローカルファイルの名前の変更規則を記述した perl スクリプトを指定する. 
X#
X# 入手する URL protocol://server/path に対して, 格納先の
X# ファイル名が protocol/server/path[/$dirinfo_file] (path が
X# ディレクトリに対する参照のとき $dirinfo_file が付加される)
X# と決定されて変数 $f に設定されるが, それをさらに書き直し
X# たい場合は, $change_filename で書き直しの方法を指定する. 
X
X# 下の初期設定例において, $use_encode_url_unsafe=1 を指定すると
X# " <>\"#%{}|\\^~[]`\@:\033" という unsafe な文字を, "%" の
X# 後に 16進数をつけた形にエンコードする. こうすることの
X# 利点が明らかではないので, 初期値では $use_encode_url_unsafe=0
X# とする. 
X
X$change_filename=<<'END_CHANGE_FILENAME';
X     $use_encode_url_unsafe=0;
X     sub change_filename {
X        my($f)=@_;
X        my($dir);
X        $f=&encode_url_unsafe($f) if $use_encode_url_unsafe;
X        $f=~s|/~|/|;       # file:/foo/~bar/xxx --> file:/foo/bar/xxx
X        $f=~s/\.cgi$/.cgi.html/;
X        $f=~m#(.*)/([^/]+)$#;
X        $dir=$1;
X        if($2=~/[&?=]/) {
X           # seemes to be CGI request
X	   $cgiseq++;
X           $f="$dir/_cgi$cgiseq.html";
X        }
X        $f;
X     }
X     1;
XEND_CHANGE_FILENAME
X
X# -------------------------------------------------------------------
X# URL selection rules
X#
X# URL の取捨選択規則を記述した perl スクリプトを指定する. 
X# 引数に指定された URL を入手対象にするときは 真, 捨てる
X# ときは偽を返すサブルーチンを指定する.
X
X$select_url=<<'END_SELECT_URL';
X     sub select_url {
X         my($url)=@_;
X         if((!$get_image) && ($f=~/(\.jpe*g$)|(\.gif$)/i)) {
X             print "## select_url: $url was ignored because \$get_image=$get_image\n" if $debug;
X             return 0;
X         }
X         if($url !~ /^$prefix/) {
X             print "## select_url: $url was ignored because \$prefix=$prefix\n" if $debug;
X             return 0;
X         }
X         1;
X     }
X     1;
XEND_SELECT_URL
X
X# -------------------------------------------------------------------
X# How to change URL
X#
X# 取得しようとする URL を強制的に書き直す規則を記述した
X# perl スクリプトを指定する. 
X
X$change_url=<<'END_CHANGE_URL';
X     sub change_url {
X        my($url)=@_;
X        if($dir_if_noext) {
X        #It is very likely that a file name without .extension is a directory.
X             $url="$url/" if $url=~m#/[-\w]+$#;
X        }
X        $url;
X     }
X     1;
XEND_CHANGE_URL
X
X# -------------------------------------------------------------------
X# How to tell a file is an HTML file
X#
X# ファイル名を見て, それが HTML ファイルであるかどうかを
X# 判定する perl スクリプトを指定する. 
X
X$is_htmlfile=<<'END_IS_HTMLFILE';
X     sub is_htmlfile {
X        my($f)=@_;
X        ($force_html ?
X            ($f!~/(\.txt$)|(\.jpe*g$)|(\.gif$)/i) :
X            ($f=~/\.[ps]*html*$/i ? 1 : 0));
X     }
X     1;
XEND_IS_HTMLFILE
X
X# -------------------------------------------------------------------
X# Whether or not to consider all files to be HTML files
X#
X# ファイル名によらず, すべてのファイルが HTML ファイルである
X# ものとみなすかどうかのオプションを指定する.
X
X$force_html=1;
X
X# -------------------------------------------------------------------
X# Special character string for temporarily renaming a file
X#
X# 作業の都合で既存ファイルを一時的に別の名前に変更することが
X# ある. そのとき, ファイル名に付加する文字列を指定する. 
X
X$tmp_rename='\x19';
X
X# -------------------------------------------------------------------
X# Whether or not to take a backup copy of an existing file before
X# fetching a new one
X#
X# ファイルを取得する前に, 既存のファイルのバックアップを
X# とって, 取得に失敗したらもとのファイルを復元するかどうかを指定する.
X
X$backup_old_file=1;
X
X# -------------------------------------------------------------------
X# Whether or not to check the size of the fetched file
X#
X# 取得されたファイルのサイズを, ヘッダ情報の Content-Length の
X# 値と比較して不一致の場合は取得に失敗したとみなすかどうかを指定する.
X# $include_header_info が指定されていて, ヘッダに Content-Length が
X# 含まれていた場合のみ有効である. 
X# 
X# なお, サイズの不一致によって取得失敗とみなされた場合であっても,
X# $backup_old_file が真でない限りは何も回復処理は行なわない.
X
X$check_file_size=1;
X
X# -------------------------------------------------------------------
X# File name for directory information
X#
X# URL がディレクトリを指している場合に, 得られたディレクトリ
X# 情報を格納するファイル名を指定する. 
X
X$dirinfo_file="index.html";
X
X# -------------------------------------------------------------------
X# end of configuration parameters
X
X$init=<<'END_INIT';
X$fetch_command="?FETCH_COMMAND";
X$fetch_stderr="?FETCH_STDERR";
X$include_header_info="?INCLUDE_HEADER_INFO";
X$depth=?DEPTH;
X$get_image=?GET_IMAGE;
X$targetdir="?TARGETDIR";
X$max_fetch_proc=?MAX_FETCH_PROC;
X$sleep=?SLEEP;
X$debug=?DEBUG;
X$mkdir_mode=?MKDIR_MODE;
X$allow_rm_and_mkdir=?ALLOW_RM_AND_MKDIR;
X$tmpfile_dir="?TMPFILE_DIR";
X$modify_local_links=?MODIFY_LOCAL_LINKS;
X$local_file_cache=?LOCAL_FILE_CACHE;
X$ignore_local_file_cache=<<'END_IGNORE_LOCAL_FILE_CACHE';
X?IGNORE_LOCAL_FILE_CACHE
XEND_IGNORE_LOCAL_FILE_CACHE
X$use_header_info=?USE_HEADER_INFO;
X$get_header_command="?GET_HEADER_COMMAND";
X$update_dirinfo=?UPDATE_DIRINFO;
X$dir_if_noext=?DIR_IF_NOEXT;
X$change_filename=<<'END_CHANGE_FILENAME';
X?CHANGE_FILENAME
XEND_CHANGE_FILENAME
X$select_url=<<'END_SELECT_URL';
X?SELECT_URL
XEND_SELECT_URL
X$change_url=<<'END_CHANGE_URL';
X?CHANGE_URL
XEND_CHANGE_URL
X$is_htmlfile=<<'END_IS_HTMLFILE';
X?IS_HTMLFILE
XEND_IS_HTMLFILE
X$force_html=?FORCE_HTML;
X$change_dir_to_file="?CHANGE_DIR_TO_FILE";
X$tmp_rename="?TMP_RENAME";
X$backup_old_file=?BACKUP_OLD_FILE;
X$check_file_size=?CHECK_FILE_SIZE;
X$dirinfo_file="?DIRINFO_FILE";
XEND_INIT
X
Xwhile(<>) {
X
X  s/\?PERL/$perl/g;
X  s/\?INIT/$init/g;
X
X  s/\?FETCH_COMMAND/$fetch_command/g;
X  s/\?FETCH_STDERR/$fetch_stderr/g;
X  s/\?INCLUDE_HEADER_INFO/$include_header_info/g;
X  s/\?DEPTH/$depth/g;
X  s/\?GET_IMAGE/$get_image/g;
X  s/\?TARGETDIR/$targetdir/g;
X  s/\?MAX_FETCH_PROC/$max_fetch_proc/g;
X  s/\?SLEEP/$sleep/g;
X  s/\?DEBUG/$debug/g;
X  s/\?MKDIR_MODE/$mkdir_mode/g;
X  s/\?ALLOW_RM_AND_MKDIR/$allow_rm_and_mkdir/g;
X  s/\?TMPFILE_DIR/$tmpfile_dir/g;
X  s/\?MODIFY_LOCAL_LINKS/$modify_local_links/g;
X  s/\?LOCAL_FILE_CACHE/$local_file_cache/g;
X  s/\?IGNORE_LOCAL_FILE_CACHE/$ignore_local_file_cache/g;
X  s/\?USE_HEADER_INFO/$use_header_info/g;
X  s/\?GET_HEADER_COMMAND/$get_header_command/g;
X  s/\?UPDATE_DIRINFO/$update_dirinfo/g;
X  s/\?DIR_IF_NOEXT/$dir_if_noext/g;
X  s/\?CHANGE_FILENAME/$change_filename/g;
X  s/\?SELECT_URL/$select_url/g;
X  s/\?CHANGE_URL/$change_url/g;
X  s/\?IS_HTMLFILE/$is_htmlfile/g;
X  s/\?FORCE_HTML/$force_html/g;
X  s/\?CHANGE_DIR_TO_FILE/$change_dir_to_file/g;
X  s/\?TMP_RENAME/$tmp_rename/g;
X  s/\?BACKUP_OLD_FILE/$backup_old_file/g;
X  s/\?CHECK_FILE_SIZE/$check_file_size/g;
X  s/\?DIRINFO_FILE/$dirinfo_file/g;
X
X  print $_;
X}
END-of-configure
exit