2. perl - HTML のチェック・編集 - HTML の要素を編集(入れ子を入替)

 
2.1 概要
2.2 入れ子を入れ替える

2.1 概要

 やりたいことは単純なのです。  本サイトで

<dl class="bodycontents">
<dt><a href="...">・・・     </a></dt>
<dt><a href="...">・・・     </a></dt>
</dl>
 と書いてある .html が大量にあるのですが。  .css を変更した事情で、これを

<dl class="bodycontents">
<a href="..."><dt>・・・     </dt></a>
<a href="..."><dt>・・・     </dt></a>
</dl>
 という並びに書き換えたいのです。

2.2 入れ子を入れ替える

 で、できたソースがこれ

#!/usr/local/bin/perl

use strict;
use FileList;

use constant true  => 1;
use constant false => 0;
use constant ext => 'html';

sub main
{
	my @argv = @_;
	my $root = $argv[0];

	my $list = FileList->new();

	my $filelist = $list->get($root, ext);

	foreach my $name (sort(@$filelist))
	{
		my $result = check($name);

		if ($result == true)
		{
			print "$name \n";
		}
	}
}

sub check
{
	my ($name) = @_;
	my $fh = IO::File->new();

	$fh->open($name, "r") or die "$!";								#	読込オープン
	my @read = <$fh>;												#	読込
	$fh->close();													#	クローズ

	my $change = false;
	my @write = undef;

	foreach my $line(@read)
	{
		if ($line =~ /<\/a><\/dt>/)									#	</a></dt>	を含む行
		{
			my ($head, $href, $tail) = ($line, $line, $line);

			$head =~ s/(.*)(<dt><a\ .+?>)(.*\n)/$1/;				#	<dt><a href="..."> の前を取得
			$href =~ s/(.*)(<a\ .+?>)(.*\n)/$2/;					#	<a href="..."> 	   を取得
			$tail =~ s/(.*)(<dt><a.*"[ \t\n]*>)(.*\n)/$3/;			#	<dt><a href="..."> の後を取得

			$line = "$head$href<dt>$tail";
			$line =~ s/<\/a><\/dt>/<\/dt><\/a>/;

			$change = true;
		}
		elsif
		   ($line =~ /<dt>/)										#	<dt>	を含む行で
		{
			if ($line !~ /<\/dt>/)									#	</dt>	を含まない
			{
				my ($head, $href, $tail) = ($line, $line, $line);

				$head =~ s/(.*)(<dt><a\ .+?>)(.*\n)/$1/;			#	<dt><a href="..."> の前を取得
				$href =~ s/(.*)(<a\ .+?>)(.*\n)/$2/;				#	<a href="..."> 	   を取得
				$tail =~ s/(.*)(<dt><a.*"[ \t\n]*>)(.*\n)/$3/;		#	<dt><a href="..."> の後を取得

				$line = "$head$href<dt>$tail";
				$line =~ s/<\/a>/<\/dt><\/a>/;

				$change = true;
			}
		}

		push(@write, $line);
	}

	if ($change == true)
	{
		$fh->open($name, "w") or die "$!";
		print $fh @write;
		$fh->close();
	}

	return $change;
}

main(@ARGV);
 FileList に関しては「クラスライブラリ」をご参照ください。  <dt><a href="...">...</a></dt> の文字列が1行に収まっていなければならないという制約がありますがきっちり動きます。  もう少し文法に詳しければ、もっとスマートな書き方があるはずですが・・・

> perl ソースファイル.pl ディレクトリ
 で動作します。