編集(管理者用) | 差分 | 新規作成 | 一覧 | RSS | 表紙 | 検索 | 更新履歴

memo

個人的メモ。

何故か妙なスクリプトの溜まり場になっていたり……。


cpanmetadb.appspot.com を使わずにcpanmを使うためのhelper script

#!/usr/bin/env perl
use strict;
use warnings;
use IO::Zlib;

my $PKGS = '02packages.details.txt.gz';

if (@ARGV < 2) {
    die "Usage: cpanm.pl mirror_site module_name [module_name ...]\n";
}

# setup

require_cpanm();
my $app = App::cpanminus::script->new;
$app->{home} = $app->env('HOME') if $app->env('HOME');
$app->init_tools;

my $mirror_site = shift;
my $modules_re = join '|', map { quotemeta } @ARGV;
$modules_re = qr{^(?:$modules_re)$};

# mirroring packages data file

my $local_pkgs = "$app->{home}/$PKGS";
my $status = $app->mirror("$mirror_site/modules/$PKGS", $local_pkgs);
warn "status $status at mirroring $PKGS\n";

# read packages data

my $fh = IO::Zlib->new;
$fh->open($local_pkgs, 'rb') or die "cannot open $local_pkgs: $!";
while (<$fh>) {
    last if /^$/;
}

my @updated_modules;
while (<$fh>) {
    my ($module, $version, $path) = split /\s+/;
    undef $version if $version eq 'undef';

    next if $module !~ $modules_re;

    my ($ok, $local) = $app->check_module($module, $version || 0);
    if ($ok) {
        warn "$module is up to date. ($local)\n";
        next;
    }

    if (defined $local) {
        warn "$module $version (> $local)\n";
    }
    else {
        warn "$module $version (not installed)\n";
    }
    push @updated_modules, $path;
}
$fh->close;

# output cpanm's option

if (@updated_modules) {
    print '--mirror ', $mirror_site;
    print " ", $_ for @updated_modules;
    print "\n";
}

# load cpanm script

sub require_cpanm {
    my @paths = split /:/, $ENV{PATH};
    for my $path (@paths) {
        my $target = "$path/cpanm";
        next if !-f $target;
        require $target;
        return;
    }
    die "cpanm does not exist";
}

__END__

=head1 NAME

cpanmh.pl - cpanm helper

=head1 SYNOPSIS

  $ cpanmh.pl
  Usage: cpanm.pl mirror_site module_name [module_name ...]
  $ cpanmh.pl http://www.cpan.org/ LWP URI
  status 200 at mirroring 02packages.details.txt.gz
  LWP is up to date. (5.837)
  URI is up to date. (1.56)
  $ cpanmh.pl http://www.cpan.org/ Acme::Bleach DateTime
  status 304 at mirroring 02packages.details.txt.gz
  Acme::Bleach 1.12 (not installed)
  DateTime 0.65 (> 0.63)
  --mirror http://www.cpan.org/ D/DC/DCONWAY/Acme-Bleach-1.12.tar.gz D/DR/DROLSKY/DateTime-0.65.tar.gz
  $ cpanmh.pl http://www.cpan.org/ Acme::Bleach Acme::Damn | cpanm

=head1 DESCRIPTION

No use L<http://cpanmetadb.appspot.com/>.

Use 02packages.details.txt.gz in mirror site.

=head1 AUTHOR

KITAMURA Akatsuki

=head1 License

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 SEE ALSO

L<App::cpanminus>

=cut

view for Pod::POM

package MyPOMView;

use strict;
use warnings;
use base qw( Pod::POM::View::HTML );

my @OVER;

sub view_pod {
	my ($self, $pod) = @_;
	my $title = $pod->head1->[0]->content->[0] || 'no title';
	$title =~ s{\s*$}{};
	my $body = $pod->content->present($self);
	my $index = make_index($pod);

	return <<"__EOT__";
<!DOCTYPE html>
<html>
<link rel="stylesheet" href="./cpan.css">
<title>$title</title>
<body>
$index
$body
</body>
</html>
__EOT__
}


sub view_head1 {
	my ($self, $head1) = @_;
	my $title = $head1->title->present($self);
	my $id = title_to_id($title);

	return qq{<hr>\n<h1 id="$id">$title</h1>\n}
		. $head1->content->present($self);
}

sub view_head2 {
	my ($self, $head2) = @_;
	my $title = $head2->title->present($self);
	my $id = title_to_id($title);

	return qq{<h2 id="$id">$title</h2>\n}
		. $head2->content->present($self);
}

sub view_head3 {
	my ($self, $head3) = @_;
	my $title = $head3->title->present($self);
	my $id = title_to_id($title);

	return qq{<h3 id="$id">$title</h3>\n}
		. $head3->content->present($self);
}

sub view_head4 {
	my ($self, $head4) = @_;
	my $title = $head4->title->present($self);
	my $id = title_to_id($title);

	return qq{<h4 id="$id">$title</h4>\n}
		. $head4->content->present($self);
}

sub view_over {
	my ($self, $over) = @_;
	my ($start, $end, $strip);
	my $items = $over->item();

	if (@$items) {

		my $first_title = $items->[0]->title();

		if ($first_title =~ /^\s*\*\s*/) {
			# '=item *' => <ul>
			$start = "<ul>\n";
			$end   = "</ul>\n";
			$strip = qr/^\s*\*\s*/;
		}
		elsif ($first_title =~ /^\s*\d+\.?\s*/) {
			# '=item 1.' or '=item 1 ' => <ol>
			$start = "<ol>\n";
			$end   = "</ol>\n";
			$strip = qr/^\s*\d+\.?\s*/;
		}
		else {
			$start = "<dl>\n";
			$end   = "</dl>\n";
			$strip = '';
		}

		my $overstack = ref $self ? $self->{ OVER } : \@OVER;
		push(@$overstack, $strip);
		my $content = $over->content->present($self);
		pop(@$overstack);

		return $start
			. $content
			. $end;
	}
	else {
		return "<blockquote>\n"
			. $over->content->present($self)
			. "</blockquote>\n";
	}
}

sub view_item {
	my ($self, $item) = @_;

	my $over  = ref $self ? $self->{ OVER } : \@OVER;
	my $title = $item->title();
	my $strip = $over->[-1];

	if (defined $title) {
		$title = $title->present($self) if ref $title;
		$title =~ s/$strip// if $strip;
		if (length $title && !$strip) {
			my $id = title_to_id($title);
			return qq{<dt id="$id">$title</dt>\n<dd>}
				. $item->content->present($self)
				. "</dd>\n";
		}
	}

	return qq{<li>}
		. "$title\n"
		. $item->content->present($self)
		. "</li>\n";
}

sub view_verbatim {
	my ($self, $text) = @_;

	my ($space) = ( $text =~ /^(\s+)/ );
	$text =~ s/^$space//mg if $space;

	$text =~ s/&/&amp;/g;
	$text =~ s/</&lt;/g;
	$text =~ s/>/&gt;/g;
	return "<pre>$text</pre>\n\n";
}


sub view_seq_link_transform_path {
	my($self, $page) = @_;
	$page =~ s{::}{/}g;
	$page = "/$page.html";
	return $page;
}

sub view_seq_entity {
	my ($self, $entity) = @_;

	if ($entity =~ /^0[0-7]+$/) {
		my $num = oct $entity;
		return "&#$num;";
	}
	elsif ($entity =~ /^0x([\dA-Fa-f]+)$/) {
		return "&#x$1;";
	}
	elsif ($entity =~ /^\d+$/) {
		return "&#$entity;";
	}
	elsif ($entity eq 'verbar') {
		return '|';
	}
	elsif ($entity eq 'sol') {
		return '/';
	}
	else {
		return "&$entity;"
	}
}


# helper function

sub make_index {
	my ($pod, $level) = @_;
	$level ||= 1;

	my $head = "head$level";
	my $result = '';

	for my $head ($pod->$head) {
		my $title = $head->title;
		my $id = title_to_id($title);
		$result .= qq{<li><a href="#$id">$title</a>}
			. make_index($head, $level + 1)
			. qq{</li>\n};
	}

	$result &&= "\n<ul>\n$result</ul>\n";
	return $result;
}

sub title_to_id {
	my ($id) = @_;
	$id =~ s/^\s+//;
	$id =~ s/\s+$//;
	$id =~ s/\W/_/g;
	return $id;
}

1;

test.pod

=encoding utf-8

=head1 NAME

My::Module - just another My::Module

foo bar baz

本日は晴天なり。

E<0x672c>E<0x65e5>E<0x306f>E<0x6674>E<0x5929>E<0x306a>E<0x308a>E<0x3002>E<34>E<0100>

E<verbar> E<sol>

=head1 DESCRIPTION

This is My::Module, a deeply funky piece of Perl code.

=head2 Sample

this is test: L<Pod::POM>, L<foo|"bar">

=head1 METHODS

My::Module implements the following methods

=over 4

=item new(\%config)

This is the constructor method.  It accepts the following 
configuration options:

=over 4

=item name

The name of the thingy.

=item colour

The colour of the thingy.

=back

