View | Details | Raw Unified | Return to bug 6429
Collapse All | Expand All

(-)a/docs/comp_about.pl (-1 / +119 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright 2011 Rijksmuseum
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
# This script prints the names of all new developers in history.txt, not found
21
# in about template (English version).
22
23
use strict;
24
use warnings;
25
26
use utf8;
27
use open  OUT=>':utf8', ":std";
28
use Encode;
29
30
use constant HISTORY => '../docs/history.txt';
31
use constant ABOUT_T => '../koha-tmpl/intranet-tmpl/prog/en/modules/about.tt';
32
33
my ($fh_about, $fh_history, $about_cont, $about_cont2, $lastnum);
34
35
#-------------------------------------------------------------------------------
36
37
init_vars();
38
show_new_committers();
39
exit_stuff();
40
41
#-------------------------------------------------------------------------------
42
43
sub init_vars {
44
  open $fh_about, '<:encoding(UTF-8)', ABOUT_T or die $!;
45
  open $fh_history, '<:encoding(UTF-8)', HISTORY or die $!;
46
47
  my @a=<$fh_about>;
48
  $about_cont= join '', @a;
49
  if ($about_cont=~/id=\"team\"(.*)id=\"licenses\"/s ) {
50
    $about_cont= $1;
51
  }
52
  else {
53
    print "WARNING: Check about template for div ids\n";
54
  }
55
  $about_cont2= $about_cont;
56
  $about_cont2=~ tr/áéíóúàèìòùäëïöü/aeiouaeiouaeiou/; #remove some diacritics
57
}
58
59
sub show_new_committers {
60
  my @lines= <$fh_history>;
61
62
  foreach(@lines) {
63
    if(/becomes?.*(developer|committer)/) {
64
      my $dev=extract_name($_);
65
      check_developer($dev) if $dev;
66
    }
67
  }
68
}
69
70
sub extract_name {
71
  #get name from line
72
  #format looks like date name becomes ..
73
  my $line=shift;
74
  if($line=~/^\w+\s+\d+\s+\d{4}\s+(.*)become\D+(\d+)/) {
75
    my $found=$1; my $num=$2;
76
    print "MISSING NUMBER: ".($lastnum+1)."\n" if $lastnum && $num>$lastnum+1 && $lastnum>5; #first five not all mentioned?
77
    $lastnum=$num;
78
79
    #strip some garbage
80
    $found=~s/\(.*\)//g;
81
    $found=~s/narrowly beats Jane to//;
82
    $found=~s/Katipo.s new developer//;
83
    $found=~s/^\s+//;
84
    $found=~s/\s+$//;
85
    #print "$num $found\n";
86
87
    return "$found";
88
  }
89
  print 'NO MATCH:'.$line;
90
}
91
92
sub check_developer {
93
  my $dev= shift;
94
  my $test;
95
96
  #skip some names
97
  return if $dev=~/Polytechnic University|NCE|Koha production|Andy\?\?|doXulting|Gavin \?\?|Nicole Engard/; #tt lists Nicole C. Engard
98
99
  return if index(lc $about_cont,lc $dev) >=0; #lowercase
100
101
  #test removing some diacritics?
102
  $test= $dev;
103
  $test=~ tr/áéíóúàèìòùäëïöü/aeiouaeiouaeiou/;
104
  #return if index(lc $about_cont,lc $test) >=0;
105
  return if index(lc $about_cont2, lc $test) >=0;
106
107
  #remove middle initials
108
  #$test=$dev;
109
  #$test=~s/(?<=\s)[A-Z]\.\s//;
110
  #return if index(lc $about_cont,lc $test) >=0;
111
112
  print "MISSING DEV: $dev\n";
113
}
114
115
sub exit_stuff {
116
  close $fh_about;
117
  close $fh_history;
118
}
119

Return to bug 6429