Changeset 9910

Show
Ignore:
Timestamp:
04/19/08 22:12:20 (7 years ago)
Author:
yappo
Message:

lang/perl/Data-CodeRepos?-CommitPing?: できた

Location:
lang/perl/Data-CodeRepos-CommitPing/trunk
Files:
2 added
3 modified

Legend:

Unmodified
Added
Removed
  • lang/perl/Data-CodeRepos-CommitPing/trunk/Changes

    r9707 r9910  
    11Revision history for Perl extension Data::CodeRepos::CommitPing 
    22 
    3 0.01    Fri Apr 18 19:44:22 2008 
     30.01    2008-04-19T22:10:31+09:00 
    44        - original version 
  • lang/perl/Data-CodeRepos-CommitPing/trunk/MANIFEST

    r9901 r9910  
    2525t/01_parse_cgi.t 
    2626t/01_parse_hash.t 
     27t/02_extract_changes_base.t 
    2728t/revs/9734.txt 
    2829t/revs/9741.txt 
     
    3132t/revs/9879.txt 
    3233t/revs/9895.txt 
     34t/revs/9906.txt 
  • lang/perl/Data-CodeRepos-CommitPing/trunk/lib/Data/CodeRepos/CommitPing.pm

    r9901 r9910  
    2929    $stuff->{date} = DateTime::Format::HTTP->parse_datetime($stuff->{date}); 
    3030 
     31    for (@{ $stuff->{files} }) { 
     32        $_->{path_list} = [ split '/', $_->{path} ]; 
     33    } 
     34 
    3135    bless { %$stuff }, $class; 
    3236} 
     
    3438sub revision { shift->{rev} } 
    3539*rev = \&revision; 
     40sub comment { shift->{comment} } 
     41sub date { shift->{date} } 
     42sub author { shift->{author} } 
     43sub files { shift->{files} } 
     44 
     45sub changes_base { 
     46    my $self = shift; 
     47 
     48    my $changes_projs = {}; 
     49    for my $file (@{ $self->{files} }) { 
     50        my $proj = 'proj_' . $file->{path_list}->[0]; 
     51        my $path = $self->$proj($file); 
     52        $changes_projs->{$path}++; 
     53    } 
     54 
     55    for my $top ($self->toplevel_updates) { 
     56        next unless $top->{status} eq '_U'; 
     57        my $path = join '/', @{ $top->{path_list} }; 
     58        delete $changes_projs->{$path}; 
     59    } 
     60 
     61    my @ret; 
     62    for my $path ( sort { $changes_projs->{$b} <=> $changes_projs->{$a} } keys %{ $changes_projs } ) { 
     63        push @ret, $path; 
     64    } 
     65    return unless @ret; 
     66    return @ret > 1 ? [ @ret ] : $ret[0]; 
     67} 
     68 
     69sub toplevel_updates { 
     70    my $self = shift; 
     71 
     72    my @ret; 
     73    for my $file (@{ $self->{files} }) { 
     74        next if @{ $file->{path_list} } > 2; 
     75        push @ret, $file; 
     76    } 
     77    @ret; 
     78} 
     79 
     80 
     81# projects 
     82# book  config  corp  dan  docs  dotfiles  lang  platform  poem  websites 
     83our %PROJECT_BASE; 
     84for my $proj (qw/ lang platform docs dan corp /) { 
     85    $PROJECT_BASE{$proj} = 3; 
     86} 
     87for my $proj (qw/ config websites dotfiles poem book  /) { 
     88    $PROJECT_BASE{$proj} = 2; 
     89} 
     90 
     91for my $proj (keys %PROJECT_BASE) { 
     92    no strict 'refs'; 
     93    *{"proj_$proj"} = sub { 
     94        use strict; 
     95        my($self, $file) = @_; 
     96        my @list = @{ $file->{path_list} }; 
     97        my $max = $PROJECT_BASE{$proj}; 
     98        $max = @list < $max ? scalar(@list) : $max; 
     99        $max--; 
     100        join '/', @list[0..$max]; 
     101    } 
     102} 
     103 
    36104 
    371051; 
     
    42110=head1 NAME 
    43111 
    44 Data::CodeRepos::CommitPing - 
     112Data::CodeRepos::CommitPing - CodeRepos commit ping data handler 
    45113 
    46114=head1 SYNOPSIS 
     
    48116  use Data::CodeRepos::CommitPing; 
    49117 
     118  # from CGI data 
     119  my $data = Data::CodeRepos::CommitPing->new(CGI->new); 
     120 
     121  # from yaml data 
     122  my $data = Data::CodeRepos::CommitPing->new(CGI->new->param('yaml')); 
     123 
     124  # from HASH ref 
     125  my $data = Data::CodeRepos::CommitPing->new({ 
     126      author  => 'yappo', 
     127      comment => 'commit log', 
     128      date    => '2008-02-08 14:59:11 +0900', 
     129      files   => [ 
     130          { 
     131              path   => 'websites/coderepos.org/scripts/commit-ping-hook.pl', 
     132              status => 'U', 
     133          }, 
     134      ], 
     135      rev     => '6373', 
     136  }); 
     137 
     138  print $data->revision; # 6373 
     139  print $data->comment; # commit log 
     140  print $data->author; # yappo 
     141  print $data->date; # DateTime object 
     142  print $data->files; # file list array ref 
     143 
     144  print $data->changes_base; # websites/coderepos.org 
     145 
     146 
    50147=head1 DESCRIPTION 
    51148 
    52 Data::CodeRepos::CommitPing is 
     149Data::CodeRepos::CommitPing is CodeRepos commit log parser and handler. 
    53150 
    54151=head1 AUTHOR 
     
    57154 
    58155=head1 SEE ALSO 
     156 
     157L<http://coderepos.org/share/> 
     158L<http://coderepos.org/share/wiki/commit-ping/SITEINFO> 
    59159 
    60160=head1 REPOSITORY