=item print()

This prints the thingy.

=back

=head2 test1

=over 4

=item *

foo1

=item *

foo2

=item *

foo3

=back

=head3 test1-2

=over 4

=item 1

hoge1

=item 2

hoge2

=over 4

=item 1

hoge2-1

=item 2

hoge2-2

=back

=item *

hoge3

=back

=head2 test1-3

this is a pen.

=over 4

this is a pen. this is a pen. this is a pen. this is a pen. this is a pen. 
this is a pen. this is a pen. this is a pen. this is a pen. this is a pen. 
this is a pen. this is a pen. this is a pen. this is a pen. this is a pen. 
this is a pen. this is a pen. this is a pen. this is a pen. this is a pen. 

=back

this is a pen.

=head1 AUTHOR

My::Module was written by me E<lt>me@here.orgE<gt>

=head2 test2

bar

    bar bar bar bar bar bar bar
    bar bar bar bar bar bar bar

    bar bar bar bar bar bar bar
    bar bar bar bar bar bar bar

baz

	baz baz baz baz baz baz baz
	baz baz baz baz baz baz baz

	baz baz baz baz baz baz baz
	baz baz baz baz baz baz baz

punycodeテスト。

use strict;
use warnings;
use Test::More;

# RFC 3492 samples

my @samples = (
    [   '(A) Arabic (Egyptian):',
        "\x{0644}\x{064A}\x{0647}\x{0645}\x{0627}\x{0628}\x{062A}"
          . "\x{0643}\x{0644}\x{0645}\x{0648}\x{0634}\x{0639}\x{0631}"
          . "\x{0628}\x{064A}\x{061F}",
        'egbpdaj6bu4bxfgehfvwxn',
    ],
    [   '(B) Chinese (simplified):',
        "\x{4ED6}\x{4EEC}\x{4E3A}\x{4EC0}\x{4E48}\x{4E0D}\x{8BF4}"
          . "\x{4E2D}\x{6587}",
        'ihqwcrb4cv8a8dqg056pqjye',
    ],
    [   '(C) Chinese (traditional):',
        "\x{4ED6}\x{5011}\x{7232}\x{4EC0}\x{9EBD}\x{4E0D}\x{8AAA}"
          . "\x{4E2D}\x{6587}",
        'ihqwctvzc91f659drss3x8bo0yb',
    ],
    [   '(D) Czech: Pro<ccaron>prost<ecaron>nemluv<iacute><ccaron>esky',
        "\x{0050}\x{0072}\x{006F}\x{010D}\x{0070}\x{0072}\x{006F}"
          . "\x{0073}\x{0074}\x{011B}\x{006E}\x{0065}\x{006D}\x{006C}"
          . "\x{0075}\x{0076}\x{00ED}\x{010D}\x{0065}\x{0073}\x{006B}"
          . "\x{0079}",
        'Proprostnemluvesky-uyb24dma41a',
    ],
    [   '(E) Hebrew:',
        "\x{05DC}\x{05DE}\x{05D4}\x{05D4}\x{05DD}\x{05E4}\x{05E9}"
          . "\x{05D5}\x{05D8}\x{05DC}\x{05D0}\x{05DE}\x{05D3}\x{05D1}"
          . "\x{05E8}\x{05D9}\x{05DD}\x{05E2}\x{05D1}\x{05E8}\x{05D9}"
          . "\x{05EA}",
        '4dbcagdahymbxekheh6e0a7fei0b',
    ],
    [   '(F) Hindi (Devanagari):',
        "\x{092F}\x{0939}\x{0932}\x{094B}\x{0917}\x{0939}\x{093F}"
          . "\x{0928}\x{094D}\x{0926}\x{0940}\x{0915}\x{094D}\x{092F}"
          . "\x{094B}\x{0902}\x{0928}\x{0939}\x{0940}\x{0902}\x{092C}"
          . "\x{094B}\x{0932}\x{0938}\x{0915}\x{0924}\x{0947}\x{0939}"
          . "\x{0948}\x{0902}",
        'i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd',
    ],
    [   '(G) Japanese (kanji and hiragana):',
        "\x{306A}\x{305C}\x{307F}\x{3093}\x{306A}\x{65E5}\x{672C}"
          . "\x{8A9E}\x{3092}\x{8A71}\x{3057}\x{3066}\x{304F}\x{308C}"
          . "\x{306A}\x{3044}\x{306E}\x{304B}",
        'n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa',
    ],
    [   '(H) Korean (Hangul syllables):',
        "\x{C138}\x{ACC4}\x{C758}\x{BAA8}\x{B4E0}\x{C0AC}\x{B78C}"
          . "\x{B4E4}\x{C774}\x{D55C}\x{AD6D}\x{C5B4}\x{B97C}\x{C774}"
          . "\x{D574}\x{D55C}\x{B2E4}\x{BA74}\x{C5BC}\x{B9C8}\x{B098}"
          . "\x{C88B}\x{C744}\x{AE4C}",
        '989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c',
    ],
    [   '(I) Russian (Cyrillic):',
        "\x{043F}\x{043E}\x{0447}\x{0435}\x{043C}\x{0443}\x{0436}"
          . "\x{0435}\x{043E}\x{043D}\x{0438}\x{043D}\x{0435}\x{0433}"
          . "\x{043E}\x{0432}\x{043E}\x{0440}\x{044F}\x{0442}\x{043F}"
          . "\x{043E}\x{0440}\x{0443}\x{0441}\x{0441}\x{043A}\x{0438}",
        'b1abfaaepdrnnbgefbadotcwatmq2g4l',
    ],
    [   '(J) Spanish: Porqu<eacute>nopuedensimplementehablarenEspa<ntilde>ol',
        "\x{0050}\x{006F}\x{0072}\x{0071}\x{0075}\x{00E9}\x{006E}"
          . "\x{006F}\x{0070}\x{0075}\x{0065}\x{0064}\x{0065}\x{006E}"
          . "\x{0073}\x{0069}\x{006D}\x{0070}\x{006C}\x{0065}\x{006D}"
          . "\x{0065}\x{006E}\x{0074}\x{0065}\x{0068}\x{0061}\x{0062}"
          . "\x{006C}\x{0061}\x{0072}\x{0065}\x{006E}\x{0045}\x{0073}"
          . "\x{0070}\x{0061}\x{00F1}\x{006F}\x{006C}",
        'PorqunopuedensimplementehablarenEspaol-fmd56a',
    ],
    [   '(K) Vietnamese: T<adotbelow>isaoh<odotbelow>kh<ocirc>ngth'
          . '<ecirchookabove>ch<ihookabove>n<oacute>iti<ecircacute>ngVi'
          . '<ecircdotbelow>t',
        "\x{0054}\x{1EA1}\x{0069}\x{0073}\x{0061}\x{006F}\x{0068}"
          . "\x{1ECD}\x{006B}\x{0068}\x{00F4}\x{006E}\x{0067}\x{0074}"
          . "\x{0068}\x{1EC3}\x{0063}\x{0068}\x{1EC9}\x{006E}\x{00F3}"
          . "\x{0069}\x{0074}\x{0069}\x{1EBF}\x{006E}\x{0067}\x{0056}"
          . "\x{0069}\x{1EC7}\x{0074}",
        'TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g',
    ],
    [   '(L) 3<nen>B<gumi><kinpachi><sensei>',
        "\x{0033}\x{5E74}\x{0042}\x{7D44}\x{91D1}\x{516B}\x{5148}"
          . "\x{751F}",
        '3B-ww4c5e180e575a65lsy2b',
    ],
    [   '(M) <amuro><namie>-with-SUPER-MONKEYS',
        "\x{5B89}\x{5BA4}\x{5948}\x{7F8E}\x{6075}\x{002D}\x{0077}"
          . "\x{0069}\x{0074}\x{0068}\x{002D}\x{0053}\x{0055}\x{0050}"
          . "\x{0045}\x{0052}\x{002D}\x{004D}\x{004F}\x{004E}\x{004B}"
          . "\x{0045}\x{0059}\x{0053}",
        '-with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n',
    ],
    [   '(N) Hello-Another-Way-<sorezore><no><basho>',
        "\x{0048}\x{0065}\x{006C}\x{006C}\x{006F}\x{002D}\x{0041}"
          . "\x{006E}\x{006F}\x{0074}\x{0068}\x{0065}\x{0072}\x{002D}"
          . "\x{0057}\x{0061}\x{0079}\x{002D}\x{305D}\x{308C}\x{305E}"
          . "\x{308C}\x{306E}\x{5834}\x{6240}",
        'Hello-Another-Way--fc4qua05auwb3674vfr0b',
    ],
    [   '(O) <hitotsu><yane><no><shita>2',
        "\x{3072}\x{3068}\x{3064}\x{5C4B}\x{6839}\x{306E}\x{4E0B}"
          . "\x{0032}",
        '2-u9tlzr9756bt3uc0v',
    ],
    [   '(P) Maji<de>Koi<suru>5<byou><mae>',
        "\x{004D}\x{0061}\x{006A}\x{0069}\x{3067}\x{004B}\x{006F}"
          . "\x{0069}\x{3059}\x{308B}\x{0035}\x{79D2}\x{524D}",
        'MajiKoi5-783gue6qz075azm5e',
    ],
    [   '(Q) <pafii>de<runba>',
        "\x{30D1}\x{30D5}\x{30A3}\x{30FC}\x{0064}\x{0065}\x{30EB}"
          . "\x{30F3}\x{30D0}",
        'de-jg4avhby1noc0d',
    ],
    [   '(R) <sono><supiido><de>',
        "\x{305D}\x{306E}\x{30B9}\x{30D4}\x{30FC}\x{30C9}\x{3067}",
        'd9juau41awczczp',
    ],
    [   '(S) -> $1.00 <-',
        "\x{002D}\x{003E}\x{0020}\x{0024}\x{0031}\x{002E}\x{0030}"
          . "\x{0030}\x{0020}\x{003C}\x{002D}",
        '-> $1.00 <--',
    ],
);

