chalow - ~matubara/ChangeLog →移動しました

■ ChangeLog parser with Parse/RecDescent [perl][chalow]

<http://blogger.main.jp/changelog/2004-07-28-2.html>
改造した。

いわゆる一つの再帰下降型構文解析。
ループと分岐と関数呼び出しで書く例のやつです。
[src]
#! perl -w
# Parse ChangeLog
# Copyright: (C) Project PaoPei with zuihu 2004 JAPAN
# $Id: remoteclog.txt,v 1.2 2004/12/06 08:58:45 zuihu Exp $

# modified 2006-11-27, for chalow, cf. http://kerolin.jspeed.jp/2006/10/03/

package ParseChangeLog;
use strict;
use Parse::RecDescent;
use Data::Dumper;
$Parse::RecDescent::skip = '[\r\f\n]*';

    my $grammar = q(
        parse: entry(s)
        {[{entry => $item[1]}]}

        entry: entryheader item(s)
         

        entryheader: /^(\d{4}-\d{2}-\d{2})\s+(.+) \s+\<(.+)\>/
        {@{$return}{qw(date user mail)} = ($1,$2,$3)}

        item: itemheader itembody(s)
        {
            my $body = join ("\n", @{$item[2]});
@{$return}{qw(title tag body)} = ($item[1]->[0], $item[1]->[1], $body)
        }

        itemheader: /^\t\* ([^\[]*)(\[.*\]):/
        {[$1,$2]}

        itembody: /^(?!(\t\* .+?:|\d{4}-\d\d\-\d\d))(.*)/
        {($2)}
    );


my $text;
{
  local $/ = undef;
  $text = <STDIN>;
}
my $log = Parse::RecDescent->new($grammar)->parse($text);
print Dumper($log);
[src]

■ カエルチュウイホウ - PlaggerでChangeLogを扱う(2) [perl][chalow][net]

<http://kerolin.jspeed.jp/Computer/Linux/Meadowger060611.html>

package Plagger::Plugin::CustomFeed::ChangeLog;
use strict;
use warnings;
use base qw( Plagger::Plugin );
use Parse::RecDescent;
use Text::Markdown 'markdown';

$Parse::RecDescent::skip = '[ \r\f\n]*'; 

sub register {
    my($self, $context) = @_;
    $context->register_hook(
        $self,
        'subscription.load' => \&load,
    );
}

sub load {
    my($self, $context) = @_;

    my $feed = Plagger::Feed->new;
    $feed->aggregator(sub { $self->aggregate(@_) });
    $context->subscription->add($feed);
}

sub aggregate {
    my($self, $context, $args) = @_;

    my $file = $self->conf->{changelog_file};

    $context->log(info => "Load $file");

    open my $fh, $file
        or return $context->log(error => "$file: $!");

    my $text;    
    {
	local $/ = undef;
	$text = <$fh>;
    }

    my $feed = Plagger::Feed->new;
    $feed->title("ChangeLog");
    $feed->type('ChangeLog');

    my $grammar = q(
        parse: entry(s)
        {@{$return}{entry} = @item[1]}

	 entry: entryheader item(s)
	 {@{$return}{qw(header item)} = @item[1..2]}

        entryheader: /^(\d{4}-\d{2}-\d{2})\s+(.+) \s+\<(.+)\>/
        {@{$return}{qw(date user mail)} = ($1,$2,$3)}

        item: itemheader itembody(s)
        {
            my $body = join ("\n", @{$item[2]});
	    @{$return}{qw(tag title body)} = ($item[1]->[0], $item[1]->[1], $body)
        }

        itemheader: /^\t\* (.*):\s+(.+)/
        {[$1,$2]}

        itembody: /^\t(?!\*)(.*)/
        {($1)}
    );

    my $data = Parse::RecDescent->new($grammar)->parse($text);

    for my $datelog (@{$data->{entry}}){
	for my $item (@{$datelog->{item}}){
	    my $entry = Plagger::Entry->new;
	    $entry->title($item->{title});
	    $entry->author($datelog->{user});
	    $entry->date($datelog->{date});
            my $htmlized_body = markdown($item->{body});
	    $entry->body($htmlized_body);
	    $feed->add_entry($entry);
	}
    }

    $context->update->add($feed);
}

1;
__END__

■ ChangeLog Merger [perl][chalow]

sort + uniq 機能つき。

#! /usr/bin/env perl
use warnings;
use strict;

my @articles = (); # [id(date+author), begin, end]
my @lines = <>;

# collect ids and begins
for my $i (0 .. $#lines) {
    if ( $lines[$i] =~ m/^(\d\d\d\d-\d\d-\d\d\s+.*)$/ ) {
        push @articles, [$1, $i, ];
    }
}

# collect ends
for my $i (0 .. $#articles-1) {
    $articles[$i][2] = $articles[$i+1][1]-1;
}
$articles[$#articles][2] = $#lines;

# collect lines
@articles = map [$_->[0], join('', @lines[ $_->[1]+1 .. $_->[2] ])], @articles;


# uniq
{
    my %h;
    foreach ( @articles ) {
        my $k = $_->[0];
        if ( exists $h{$k} ) {
            $h{$k}->[1] .= $_->[1];
        } else {
            $h{$k} = $_;
        }
    }
    @articles = values %h;
}

print
    map "$_->[0]\n$_->[1]",
    sort { - ($a->[0] cmp $b->[0]) } @articles;

■ ${FIREFOX_PROFILE}/user.js [chalow]

Copy URL+ という Firefox 拡張で、ChangeLog形式にコピーするためのスクリプト片。

user_pref('copyurlplus.menus.1.label', 'Title [net]: <URL> >>Sel<<');
user_pref('copyurlplus.menus.1.copy', "%TITLE% [net]:\n	<%URL%>\n	>>%SEL%\n	<<");
user_pref('copyurlplus.menus.2.label', '[[Title|URL]]');
user_pref('copyurlplus.menus.2.copy', "[[%TITLE%|%URL%]]");

■ How to Use Notepad to Create a Log File [win][chalow][net]

<http://support.microsoft.com/?kbid=260563>

2. Type .LOG on the first line, and then press ENTER to move to the next line.

■ bin/privatize_changelog [chalow][perl]

ChangeLog の特定カテゴリのエントリに"p:"の印を付けるプログラム。

#! /usr/bin/perl
use strict;
use warnings;
use Getopt::Long;

my @priv_categories;
GetOptions('private=s@' => \@priv_categories);

print STDERR "privatizing ", map("[$_]",@priv_categories), " ...\n";

my %priv_table;
@priv_table{@priv_categories} = map 1, (1 .. scalar @priv_categories);

foreach my $line (<>) {
  my $priv = 0;

  if ( $line =~ m/^\s*\*\s*([^\[]+)(.*)\s*:\s*$/ ) { # match to a title line
    my($title, $cat) = ($1, $2);
    my @categories = ($cat =~ m/\[(.*?)\]/g);
    foreach (@categories ) {
      $priv = 1, last  if $priv_table{$_};
    }
    if ( $priv ) {
      print "\t* p:$title ".
      join('',map "[$_]", @categories).
        ":\n";
      next;
    }
  }

  print $line;
}

■ 佐藤 克己 Yoshiki SATO [java][vis][chalow][people][net]

<http://apollo.u-gakugei.ac.jp/~yoshiki/>
chalow で日記をつけている情報視覚化（可視化）の専門家。
視覚化 / Y's memo
Java / Y's memo
Ajax / Y's memo
などがみどころ。

内容は同じだが、xight.orgの方が見やすいかも。

■ changelog2mediawiki [linux][chalow][perl]

ChangeLog での日誌がたまったし、Wikiへ転載できるように、変換スクリプトを書いた。
ChangeLogにはキーワードを付けてあるので、それを指定して抜き出す。

Wikiで日誌を付けるのは少々面倒なので、今後はChangeLogメインになるが、移行期間ということで。

#! /usr/bin/perl -w
use strict;

my @keys = qw|segmentation|;
my %keywords;
@keywords{ @keys } = map 1, @keys;
my $regexp_section_head = '^([\d-]+)';
my $output_section_head = sub { "== $_[0] ==" };
my $regexp_subsect_head = '^\t\*(.+):';
my $output_subsect_head = sub { "=== $_[0] ===" };
my $regexp_keyword = '('. join('|',@keys) .')';
my $regexp_begin_src = '\[src\]';
my $regexp_end_src = '\[/src\]';

my $showing = 0;
my $insrc = 0;
while ( $_ = <> ) {
  if ( m/$regexp_section_head/ ) {
    print $output_subsect_head->($1)."\n";
    $showing = 0;
  } elsif ( m/$regexp_subsect_head/ ) {
    my $subsect = $1;
    if ( $subsect =~ m/$regexp_keyword/ ) {
      print $output_subsect_head->($subsect)."\n";
      $showing = 1;
    } else {
      $showing = 0;
    }
  } elsif ( m/^(.+)$/) {
    my $text = $1;
    if ( $insrc ) {
      if ( $text =~ m/$regexp_end_src/ ) {
        $text = "$`\n$'";
        $insrc = 0;
      }
      print " $text\n";
    } elsif ($text =~ m/$regexp_begin_src/) {
      $insrc = 1;
    } elsif ( $showing ) {
      $text =~ s/^\s+-/\*/;
      print "$text\n";
    }
  }
}