plan tests => @samples * 2;


#use lib 'src/kraih-mojo-906a1e7/lib';
use Mojo::ByteStream 'b';

for my $sample (@samples) {
    my ($desc, $orig, $puny) = @$sample;
    is b($orig)->punycode_encode->to_string, $puny, "encode: $desc";
    is b($puny)->punycode_decode->to_string, $orig, "decode: $desc";
}

jQueryによるplaceholderサポート別解

$(function () {
	// placeholder をサポートしているなら終了
	if ( 'placeholder' in document.createElement('input') ) return;

	// placeholder属性を持つ要素への処理
	$('[placeholder]')
		.focus( placeholderOff )
		. blur( placeholderOn  )
		. each( placeholderOn  );

	// form要素のsubmit時の処理
	$('form').submit(function() {
		$('[placeholder]', this).each( placeholderOff );
	});

	// placeholder表示を無効
	function placeholderOff() {
		var $this = $(this);
		if ( $this.css('color') === 'graytext' ) {
			$this.css('color', '').val('');
		}
	}

	// placeholderを表示
	function placeholderOn() {
		var $this = $(this);
		if ( !$this.val() ) {
			$this.css('color', 'graytext').val( $this.attr('placeholder') );
		}
	}
});

PCFET0NUWVBFIGh0bWw+CjxodG1sPgo8aGVhZD48dGl0bGU+dGVzdDwvdGl0bGU+PC9oZWFkPgo8
c3R5bGU+Cgpib2R5IHsKCWJhY2tncm91bmQtY29sb3I6I2RkZDsKfQoKI2ltZyB7Cglwb3NpdGlv
bjpyZWxhdGl2ZTsKCXdpZHRoOjMyMHB4OwoJaGVpZ2h0OjQ3MHB4OwoJYmFja2dyb3VuZC1jb2xv
cjojZmZmOwp9Cgouc2xpY2UgewoJcG9zaXRpb246YWJzb2x1dGU7CglsZWZ0OjEwcHg7Cgl3aWR0
aDozMThweDsKCWhlaWdodDoyMzhweDsKCW9wYWNpdHk6MC40OwoJYmFja2dyb3VuZC1jb2xvcjoj
ZmNjOwoJYm9yZGVyOnNvbGlkIDFweCAjZjAwOwp9CgojczEgewoJdG9wOjA7CglsZWZ0OjEwcHg7
Cn0KPC9zdHlsZT4KCjxib2R5Pgo8cD48aW5wdXQgdHlwZT0idGV4dCIgbmFtZT0iaW5wdXQtaGVp
Z2h0IiBpZD0iaW5wdXQtaGVpZ2h0IiBzaXplPSI1Ij5weAo8aW5wdXQgdHlwZT0iYnV0dG9uIiB2
YWx1ZT0ibWFrZSBzbGljZSEiIG9uY2xpY2s9InByZXBhcmUoKTttYWtlU2xpY2VzKCk7Ij48L3A+
Cgo8ZGl2IGlkPSJpbWciPgo8ZGl2IGNsYXNzPSJzbGljZSIgaWQ9InMxIj48L2Rpdj4KPC9kaXY+
CgoKPHNjcmlwdCB0eXBlPSJ0ZXh0L2phdmFzY3JpcHQiPgpmdW5jdGlvbiBwcmVwYXJlKCkgewoJ
dmFyIGltZyA9IGRvY3VtZW50LmdldEVsZW1lbnRCeUlkKCdpbWcnKTsKCXZhciBoZWlnaHQgPSBp
bWcub2Zmc2V0SGVpZ2h0OwoKCXZhciBpbnB1dEggPSBkb2N1bWVudC5nZXRFbGVtZW50QnlJZCgn
aW5wdXQtaGVpZ2h0Jyk7CglpZiAoaW5wdXRILnZhbHVlKSB7CgkJaGVpZ2h0ID0gaW5wdXRILnZh
bHVlOwoJCWltZy5zdHlsZS5oZWlnaHQgPSBpbnB1dEgudmFsdWUgKyAncHgnOwoJfQoJZWxzZSB7
CgkJaW5wdXRILnZhbHVlID0gaGVpZ2h0OwoJfQoKCXZhciBzMSA9IGRvY3VtZW50LmdldEVsZW1l
bnRCeUlkKCdzMScpOwoJdmFyIGltZyA9IHMxLnBhcmVudE5vZGU7Cgl2YXIgc2M7Cgl3aGlsZSAo
c2MgPSBzMS5uZXh0U2libGluZykgewoJCWltZy5yZW1vdmVDaGlsZChzYyk7Cgl9Cn0KCmZ1bmN0
aW9uIG1ha2VTbGljZXMoKSB7Cgl2YXIgczEgPSBkb2N1bWVudC5nZXRFbGVtZW50QnlJZCgnczEn
KTsKCXMxV2lkdGggPSBzMS5vZmZzZXRXaWR0aDsKCXMxSGVpZ2h0ID0gczEub2Zmc2V0SGVpZ2h0
OwoKCXZhciBpbWcgPSBkb2N1bWVudC5nZXRFbGVtZW50QnlJZCgnaW1nJyk7Cgl2YXIgaW1nSGVp
Z2h0ID0gaW1nLm9mZnNldEhlaWdodDsKCXZhciBzbGljZXNOdW0gPSBNYXRoLmNlaWwoMiAqIGlt
Z0hlaWdodCAvIHMxSGVpZ2h0KSAtIDEKCgl2YXIgc3RlcCA9IChpbWdIZWlnaHQgLSBzMUhlaWdo
dCkgLyAoc2xpY2VzTnVtIC0gMSk7CgoJZm9yICh2YXIgbnVtID0gMjsgbnVtIDw9IHNsaWNlc051
bTsgbnVtKyspIHsKCQl2YXIgc0Nsb25lID0gczEuY2xvbmVOb2RlKDApOwoJCXNDbG9uZS5yZW1v
dmVBdHRyaWJ1dGUoJ2lkJyk7CgkJc0Nsb25lLnN0eWxlLnRvcCA9IE1hdGguY2VpbChzdGVwICog
KG51bSAtIDEpKSArICdweCc7CgkJc0Nsb25lLnN0eWxlLmxlZnQgPSAxMCAqIG51bSArICdweCc7
CgkJaW1nLmFwcGVuZENoaWxkKHNDbG9uZSk7Cgl9Cn0KCnByZXBhcmUoKTsKbWFrZVNsaWNlcygp
Owo8L3NjcmlwdD4KCjwvYm9keT4KPC9odG1sPgo=

tanpen.jp用twitter widget設置例

<style type="text/css">
body #twtr-widget-1 .twtr-tweet-text {
	margin-left: 0;
}

body #twtr-widget-1 .twtr-avatar {
	width: 34px;
	height: 30px;
}

body #twtr-widget-1 .twtr-hd a,
body #twtr-widget-1 h3,
body #twtr-widget-1 h4 {
	background-color: #ffffff !important;
	color: #226666 !important;
}

body #twtr-widget-1 .twtr-bd,
body #twtr-widget-1 .twtr-timeline i a,
body #twtr-widget-1 .twtr-bd p {
	color: #000000 !important;
}

body #twtr-widget-1 .twtr-tweet a,
body #twtr-widget-1 .twtr-ft a {
	color: #99592e !important;
}
</style>

<script src="http://widgets.twimg.com/j/2/widget.js"></script>
<script>
new TWTR.Widget({
  version: 2,
  type: 'search',
  search: '#tanpenjp',
  interval: 6000,
  title: '短編に関する呟き',
  subject: '<a href="http://twitter.com/search?q=%23tanpenjp">#tanpenjp<\/a>',
  width: 110,
  height: 300,
  theme: {
    shell: {
      background: 'inherit',
      color: 'inherit'
    },
    tweets: {
      background: 'inherit',
      color: 'inherit',
      links: 'inherit'
    }
  },
  features: {
    scrollbar: false,
    loop: false,
    live: false,
    hashtags: true,
    timestamp: true,
    avatars: true,
    toptweets: false,
    behavior: 'all'
  }
}).render().start();
</script>

AquesTalkをPerlのWin32::API経由で使う。

# Aqtk.pm
package Aqtk;

use Any::Moose;
use Any::Moose '::Util::TypeConstraints';
use Win32::API;

# error messages

my %Error = (
	100 => q{Other error},
	101 => q{Memory shortage},
	102 => q{An undefined reading sign in voice symbol string},
	103 => q{Duration of the meter data is a negative value. },
	104 => q{Internal error (undefined separator detection)},
	105 => q{An undefined reading sign in voice symbol string},
	106 => q{The tag in the voice symbol string is incorrect. },
	107 => q{The length of tag has exceeded the limitation (or, > is not found)},
	108 => q{The value in tag is incorrect},
	109 => q{Cannot play WAVE (sound driver's problem)},
	110 => q{Cannot play WAVE (sound driver's problem, asynchronous play)},
	111 => q{No data that should be uttered},
	200 => q{Voice symbol string is too long. },
	201 => q{A lot of reading signs in one phrase},
	202 => q{Voice symbol string is long (internal buffer over 1)},
	203 => q{Heap memory shortage},
	204 => q{Voice symbol string is long (internal buffer over 1)},
);

# function in AquesTalk DLL

my $Func_Synthe   = Win32::API->new('AquesTalk',   'AquesTalk_Synthe',     'PNP', 'N');
my $Func_Freewave = Win32::API->new('AquesTalk',   'AquesTalk_FreeWave',   'N',   'V');
my $Func_Playsync = Win32::API->new('AquesTalkDa', 'AquesTalkDa_PlaySync', 'PN',  'N');

# types, accessers and methods

subtype 'Aqtk::Type::Speed'
	=> as 'Int'
	=> where { 50 <= $_ && $_ <= 300 };

coerce 'Aqtk::Type::Speed'
	=> from 'Int'
		=> via {
			return 50  if $_  < 50;
			return 300 if 300 < $_ ;
		};

has koe => (
	is => 'rw',
	isa => 'Str',
	trigger => sub { $_[0]->clear_wav },
);

has speed => (
	is => 'rw',
	isa => 'Aqtk::Type::Speed',
	coerce => 1,
	default => 100,
	trigger => sub { $_[0]->clear_wav },
);

has wav => (
	is => 'ro',
	init_arg => undef,
	lazy_build => 1,
);

sub play_sync {
	my ($self) = @_;
	my $ret = $Func_Playsync->Call( $self->koe, $self->speed );
	if ($ret != 0) {
		$self->_split_test;
		confess "Cannot play_sync";
	}
}

sub _build_wav {
	my ($self) = @_;

	my $size_buffer = "\0\0\0\0";  # long
	my $lp_wav = $Func_Synthe->Call( $self->koe, $self->speed, $size_buffer );
	my $size = unpack 'L!', $size_buffer;
	if ($lp_wav == 0) {
		$self->_split_test;
		confess "Cannot get WAVE data";
	}
	my $wav = unpack "P$size", pack('L!', $lp_wav);
	$Func_Freewave->Call($lp_wav);

	return $wav;
}

sub _split_test {
	my ($self) = @_;
	# 0x8141 = kuten, 0x8142 = toten
	my @strs = split /\x81[\x41\x42]/, $self->koe;
	for my $str (@strs) {
		next if ($str eq '');
		my $size_buffer = "\0\0\0\0";  # long
		my $lp_wav = $Func_Synthe->Call($str, 300, $size_buffer);
		my $size = unpack 'L!', $size_buffer;
		if ($lp_wav == 0) {
			warn "AquesTalk error: $size: $Error{$size} : $str\n";
		}
		$Func_Freewave->Call($lp_wav);
	}
}

# end

no Any::Moose;
no Any::Moose '::Util::TypeConstraints';
__PACKAGE__->meta->make_immutable;
1;


=pod
use strict;
use warnings;
use Data::Dumper;
$Data::Dumper::Useqq = 1;

use Aqtk;

my $aqtk = Aqtk->new( koe => 'となりのたけがきにたけたてかけたのわ、たけたてかけたかったから、たけたてかけた。', speed => 140);

print $aqtk->koe, $/;
print $aqtk->speed, $/;

print $aqtk->test, $/;

open my $fh, '>', 'test.wav' or die $!;
print $fh $aqtk->wav;
close $fh;

print $aqtk->speed(200), $/;

open my $fh2, '>', 'test2.wav' or die $!;
print $fh2 $aqtk->wav;
close $fh2;

well-formedでないXHTMLを無理矢理HTMLとして表示させるためのgreasemonkeyスクリプト(非推奨)。

// ==UserScript==
// @name           test
// @include        http://web.archive.org/web/*
// ==/UserScript==

(function() {
	if (
		document.documentElement.namespaceURI
			!= "http://www.mozilla.org/newlayout/xml/parsererror.xml"
	) return;

	var render = function() {
		GM_xmlhttpRequest({
			method: "GET",
			url: location.href,
			onload: function (res) {
				location.href
					= "data:text/html,"
					+ encodeURIComponent(res.responseText)
					+ location.hash;
			}
		});
	}
	var button = document.createElementNS('http://www.w3.org/1999/xhtml', 'input');
	button.type = 'button';
	button.value = 'render as text/html';
	button.addEventListener('click', render, false);
	document.documentElement.appendChild(button);
})();

w3mではてブ (local-CGI用)

#!/usr/bin/perl
use strict;
use warnings;
use CGI;
use URI;

my $uri = URI->new('http://b.hatena.ne.jp/kits/add.confirm');
$uri->query_form( url => $ENV{W3M_URL} );
print CGI::redirect($uri);

ttp://el.jibun.atmarkit.co.jp/hayashi/2009/05/xslt-2c49.html をもう少し短く。

<?xml version="1.0" encoding="utf-8"?>
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">

<xsl:output method="html" indent="yes"/>

<xsl:template match="/root">
  <style type="text/css">
    td { width:20px; height:20px; }
    .cell-0 { background-color:#000000; }
    .cell-1 { background-color:#DB2B00; }
    .cell-2 { background-color:#8B7300; }
    .cell-3 { background-color:#FF9B3B; }
  </style>
  <table border="0" cellspacing="1" cellpadding="0">
    <xsl:apply-templates select="row"/>
  </table>
</xsl:template>

<xsl:template match="row">
  <tr>
    <xsl:call-template name="countup" />
  </tr>
</xsl:template>

<xsl:template name="countup">
  <xsl:param name="index" select="1"/>
  <td class="cell-{substring(@value, $index, 1)}"/>
  <xsl:if test="$index &lt; string-length(@value)">
    <xsl:call-template name="countup">
      <xsl:with-param name="index" select="$index + 1" />
    </xsl:call-template>
  </xsl:if>
</xsl:template>

</xsl:stylesheet>

style要素を使わない別解。

<?xml version="1.0" encoding="utf-8"?>
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">

<xsl:output method="html" indent="yes"/>

<xsl:template name="color">
    <color num="0">#000000</color>
    <color num="1">#DB2B00</color>
    <color num="2">#8B7300</color>
    <color num="3">#FF9B3B</color>
</xsl:template>

<xsl:template match="/root">
    <table border="0" cellpadding="0" cellspacing="1">
        <xsl:apply-templates select="row"/>
    </table>
</xsl:template>

<xsl:template match="row">
    <tr>
        <xsl:call-template name="countup"/>
    </tr>
</xsl:template>

<xsl:template name="countup">
    <xsl:param name="prmcount" select="1"/>
    <td style="width:20px; height:20px; background-color:{
        document('')//color[
            @num = substring( current()/@value, $prmcount, 1 )
        ]
    }"/>
    <xsl:if test="string-length(@value) > $prmcount">
        <xsl:call-template name="countup">
            <xsl:with-param name="prmcount" select="$prmcount + 1" />
        </xsl:call-template>
    </xsl:if>
</xsl:template>

</xsl:stylesheet>

HTML 5目次から要素説明へのアンカーを取り出す。

use strict;
use warnings;
use feature qw(say);
use Data::Dumper;

use XML::LibXML;

my $toc_url = 'http://www.whatwg.org/specs/web-apps/current-work/multipage/';
my $parser = XML::LibXML->new;
my $doc = $parser->parse_html_file($toc_url);

my $anchor_xpath = q{
	//a[
		starts-with(span, "4.")
		and contains( substring-after(@href, "#the-"), "-element")
		and code
	]
};

my @anchors = $doc->findnodes($anchor_xpath);
say '-> ', $_->toString for @anchors;
#print Dumper \@anchors;

Fix XSS in flavour name (CVE-2008-2236)

# Blosxom Plugin: cve_2008_2236
# Author: KITAMURA Akatsuki <kits@akatsukinishisu.net>
# Version: 2008-10-22
# Blosxom Home/Docs/Licensing: http://www.blosxom.com/

package cve_2008_2236;
use strict;

sub start {
	my $escaped_flavour = $blosxom::flavour;
	$escaped_flavour =~ s/&/&amp;/g;
	$escaped_flavour =~ s/</&lt;/g;
	$escaped_flavour =~ s/>/&gt;/g;
	$escaped_flavour =~ s/"/&quot;/g;
	$escaped_flavour =~ s/'/&#39;/g;

	for my $tmpl ( values %{ $blosxom::template{error} } ) {
		$tmpl =~ s/\$(?:blosxom::)?flavour/$escaped_flavour/g;
	}

	1;
}

1;


=head1 NAME

Blosxom Plug-in: cve_2008_2236

=head1 SYNOPSIS

Fix XSS in flavour name (CVE-2008-2236)

http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2008-2236

http://jvn.jp/en/jp/JVN03300113/index.html

http://jvn.jp/jp/JVN03300113/index.html (Japanese)

=head1 AUTHOR

北村曉 (KITAMURA Akatsuki)
<kits@akatsukinishisu.net>,
http://www.akatsukinishisu.net/

=head1 SEE ALSO

cve_2008_2236 plugin:

Blosxom Home/Docs/Licensing: http://www.blosxom.com/

Blosxom Plugin Docs: http://www.blosxom.com/plugins/

=head1 LICENSE

This Blosxom Plug-in Copyright (c) 2008, KITAMURA Akatsuki

Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.

CPANのpodなどのpre要素につく余計なインデントを削除

(function(){
	var pres = document.getElementsByTagName('pre');
	var i = pres.length;
	while (i--) {
		var pre = pres[i];
		var src = pre.innerHTML;
		var indent = /^\s*/.exec(src)[0];
		if (!indent) continue;
		pre.innerHTML = src.replace(new RegExp('(^|\n)' + indent, 'g'), '$1');
	}
})();

或る要素の言語コードを取得する。(XPath)

<?xml version="1.0" encoding="utf-8"?>
<xsl:stylesheet
	version="1.0"
	xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
>
<xsl:output method="text" />
<xsl:strip-space elements="*"/>
<xsl:template match="bar">
	<xsl:value-of select="name()"/>
	<xsl:text> 要素の言語は、</xsl:text>
	<xsl:value-of select="ancestor-or-self::*[@xml:lang][1]/@xml:lang"/>
	<!--<xsl:value-of select="(ancestor-or-self::*/@xml:lang)[last()]"/>-->
	<xsl:text> です。&#10;</xsl:text>
</xsl:template>
</xsl:stylesheet>
<?xml version="1.0" encoding="utf-8"?>
<foo xml:lang="ja">
<foo xml:lang="ko">
<foo xml:lang="zh">
<foo xml:lang="en">
<foo xml:lang="fr">
<foo xml:lang="de">
<bar/>
</foo>
</foo>
</foo>
</foo>
</foo>
</foo>
$ xsltproc a.xsl a.xml
bar 要素の言語は、de です。 

参考

XPath 1.0のlang関数はこの用途には使えない。


Template Toolkit + PerlIO 実験

use strict;
use warnings;
use utf8;
use Template;

my $vars = {
	scalar => 'こんにちは!',
	array => [
		'犬も歩けば棒に当たる',
		'論より証拠',
		'花より団子',
	],
	hash => {
		apple => '林檎',
		pear  => '梨',
		peach => '桃',
		grape => '葡萄',
	},
};

my $tt = Template->new();

open my $tmpl_fh, '<:utf8',               'tmpl.tt' or die $!;
open my $out_fh,  '>:encoding(euc-jp)',   'out.txt' or die $!;

$tt->process($tmpl_fh, $vars, $out_fh) or die $tt->error();

close $tmpl_fh;
close $out_fh;
*挨拶

[% scalar %]

*諺

[% FOREACH item IN array -%]
 - [% item %]
[% END -%]

*果物

[% FOREACH key IN hash.keys -%]
 - [% key %] は、[% hash.$key %] です。
[% END -%]

以上。

eijiro.pl改造

#!/usr/bin/perl
# eijiro.pl - http://www.alc.co.jp/

use strict;
use Encode qw( decode );
use Jcode qw( jcode );
use URI::Fetch;

use LWP::UserAgent;
use URI;
use HTML::FormatText;
use HTML::TreeBuilder;

#use FileHandle;
#use Term::ReadLine;
#use Data::Dumper;
#my $historyfile = $ENV{HOME} . '/.eijirohistory';

my $pager = $ENV{PAGER} || 'less';
my $uri_base = 'http://eow.alc.co.jp/';

if ( @ARGV ) {
	translate( @ARGV );
} else {
	die "usage: $0 word\n";
}


sub translate {
	my $word_in = join ' ', @_;
	return if !$word_in;

	# build URI
	$word_in = jcode($word_in)->utf8();
	my $uri = URI->new($uri_base);
	$uri->path_segments($word_in, 'UTF-8');

	# get HTML page
	#my $content = get($uri) or die "cannot get: $!";

	my $ua = LWP::UserAgent->new();
	$ua->env_proxy();
	my $res = URI::Fetch->fetch($uri, UserAgent => $ua  )
		or die URI::Fetch->errstr;

	my $content = decode('utf8', $res->content());

	# parse and get content
	my $tree = HTML::TreeBuilder->new();
	my $chunk
		= $tree->parse($content)
			->look_down('id', 'resultList')
			->look_down('_tag', 'ul');

	# output content
	my $formatter = HTML::FormatText->new( leftmargin => 0 );
	open my $fh_pager, "| $pager";
	binmode $fh_pager, ':utf8';
	print $fh_pager $formatter->format($chunk);
	close $fh_pager;
}

id, name属性表示のbookmarklet

(function(){
	var elements = $A(document.body.getElementsByTagName('*'));
	var i = elements.length;
	while (i--) {
		var element = elements[i];
		if (element.tagName.toLowerCase() == 'a') {
			var id =  element.id || element.name;
			if (!id) continue;
			var anch = makeIdAnch(id);
			element.parentNode.insertBefore(anch, element);
		}
		else if (element.id) {
			var anch = makeIdAnch(element.id);
			element.insertBefore(anch, element.firstChild);
		}
	}

	function $A(list) {
		var i = list.length, array = new Array(i);
		while (i--) array[i] = list[i];
		return array;
	}

	function makeIdAnch(id) {
		var anch = document.createElement('a');
		var text = document.createTextNode(' ');
		anch.appendChild(text);

		anch.style.backgroundColor = '#ffc';
		anch.style.border = 'outset 1px #ffc';
		anch.style.padding = '0 2px';
		anch.style.textDecoration = 'none';
		anch.style.color = '#00f';
		anch.style.fontSize = '12px';
		anch.style.fontWeight = 'normal';

		anch.href = '#' + id;
		text.data = id;
		return anch;
	}
})();

crossing hatena 新規サービス対応版

(function(){
	var d = document;
	if ( !d.contentType.match(/^text\/html/i) ) return;
	var xulns = 'http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul';
	var hatena = '\u306F\u3066\u306A';
	var services = {
		q: '\u4EBA\u529B\u691C\u7D22' + hatena,
		a: hatena + '\u30A2\u30F3\u30C6\u30CA',
		b: hatena + '\u30D6\u30C3\u30AF\u30DE\u30FC\u30AF',
		d: hatena + '\u30C0\u30A4\u30A2\u30EA\u30FC',
		f: hatena + '\u30D5\u30A9\u30C8\u30E9\u30A4\u30D5',
		g: hatena + '\u30B0\u30EB\u30FC\u30D7',
		r: hatena + 'RSS',
		counter: hatena + '\u30AB\u30A6\u30F3\u30BF\u30FC',
		map: hatena + '\u30DE\u30C3\u30D7',
		graph: hatena + '\u30B0\u30E9\u30D5',
		ring: hatena + '\u30EA\u30F3\u30B0',
		i: hatena + '\u30A2\u30A4\u30C7\u30A2',
		s: hatena + '\u30B9\u30BF\u30FC',
		m: hatena + '\u30E1\u30C3\u30BB\u30FC\u30B8',
		w: hatena + '\u30EF\u30FC\u30EB\u30C9',
		h: hatena + '\u30CF\u30A4\u30AF',
		www: hatena + ' \u30D7\u30ED\u30D5\u30A3\u30FC\u30EB'
	};
	if (d.cookie.match(/rk=/)) {
		services.my = 'My' + hatena;
	}

	var url = location.href;
	var current, user;
	if (url.match(/http:\/\/([^.]+\.)?([abdfghirqsw]|graph|map|ring|counter|www)\.hatena\.ne\.jp\/([A-Za-z][A-Za-z0-9_-]+)\//)) {
		current = RegExp.$2;
		user = RegExp.$3;
	}
	/* Hatena Profile is obsoluted?
	else if (url.match(/http:\/\/www\.hatena\.ne\.jp\/user\?.*userid=([A-Za-z][A-Za-z0-9_-]+)/)) {
		current = 'www';
		user = RegExp.$1;
	}
	*/
	else if (url.match(/http:\/\/www\.hatena\.ne\.jp\/my/)) {
		current = 'my';
		user = d.getElementsByTagName('strong')[0].firstChild.data;
	}
	else if (url.match(/http:\/\/m\.hatena\.ne\.jp\//)) {
		current = 'm';
		user = d.getElementsByTagName('h1')[0]
			.getElementsByTagName('a')[1]
			.firstChild.data
			.replace(/\u306E\u30E1\u30C3\u30BB\u30FC\u30B8/, '');
	}

	if (!current || !user) return;
	if (user == 'entry') return;
	if (user == 'keyword') return;
	if (user == 'idea') return;
	if (user == 'feed') return;

	var box = d.createElementNS(xulns, 'box');
	var bs = box.style;
	bs.position = 'fixed';
	bs.top = '0';
	bs.left = '0';
	bs.zIndex = '100';
	bs.textAlign = 'left';
	bs.backgroundColor = 'ButtonFace';
	bs.border = 'outset 1px ButtonFace';
	bs.MozOpacity = '0.7';

	var mbar = d.createElementNS(xulns, 'menubar');
	mbar.style.borderStyle = 'none';
	box.appendChild(mbar);

	var menu = d.createElementNS(xulns, 'menu');
	menu.setAttribute('label', 'go!');
	mbar.appendChild(menu);
	var mpu = d.createElementNS(xulns, 'menupopup');
	menu.appendChild(mpu);

	for (var srv in services) {
		if (srv == 'www') {
			mpu.appendChild(d.createElementNS(xulns, 'menuseparator'));
		}
		var mi = d.createElementNS(xulns, 'menuitem');
		mpu.appendChild(mi);
		mi.setAttribute('label', services[srv]);
		if (srv == 'a' && !url.match(/simple/)) {
			var mias = d.createElementNS(xulns, 'menuitem');
			mpu.appendChild(mias);
			mias.setAttribute('label', ' simple');
			mias.addEventListener('click', aSimpleHandler(user), false);
		} else if (srv == 'd' && !url.match(/about/)) {
			var mida = d.createElementNS(xulns, 'menuitem');
			mpu.appendChild(mida);
			mida.setAttribute('label', ' about');
			mida.addEventListener('click', dAboutHandler(user), false);
		}
		if (
			srv == current &&
			(
				(srv != 'd' && srv != 'a')
				|| (srv == 'a' && !url.match(/simple/))
				|| (srv == 'd' && !url.match(/about/))
			)
		) {
			mi.setAttribute('disabled', 'true');
			continue;
		}
		mi.addEventListener('click', dispatchHandler(srv, user), false);
	}
	d.body.appendChild(box);

	function dispatchHandler(domain, user) {
		var url;
		/*
		if (domain == 'www') {
			url = 'http://www.hatena.ne.jp/user?userid=' + user;
		}
		*/
		if (domain == 'my') {
			url = 'http://www.hatena.ne.jp/my';
		}
		else if (domain == 'm') {
			url = 'http://m.hatena.ne.jp/';
		}
		else{
			url = 'http://' + domain + '.hatena.ne.jp/' + user + '/';
		}
		return makeHandler(url);
	}

	function aSimpleHandler(user) {
		var url = 'http://a.hatena.ne.jp/' + user + '/simple';
		return makeHandler(url);
	}

	function dAboutHandler(user) {
		var url = 'http://d.hatena.ne.jp/' + user + '/about';
		return makeHandler(url);
	}

	function makeHandler(url) {
		return function(e) {
			var btn = e.button;
			if (btn == 0) {
				location.href = url;
			} else if (btn == 1) {
				window.open(url, '_blank');
			}
		}
	}
})();

Jim Breen's WWWJDIC (漢字字典) のOpenSearchプラグイン。

<SearchPlugin xmlns="http://www.mozilla.org/2006/browser/search/" xmlns:os="http://a9.com/-/spec/opensearch/1.1/">
<os:ShortName>Jim Breen's WWWJDIC</os:ShortName>
<os:Description>Jim Breen's WWWJDIC Japanese Dictionary Server</os:Description>
<os:InputEncoding>EUC-JP</os:InputEncoding>
<os:Image width="16" height="16">data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABAAAAAQBAMAAADt3eJSAAAAMFBMVEUjJIeZmcbOzuRfX6e2tdhDRJl9fbnu7valpc0yM4%2FCwt1UVKOKir%2Ff3u1uba78%2Ffz0pnu9AAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1woTAhkb2RLSfQAAAI1JREFUeNpj%2BK%2Fi4rLExfc%2Fw%2F%2BTu3eyhvIAGWdyhPfEvQExDnbb2OUAGefO5O3riQEyDkx4fnkmSM0BxqrlkiBGQ%2F%2FSqB8z%2FjNUedWwZR5XWc6gtST5ZGCYyyKGi45TX2ZyCskyfJE4yfdgToc%2Fw%2F8rjnHZEr1AXX8d2xIl7gMZ%2F79IKbr%2FBzH%2BX9IFEgAB10v7JtN9VgAAAABJRU5ErkJggg%3D%3D</os:Image>
<SearchForm>http://www.csse.monash.edu.au/~jwb/cgi-bin/wwwjdic.cgi?1B</SearchForm>
<os:Url type="text/html" method="POST" template="http://www.csse.monash.edu.au/~jwb/cgi-bin/wwwjdic.cgi?1D">
  <os:Param name="kanjsel" value="E"/>
  <os:Param name="ksrchkey" value="{searchTerms}"/>
</os:Url>
</SearchPlugin>

表示したOpenSearchプラグインXMLファイルをFirefoxにインストールするためのbookmarklet。

javascript:(function(){%0A%09window.external.AddSearchProvider(location.href);%0A})();

ちょっと気になったはてなテーマのCSS。


stone起動・停止スクリプト例

#!/bin/sh
#
LANG=C
STONE=/usr/local/bin/stone
CONF=/etc/stone.conf
LD_LIBRARY_PATH=/usr/local/lib:/usr/lib:/usr/local/ssl/lib
export LANG LD_LIBRARY_PATH

# kill the named process(es)
killproc() {
	pid=`/usr/bin/ps -e |
		/usr/bin/grep $1 |
		/usr/bin/sed -e 's/^  *//' -e 's/ .*//'`
	[ "$pid" != "" ] && kill $pid
}

case "$1" in
	'start')
		[ -f $STONE ] || exit 0
		[ -f $CONF ] || exit 0
		$STONE -C $CONF &
		;;
	'stop')
		killproc stone
		;;
	*)
		echo "Usage: /etc/rc2.d/S99stone { start | stop }"
		;;
esac
exit 0

http://twitter.com/orzccc/statuses/150630652


簡単な見出し一覧bookmarklet。

(function(){
	var elements = document.body.getElementsByTagName('*');
	var result = '';
	for (var i = 0, len = elements.length; i < len; i++) {
		var elem = elements[i];
		var tag = elem.tagName.toLowerCase();
		if (!tag.match(/^h[1-6]$/)) continue;
		var heading = innerText(elem);
		var bullet = 
			(tag == 'h1') ? '*'     :
			(tag == 'h2') ? '**'    :
			(tag == 'h3') ? '***'   :
			(tag == 'h4') ? '****'  :
			(tag == 'h5') ? '*****' :
			                '******';
		result += bullet + heading + '\n';
	}
	alert(result);

	function innerText(element) {
		var children = element.childNodes;
		var result = '';
		for (var i = 0, len = children.length; i < len; i++) {
			var child = children[i];
			if (child.firstChild)
				 result += innerText(child);
			else if (child.nodeType == 3)
				 result += child.data;
			else if (child.alt)
				 result += child.alt;
		}
		return result;
	}
})();

折り返しをウィンドウ幅 ⇔ 2000文字で切り替える秀丸用マクロ

// 折り返し切り替え (ウィンドウ幅 ⇔ 2000文字)

#ori = getconfig("AutoAdjustOrikaeshi");

if (#ori == 0) {
	config("xAutoAdjustOrikaeshi:1");
}
else {
	config("xOrikaeshi:2000");
}

一貫していなくとも、それがHTML

<p><a href="http://magicant.txt-nifty.com/main/2007/02/2_bb17.html"><cite>まじかんと雑記: 引用の話 その 2</cite></a>にて、以下のようなマークアップを例に挙げて、実際に発言されていない後者の科白をq要素とするのが妥当かどうか、またq要素の定義をどう解釈するかについて述べられています。</p>

<blockquote cite="http://magicant.txt-nifty.com/main/2007/02/2_bb17.html" title="まじかんと雑記: 引用の話 その 2">
<p><code>私は&lt;q&gt;こういうのは苦手なんだよなぁ&lt;/q&gt;とわざと太郎に聞こえるようにつぶやいたが、彼は&lt;q&gt;僕が代わりにやってあげるよ&lt;/q&gt;とは言ってくれなかった。</code></p>
</blockquote>

<p>以下はその関連記事。</p>

<ul>
<li><a href="http://b.hatena.ne.jp/entry/http://magicant.txt-nifty.com/main/2007/02/2_bb17.html">はてなブックマーク - まじかんと雑記: 引用の話 その 2</a></li>
<li><a href="http://magicant.txt-nifty.com/main/2007/03/html_3_c7cf.html">まじかんと雑記: HTML における引用とは その 3</a></li>
</ul>

<p><a href="http://magicant.txt-nifty.com/main/2007/03/html_3_c7cf.html" title="まじかんと雑記: HTML における引用とは その 3">HTML における引用とは その 3</a>では、まじかんとさんは以下の意見を述べています。</p>

<blockquote cite="http://magicant.txt-nifty.com/main/2007/03/html_3_c7cf.html" title="まじかんと雑記: HTML における引用とは その 3">
<p>ここで、<q>僕が代わりにやってあげるよ</q>というのは<q>太郎</q>が実際に発言したものではないので、引用とは認めない、という解釈は可能である。</p>
</blockquote>

<blockquote cite="http://magicant.txt-nifty.com/main/2007/03/html_3_c7cf.html" title="まじかんと雑記: HTML における引用とは その 3">
<p>しかし上記の解釈では実際の発言ではない文は q 要素としてマークアップされずに引用符としてそのまま残る。一部の引用符は q タグや em タグに置き換えてマークアップするのに、一方でそのままの引用符があるというのでは一貫性がない。</p>
</blockquote>

<p>q要素を(厳密な意味での)引用に限ると一貫性を欠く、というのは同意なのですが、しかしそういった一貫性を持っていないのが現状のHTMLではないか、とも思うのです。言い換えると、HTMLが持つ語彙は、強調・引用・引用元などなど限られたものであって、(通常の文章で使われる)引用符記号が持つ役割をすべてマークアップで置き換える、という観点では設計されてはいないのではないか、ということです。</p>

<blockquote cite="http://magicant.txt-nifty.com/main/2007/03/html_3_c7cf.html" title="まじかんと雑記: HTML における引用とは その 3">
<p>そもそも、マークアップによって文章の形式的構造を表すという原理に照らし合わせれば、まず第一に行われるべきは引用符の意味が強調なのか書物の題名なのかそれとも文中の文なのかということの区別であって、発言が実際のものであるかどうかという区別は文中の文がまず地の文と区別された上で文脈上判断されるものだ。</p>
</blockquote>

<p>この意見についても、意見単体としては理解できるところではありますが、「<q>HTMLにおける引用とは</q>」という主題を離れて「理想のマークアップ言語はどうあるべきか」という話になってしまっているように思います。</p>

<p>HTML 4.01仕様書の<a href="http://www.asahi-net.or.jp/~sd5a-ucd/rec-html401j/struct/text.html" title="Paragraphs, Lines, and Phrases (ja)">9 テキスト</a>を見る限りでは、テキストのマークアップは強調・引用元・コード・省略形など、割と実際的な構成要素について定義されており、「地の文と文中文を区別する」という観点は</p>

enableAbbr.htc

<public:attach event="oncontentready" onevent="enableAbbr()" />
<script type="text/javascript">

var coreAttrs = [ 'id', 'className', 'title', 'lang', 'dir', 'xml:lang' ];

// abbr要素有効化
function enableAbbr() {
	// 安全のため配列に変換
	var abbrs = $A( this.getElementsByTagName('abbr') );

	for (var i = 0, len = abbrs.length; i < len; i++) {
		var oldAbbr = abbrs[i];
		var newAbbr = cloneAbbr(oldAbbr);
		var parent = oldAbbr.parentNode;

		// abbr要素内容を移動
		// nextのチェックはタグ閉じ忘れなどへの対策のため
		var next = oldAbbr.nextSibling;
		while (next && next.nodeName != '/ABBR') {
			newAbbr.appendChild(oldAbbr.nextSibling);
			next = oldAbbr.nextSibling;
		}
		if (next) parent.removeChild(next);

		parent.insertBefore(newAbbr, oldAbbr);
		parent.removeChild(oldAbbr);
	}

	// 確認用
	//alert(this.ownerDocument.body.innerHTML);
}

// abbr要素の複製を作成
function cloneAbbr(oldAbbr) {
	var newAbbr = this.ownerDocument.createElement('abbr');

	// 属性のコピー
	for (var i = 0, len = coreAttrs.length; i < len; i++) {
		var attr = coreAttrs[i];
		if (oldAbbr[attr]) newAbbr[attr] = oldAbbr[attr];
	}

	// style属性のコピー
	if (oldAbbr.style.cssText) newAbbr.style.cssText = oldAbbr.style.cssText;

	return newAbbr;
}

// 配列に変換
function $A(list) {
	var len = list.length;
	var array = new Array(len);
	for (var i = 0; i < len; i++) {
		array[i] = list[i];
	}
	return array;
}

</script>

stricter.org/other/diary/2007/01#d_01_02 の別案。

#!/usr/local/bin/perl

use strict;
use File::Find;

my @month_archive;

# ファイルを探索
find(
	# YYYY/DD.xhtml のファイルがあれば、
	# YYYY/DD の部分を配列に追加
	sub {
		if ($File::Find::name =~ m{(\d{4}/\d{2})\.xhtml$}) {
			push @month_archive, $1;
		}
	},

	# 基点は現在のディレクトリ
	'.'
);

if (@month_archive) {
	# ファイルがあれば、
	# 降順にソートして先頭の YYYY/DD を取り出す
	my $latest = ( sort { $b cmp $a } @month_archive )[0];

	# そこにリダイレクトする
	print "Location:http://stricter.org/other/diary/$latest\n\n";
}
else {
	# ファイルが無かったらエラー表示
	print "Content-type: text/plain; charset=utf-8\n\n",
	print "Error.\n";
}

data URI をコマンドラインで生成するよ。

use strict;
use MIME::Base64;
use File::MMagic;
use IO::File;

foreach my $file (@ARGV) {
	print "$file : \n";
	print data_uri($file), "\n\n";
}

sub data_uri {
	my $file = shift;
	my $fh = IO::File->new($file) or die $!;
	my $mm = File::MMagic->new();
	my $content = do { local $/; <$fh> };
	my $type = $mm->checktype_filehandle($fh);
	$fh->close;
	return 'data:' . $type . ';base64,' . encode_base64($content, '');
}
<li><a href="http://web.archive.org/web/20010410055247/http://www.fan.gr.jp/~kaz/rec-css2/cascade.html#specificity" title="値の割り当て、カスケード処理、継承">CSS2勧告邦訳</a>(岡橋訳)は、「詳細度」</li>
<li><a href="http://www.y-adagio.com/public/standards/tr_css2/cascade.html#specificity" title="Assigning property values, Cascading, and Inheritance">段階スタイルシート 水準2(CSS2)</a>(Y-ADAGIO訳)は「固有性」</li>
<li><a href="http://hp.vector.co.jp/authors/VA022006/css/cascade.html#calculating-specificity" title="値の割り當て,カスケード處理,繼承 - CSS2リファレンス"> 正しい知識を得たい人の爲のCSS2リファレンス</a>は、「詳細性」</li>
<li><a href="http://www.htmlhelp.com/ja/reference/css/structure.html#cascade" title="CSS Structure and Rules(jp)">WDGのGuide to Cascading Style Sheets日本語翻訳版</a>は「特殊性」</li>
<li><a href="http://www.lucky-bag.com/archives/2004/12/cssspecificity_1.html" title="Lucky bag::blog: CSSのspecificity">Lucky bag::blog: CSSのspecificity</a>は「特異性」</li>

/* idつきの要素を $id名$ という変数で参照できるようにする */
Object.extend(Element, {
	indexIdentifiedElements: function() {
		var elements = $A(document.getElementsByTagName('*'));
		elements.each( function(element) {
			var id = element.id;
			if (!id) return;
			if (!id.match(/^[A-Za-z_]{2,}$/)) return;
			window['$' + id + '$'] = element;
		} );
	}
});

utf8→数値文字参照

use strict;
use Encode qw(encode decode :fallbacks);

my $utf8 = '日本語文字列のtest';
my $internal = decode('utf8', $utf8);

# 十進数値文字参照
my $dref = encode('ascii', $internal, FB_HTMLCREF);
# 十六進数値文字参照
my $xref = encode('ascii', $internal, FB_XMLCREF);
# Perl文字列エスケープ
my $pqq = encode('ascii', $internal, FB_PERLQQ);

print $utf8, "\n";
print $dref, "\n";
print $xref, "\n";
print $pqq, "\n";

recent writebacks caceh プラグイン

# Blosxom Plugin: rwbc (recent writeback cache)
# Author: KITAMURA Akatsuki
# Version: 2006-04-04
# Blosxom Home/Docs/Licensing: http://www.blosxom.com/

# This script is encoded in UTF-8.

package rwbc;

use strict;
use CGI qw(:standard);
use File::Find;
use File::stat;
use FileHandle;
use Data::Dumper;

# --- Configurable Variables -----------

my $writeback_dir = "$blosxom::plugin_state_dir/writebacks";
my $rwbc_cache_file = "$blosxom::plugin_state_dir/rwbc_cache.txt";
my $wb_file_extension = 'wb';
my $entry_extension = 'html';
my $wb_page_extension = 'wb';
my $trackback_flavour = 'tb';
my $recent_wb_num = 5;
my $empty_recent_wb = '<dt>(no writeback)</dt>';

# --- Plug-in package variables --------

use vars qw( $recent_writebacks );
my @recent_wb;

# --------------------------------------


sub start {
	return 0 if ($blosxom::static_or_dynamic eq 'static');
	@recent_wb = ();
	$recent_writebacks = '';
	foreach my $line (<DATA>) {
		last if ($line =~ /^__END__$/);
		my ($flavour, $comp, $text) = split(/ /, $line, 3);
		$text =~ s/\\n/\n/g;
		$blosxom::template{$flavour}{$comp} = $text;
	}
	1;
}

sub head {
	if ( request_method() eq 'POST' && (param('plugin') eq 'writeback' || $blosxom::flavour eq $trackback_flavour) || !(-e $rwbc_cache_file) ) {
		&make_cache;
	}

	@recent_wb or @recent_wb = &parse_wb_file($rwbc_cache_file);
	unless (@recent_wb) {
		$recent_writebacks = $empty_recent_wb;
		return 1;
	}

	foreach my $wb (@recent_wb) {
		if ($wb->{comment}) {
			$wb->{url} = qq{$blosxom::url$wb->{entry_path}/$wb->{entry_fn}.$wb_page_extension#c$wb->{number}};
		}
		$wb->{entry_url} = qq{$blosxom::url$wb->{entry_path}/$wb->{entry_fn}.$entry_extension};
		my $tmpl = &$blosxom::template($blosxom::path_info, 'recent_writebacks', $blosxom::flavour);
		$tmpl =~ s/\$rwbc::(\w+)/$wb->{$1}/g;
		$recent_writebacks .= $tmpl;
	}
}

sub make_cache {
	warn "rwbc: make cache.\n";
	find(\&get_recent_wb, $writeback_dir);
	@recent_wb = sort {
		$b->{date} <=> $a->{date}
		|| $b->{number} <=> $a->{number}
	} @recent_wb;
	splice @recent_wb, $recent_wb_num;

	my $fh = FileHandle->new;
	unless ($fh->open(">$rwbc_cache_file")) {
		warn "rwbc: can't write cache file: $rwbc_cache_file.\n";
		return;
	}
	my $temp = '';
	foreach my $wb (@recent_wb) {
		foreach my $key (sort keys %$wb) {
			$temp .= "$key:$wb->{$key}\n";
		}
		$temp .= "-----\n";
	}
	print $fh $temp;
}

sub get_recent_wb {
	return if (!/\.$wb_file_extension$/);
	push @recent_wb, &parse_wb_file($File::Find::name);
}

sub parse_wb_file {
	my $wb_file = $_[0];

	my $fh = FileHandle->new;
	unless ($fh->open($wb_file)) {
		warn "rwbc: can't open writeback file: $wb_file.\n";
		return;
	}
	my ($wb_mtime, $entry_path, $entry_fn, $entry_title);
	if ($wb_file ne $rwbc_cache_file){
		$wb_mtime = stat($fh)->mtime;
		($entry_path, $entry_fn) = $wb_file =~ m{^$writeback_dir/(?:(.*)/)?(.*)\.$wb_file_extension};
		if ($entry_path) {
			$entry_path = "/$entry_path";
		} else {
			$entry_path = '';
		}
		$entry_title = &get_entry_title("$entry_path/$entry_fn");
	}

	my @wb;
	my $i = 0;
	foreach my $line (<$fh>) {
		$line =~ /^(.+?):(.*)$/ and $wb[$i]{$1} = $2;
		$line !~ /^-+$/ and next;

		$wb[$i]{date} ||= $wb_mtime;
		$wb[$i]{number} ||= $i + 1;
		$wb[$i]{entry_path} ||= $entry_path;
		$wb[$i]{entry_fn} ||= $entry_fn;
		$wb[$i]{entry_title} ||= $entry_title;

		$i++;
	}
	return @wb;
}

sub get_entry_title {
	my $file = $_[0];
	$file = "$blosxom::datadir$file";
	$file =~ s/(?:\.[^.]+)?$/.$blosxom::file_extension/;

	my $fh = FileHandle->new;
	unless ($fh->open($file)) {
		warn "rwbc: can't open entry file: $file.\n";
		return '(no title)';
	}
	my $entry_title = <$fh>;
	chomp $entry_title;
	$entry_title;
}

1;

__DATA__
wbrss content_type application/xml;charset=utf-8
wbrss head <?xml version="1.0"?>\n<!DOCTYPE rss PUBLIC "-//Netscape Communications//DTD RSS 0.91//EN" "http://my.netscape.com/publish/formats/rss-0.91.dtd">\n\n<rss version="0.91">\n  <channel>\n    <title>recent writebacks: $blog_title</title>\n    <link>$url/</link>\n    <description>recent comments and trackbacks of $blog_title.</description>\n    <language>$blog_language</language>\n\n$rwbc::recent_writebacks\n
wbrss story 
wbrss date 
wbrss foot   </channel>\n</rss>
wbrss recent_writebacks     <item>\n      <title>$rwbc::title</title>\n      <link>$rwbc::url</link>\n      <description>$rwbc::comment$rwbc::excerpt</description>\n    </item>\n
error recent_writebacks <dt><a href="$rwbc::entry_url">$rwbc::entry_title</a></dt>\n<dd><a href="$rwbc::url">$rwbc::title</a></dd>\n
__END__

武田薫のフジテレビ・スポーツコラム 2006年2月20日分 (Googleキャッシュより)

<p class=day-takeda>2006.2.20</p>
<p class=title-takeda>『考えて欲しいNHKのカーリング』</p>
<!--	<span class="style-takeda"></span>-->
<p class=main>2月19日、久々に青梅マラソンを見にいった。<br>
今年で40回目の記念大会は、梅の芽もほころぶ陽気で、ファン・ランナーには格好の日和となった。後で、事故者が出たと聞いた。一般愛好家を対象とした大会では事故が最大の心配である。参加者の体調に関する限り、運営側はどうにも手の施しようがない。にもかかわらず、ライバルのメディアは「ほら見たことか」とデカデカ取り上げる。青梅は報知新聞主催だから、かつて日刊スポーツの記者などはいかにも怪しげな目つきで佇んでいたものだ。<br>
懐かしい風景がいくつかあった、プレスルームにキャノンのサービスマンが出張していた。プレスルームといっても、ほとんどが報知新聞か地元紙の記者。そこにワールドカップなみに世界のキャノンが出張していたことにはワケがある。かつての新聞写真部はほとんどがニコンを使っていた。いまは大部分がオートフォーカスを開発したキャノンに切り替えたが、一貫してキャノンを使い続けてきたのが報知新聞一社だった。系列の読売新聞がニコンを使っているときも、報知写真部はキャノンだった。いまでは稀になったサービス出張の風景が残っているのは、そんな風雪の名残なのだ。報知の一貫性がどうして編集方針に反映されないんだろうね……和やかなプレスルームで、そんなことを考えていたのは私だけだろう。余計なことでした。<br>

同行したKカメラマンは、ちゃっかり掃除をしてもらっていた。<br>
日本の大衆マラソンは、いかにも日本的で面白い。焼きそば屋とかトウモロコシの屋台が並び、射的場まである。ランナーたちに気負いはなく、概して年齢は高く、オヤジの姿が目立つ。胸のゼッケンを読んでいく。『酒RUN会』のオジサンは目がしょぼしょぼだ。走る前にもっとやることがあるだろう。『遅かったの会』はいいネーミングではないか。その隣には『いまは幸せ会』……というのはウソでした。<br>
自分でふざけておいて言うのも何だが、<span class="style-takeda">日本のスポーツには「ふざける」という要素が欠かせないのではないか。</span>お隣り韓国の大衆マラソンは、ものすごいライバル意識で殺気立っていると聞いたが、それとはだいぶ違う。ヘラヘラしている。<span class="style-takeda">思うに、日本人は面と向かって肉体と対峙することが苦手なのではないだろうか。</span>そこからふと目を逸らしたいのではないか? いまや日本列島は吉本興業のタレントに席巻されているが、吉本新喜劇ほど肉体を小ばかにし、笑いものにし、大うけしているショーは世界にも他に例がない。かくいう私も、大阪に行ったら必ず見にいく。吉本興業はいまスポーツ代理業にも関っているが、その吉本が戦後の地盤を固めたのは進駐軍時代のキャバレーやクラブ経営からだった。日本人の肉体と進駐軍――青梅マラソンでこんなことを考えては『行けなかった会』?<br>
夜はトリノ・オリンピックを観た。トリノは、スノボーのクロスとかスケートのパシュートなど新種目が面白かった。スキーの滑降種目もスリリングで興奮するが、不満はNHKである。カーリングを延々と流している神経はどうしたのか。ジャパン・コンソーシアムはシドニーから5大会で総額632億円の放映権料をIOCに払い、その70%がNHKの負担だ。カーリングを見るために、そんな大金を払ったのか? メダルを見たいために放映しているのか? <span class="style-takeda">昔のNHK運動部はもう少し主張があった。公共放送、せめて報知新聞写真部のような一貫性があっても</span>……ま、そこまで持ち上げる意味はないか。<br>
日本の惨敗はともかく、NHKと松岡修造がなぁ……というオリンピックである。</p>