Commit 9da4473e authored by sikeda's avatar sikeda
Browse files

[*change] Reformatting Perl sources using perltidy,

except: src/lib/Challenge.pm, src/lib/WebAgent.pm and files under ext/.
Additionally reparing long comment lines.

Used configuration for perltidy (.perltidyrc) is approximately:
------------ >8 ------------ >8 ------------ >8 ------------
# Differences from PBP are marked *.
-bar   # Opening brace always on right (* no)
-bbt=1 # Medium block brace tightness
-bt=2  # Strong brace tightness (* 1)
-ce    # Cuddled else (* no)
-cti=0 # No extra indentation for closing brackets
-i=4   # Indent level is 4 cols
-ci=4  # Continuation indent is 4 cols
-l=78  # Max line witdh is 78 cols
-nolc  # Don't outdent long comments (* -olc)
-nolq  # Don't outdent long quoted strings
-nsbl  # No opening sub brace on new line (* -sbl)
-nsfs  # No space before semicolons
-pt=2  # Strong parenthesis tightness (* 1)
-sbcp='#' # Don't format non-static block comments automatically (* '##')
-sbt=2 # Strong square bracket tightness (* 1)
-se    # Errors to STDERR
#-st   # Output to STDOUT
-vt=2  # Maximal vertical tightness
-wba="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x="
# Break after all operators
------------ 8< ------------ 8< ------------ 8< ------------


git-svn-id: https://subversion.renater.fr/sympa/branches/sympa-6.2-branch@10721 05aa8bb8-cd2b-0410-b1d7-8918dfa770ce
parent a6639eca
# important_changes.pl - This script prints important changes in Sympa since last install
# important_changes.pl - This script prints important changes in Sympa since
# last install
# It is based on the NEWS ***** entries
# RCS Identication ; $Revision$ ; $Date$
#
......@@ -29,11 +30,7 @@ use strict;
use Getopt::Long;
my %options;
GetOptions(
\%options,
'current=s',
'previous=s',
);
GetOptions(\%options, 'current=s', 'previous=s',);
die "no current given version, aborting" unless $options{current};
......@@ -43,11 +40,11 @@ if (!$options{previous}) {
}
my $previous_version = $options{previous};
my $current_version = $options{current};
my $current_version = $options{current};
# exit immediatly if previous version is higher or equal
if (($previous_version eq $current_version) ||
&higher($previous_version,$current_version)){
if (($previous_version eq $current_version)
|| &higher($previous_version, $current_version)) {
exit 0;
}
......@@ -65,26 +62,25 @@ open NOTES, 'NEWS';
my ($current, $ok);
while (<NOTES>) {
if (/^([\w_.]+)\s/) {
my $v = $1;
if ($v eq $previous_version ||
&higher($previous_version,$v)
) {
last;
}else{
$ok = 1;
}
my $v = $1;
if ( $v eq $previous_version
|| &higher($previous_version, $v)) {
last;
} else {
$ok = 1;
}
}
next unless $ok;
if (/^\*{4}/) {
print "\n" unless $current;
$current = 1;
print;
}else {
$current = 0;
print "\n" unless $current;
$current = 1;
print;
} else {
$current = 0;
}
}
close NOTES;
print "<RETURN>";
......@@ -93,24 +89,23 @@ my $wait = <STDIN>;
sub higher {
my ($v1, $v2) = @_;
my @tab1 = split /\./,$v1;
my @tab2 = split /\./,$v2;
my @tab1 = split /\./, $v1;
my @tab2 = split /\./, $v2;
my $max = $#tab1;
$max = $#tab2 if ($#tab2 > $#tab1);
for my $i (0..$max) {
for my $i (0 .. $max) {
if ($tab1[0] =~ /^(\d*)a$/) {
$tab1[0] = $1 - 0.5;
}elsif ($tab1[0] =~ /^(\d*)b$/) {
} elsif ($tab1[0] =~ /^(\d*)b$/) {
$tab1[0] = $1 - 0.25;
}
if ($tab2[0] =~ /^(\d*)a$/) {
$tab2[0] = $1 - 0.5;
}elsif ($tab2[0] =~ /^(\d*)b$/) {
} elsif ($tab2[0] =~ /^(\d*)b$/) {
$tab2[0] = $1 - 0.25;
}
......
......@@ -39,4 +39,3 @@ print $_;
while (<>) {
print $_;
}
# check_locales.pl - This script checks available locales on the system
# Sympa uses locales to build the user interface ; if none is available,
# Sympa will speak English only
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# RCS Identication ; $Revision$ ; $Date$
#
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
......@@ -26,48 +24,60 @@
use POSIX qw (setlocale);
my @locales = split /\s+/,$ENV{'SYMPA_LOCALES'};
my @locales = split /\s+/, $ENV{'SYMPA_LOCALES'};
my (@supported, @not_supported);
foreach my $loc (@locales) {
my $locale_dashless = $loc.'.utf-8'; $locale_dashless =~ s/-//g;
my $locale_dashless = $loc . '.utf-8';
$locale_dashless =~ s/-//g;
my $lang = substr($loc, 0, 2);
my $success;
foreach my $try ($loc.'.utf-8',
$loc.'.UTF-8', ## UpperCase required for FreeBSD
$locale_dashless, ## Required on HPUX
$loc,
$lang) {
if (setlocale(&POSIX::LC_ALL, $try)) {
push @supported, $loc;
$success = 1;
last;
}
foreach my $try (
$loc . '.utf-8',
$loc . '.UTF-8', ## UpperCase required for FreeBSD
$locale_dashless, ## Required on HPUX
$loc,
$lang
) {
if (setlocale(&POSIX::LC_ALL, $try)) {
push @supported, $loc;
$success = 1;
last;
}
}
push @not_supported, $loc unless ($success);
}
if ($#supported == -1) {
printf "#########################################################################################################\n";
printf "## IMPORTANT : Sympa is not able to use locales because they are not properly configured on this server\n";
printf
"#########################################################################################################\n";
printf
"## IMPORTANT : Sympa is not able to use locales because they are not properly configured on this server\n";
printf "## You should activate some of the following locales :\n";
printf "## %s\n", join(' ', @locales);
printf "## On Debian you should run the following command : dpkg-reconfigure locales\n";
printf "## On others systems, check /etc/locale.gen or /etc/sysconfig/i18n files\n";
printf "#########################################################################################################\n";
printf
"## On Debian you should run the following command : dpkg-reconfigure locales\n";
printf
"## On others systems, check /etc/locale.gen or /etc/sysconfig/i18n files\n";
printf
"#########################################################################################################\n";
my $s = $<;
}elsif ($#not_supported > -1){
printf "#############################################################################################################\n";
printf "## IMPORTANT : Sympa is not able to use all supported locales because they are not properly configured on this server\n";
} elsif ($#not_supported > -1) {
printf
"#############################################################################################################\n";
printf
"## IMPORTANT : Sympa is not able to use all supported locales because they are not properly configured on this server\n";
printf "## Herer is a list of NOT supported locales :\n";
printf "## %s\n", join(' ', @not_supported);
printf "## On Debian you should run the following command : dpkg-reconfigure locales\n";
printf "## On others systems, check /etc/locale.gen or /etc/sysconfig/i18n files\n";
printf "#############################################################################################################\n";
printf
"## On Debian you should run the following command : dpkg-reconfigure locales\n";
printf
"## On others systems, check /etc/locale.gen or /etc/sysconfig/i18n files\n";
printf
"#############################################################################################################\n";
my $s = $<;
}
This diff is collapsed.
......@@ -41,7 +41,6 @@ sub file_types {
return qw( * );
}
sub extract {
my $self = shift;
local $_ = shift;
......
......@@ -33,24 +33,24 @@ use Sympa::Constants;
use List;
use SDM;
my %month_idx = qw(jan 1
fev 2
feb 2
fv 2
mar 3
avr 4
apr 4
mai 5
may 5
jun 6
jul 7
aug 8
aou 8
sep 9
oct 10
nov 11
dec 12
dc 12);
my %month_idx = qw(jan 1
fev 2
feb 2
fv 2
mar 3
avr 4
apr 4
mai 5
may 5
jun 6
jul 7
aug 8
aou 8
sep 9
oct 10
nov 11
dec 12
dc 12);
my $msg_count = 0;
......@@ -65,9 +65,11 @@ unless (GetOptions(\%opt, 'input-directory=s')) {
die("Unknown options.");
}
die "Usage : $ARGV[-1] [-input-directory=<directory containing individual messages>] <listname> [robot]" unless ($#ARGV >= 0);
die
"Usage : $ARGV[-1] [-input-directory=<directory containing individual messages>] <listname> [robot]"
unless ($#ARGV >= 0);
my $listname = $ARGV[0];
my $robot = $ARGV[1];
my $robot = $ARGV[1];
## Check UID
unless ([getpwuid $<]->[0] eq Sympa::Constants::USER) {
......@@ -87,16 +89,17 @@ SDM::probe_db();
chdir $Conf::Conf{'home'};
my $list = List->new($listname, $robot)
my $list = List->new($listname, $robot)
or die 'Cannot create List object';
my $home_sympa;
if ($robot) {
$home_sympa = $Conf::Conf{'home'}.'/'.$robot;
}else {
$home_sympa = $Conf::Conf{'home'} . '/' . $robot;
} else {
$home_sympa = $Conf::Conf{'home'};
}
my $dest_dir = Conf::get_robot_conf($robot, 'arc_path').'/'.$list->get_list_id();
my $dest_dir =
Conf::get_robot_conf($robot, 'arc_path') . '/' . $list->get_list_id();
unless (-d "$home_sympa/$listname") {
die "No directory for list $listname";
......@@ -110,75 +113,74 @@ if (-d $dest_dir) {
print "Web archives already exist for list $listname\nGo on (<CR>|n) ?";
my $s = <STDIN>;
die if ($s eq 'n');
}else {
} else {
mkdir $dest_dir, 0755 or die;
}
if ($opt{'input-directory'}) {
unless (-d $opt{'input-directory'}) {
die "Parameter input-directory (%s) is not a directory", $opt{'input-directory'};
die "Parameter input-directory (%s) is not a directory",
$opt{'input-directory'};
}
opendir DIR, $opt{'input-directory'} || die;
foreach my $file ( sort grep (!/^\.\.?$/,readdir(DIR))) {
my @msgs; #FIXME: Not used anymore.
open ARCFILE, $opt{'input-directory'}.'/'.$file;
my @msg = <ARCFILE>;
push @msgs, \@msg;
$msg_count++;
close ARCFILE;
foreach my $file (sort grep (!/^\.\.?$/, readdir(DIR))) {
my @msgs; #FIXME: Not used anymore.
open ARCFILE, $opt{'input-directory'} . '/' . $file;
my @msg = <ARCFILE>;
push @msgs, \@msg;
$msg_count++;
close ARCFILE;
}
closedir DIR;
}else {
} else {
print STDERR "Bursting archives\n";
foreach my $arc_file (<$home_sympa/$listname/archives/log*>) {
my ($first, $new);
my $msg = [];
my @msgs;
## Split the archives file
print '.';
open ARCFILE, $arc_file;
while (<ARCFILE>) {
if (/^------- THIS IS A RFC934 (COMPILANT|COMPLIANT) DIGEST/) {
$first = 1;
$new = 1;
next;
}elsif (! $first) {
next;
}elsif (/^$/ && $new) {
next;
}elsif (/^------- CUT --- CUT/) {
push @msgs, $msg;
$msg_count++;
$msg = [];
$new = 1;
}else {
push @{$msg}, $_;
undef $new;
}
}
close ARCFILE;
##Dump
#foreach my $i (0..$#msgs) {
# printf "******** Message %d *******\n", $i;
# print @{$msgs[$i]};
#}
## Store messages in web arc
store_messages(\@msgs, $dest_dir);
my ($first, $new);
my $msg = [];
my @msgs;
## Split the archives file
print '.';
open ARCFILE, $arc_file;
while (<ARCFILE>) {
if (/^------- THIS IS A RFC934 (COMPILANT|COMPLIANT) DIGEST/) {
$first = 1;
$new = 1;
next;
} elsif (!$first) {
next;
} elsif (/^$/ && $new) {
next;
} elsif (/^------- CUT --- CUT/) {
push @msgs, $msg;
$msg_count++;
$msg = [];
$new = 1;
} else {
push @{$msg}, $_;
undef $new;
}
}
close ARCFILE;
##Dump
#foreach my $i (0..$#msgs) {
# printf "******** Message %d *******\n", $i;
# print @{$msgs[$i]};
#}
## Store messages in web arc
store_messages(\@msgs, $dest_dir);
}
}
print STDERR "\nFound $msg_count messages\n";
## Rebuild web archives
print STDERR "Rebuilding HTML\n";
my $list_id = $list->get_list_id();
......@@ -187,7 +189,6 @@ my $list_id = $list->get_list_id();
print STDERR "\nHave a look in $dest_dir/-/ directory for messages dateless
Now, you should add a web_archive parameter in the config file to make it accessible from the web\n";
## Analyze message header fields and store them in web archives
sub store_messages {
my ($list_of_msg, $dest_dir) = @_;
......@@ -198,98 +199,102 @@ sub store_messages {
## Analyzing Date header fields
#print STDERR "Analysing Date: header fields\n";
foreach my $msg (@msgs) {
my $incorrect = 0;
my ($date, $year, $month);
print '.';
foreach (@{$msg}) {
if (/^Date:\s+(.*)$/) {
#print STDERR "#$_#\n";
$date = $1;
# Date type : Mon, 8 Dec 97 13:33:47 +0100
if ($date =~ /^\w{2,3},\s+\d{1,2}\s+([\w\x80-\xFF]{2,3})\s+(\d{2,4})/) {
$month = $1;
$year =$2;
#print STDERR "$month/$year\n";
# Date type : 8 Dec 97 13:33:47+0100
}elsif ($date =~ /^\d{1,2}\s+(\w{3}) (\d{2,4})/) {
$month = $1;
$year =$2;
# Date type : 8-DEC-1997 13:33:47 +0100
}elsif ($date =~ /^\d{1,2}-(\w{3})-(\d{4})/) {
$month = $1;
$year =$2;
# Date type : Mon Dec 8 13:33:47 1997
}elsif ($date =~ /^\w+\s+(\w+)\s+\d{1,2} \d+:\d+:\d+ (GMT )?(\d{4})/) {
$month = $1;
$year =$3;
# unknown date format
}else {
$incorrect = 1;
last;
}
# Month format
if ($month !~ /^\d+$/) {
$month =~ y/\xe9\xfb/eu/; #FIXME
$month =~ y/A-Z/a-z/;
if (!$month_idx{$month}) {
$incorrect = 1;
}else {
$month = $month_idx{$month};
}
}elsif (($month < 1) or ($month > 12)) {
$incorrect = 1;
}
$month = "0".$month if $month =~ /^\d$/;
# Checking Year format
if ($year =~ /^[89]\d$/) {
$year = "19".$year;
}elsif ($year !~ /^19[89]\d|20[0-9][0-9]$/) {
$incorrect = 1;
}
last;
}
# empty line => end of header
if (/^\s*$/) {
last;
}
}
# Unknown date format/No date
if ($incorrect || ! $month || ! $year) {
$year = 'UN';
$month = 'KNOWN';
}
# New month
if (!-d "$dest_dir/$year-$month") {
print "\nNew directory $year-$month\n";
`mkdir $dest_dir/$year-$month`;
}
if (!-d "$dest_dir/$year-$month/arctxt") {
`mkdir $dest_dir/$year-$month/arctxt`;
}
$nummsg{$year}{$month}++ while (-e "$dest_dir/$year-$month/arctxt/$nummsg{$year}{$month}");
# Save message
open DESTFILE, ">$dest_dir/$year-$month/arctxt/$nummsg{$year}{$month}";
print DESTFILE @{$msg};
close DESTFILE;
# `mv $m $dest_dir/$year-$month/arctxt/$nummsg{$year}{$month}`;
$nummsg{$year}{$month}++;
my $incorrect = 0;
my ($date, $year, $month);
print '.';
foreach (@{$msg}) {
if (/^Date:\s+(.*)$/) {
#print STDERR "#$_#\n";
$date = $1;
# Date type : Mon, 8 Dec 97 13:33:47 +0100
if ($date =~
/^\w{2,3},\s+\d{1,2}\s+([\w\x80-\xFF]{2,3})\s+(\d{2,4})/)
{
$month = $1;
$year = $2;
#print STDERR "$month/$year\n";
# Date type : 8 Dec 97 13:33:47+0100
} elsif ($date =~ /^\d{1,2}\s+(\w{3}) (\d{2,4})/) {
$month = $1;
$year = $2;
# Date type : 8-DEC-1997 13:33:47 +0100
} elsif ($date =~ /^\d{1,2}-(\w{3})-(\d{4})/) {
$month = $1;
$year = $2;
# Date type : Mon Dec 8 13:33:47 1997
} elsif ($date =~
/^\w+\s+(\w+)\s+\d{1,2} \d+:\d+:\d+ (GMT )?(\d{4})/) {
$month = $1;
$year = $3;
# unknown date format
} else {
$incorrect = 1;
last;
}
# Month format
if ($month !~ /^\d+$/) {
$month =~ y/\xe9\xfb/eu/; #FIXME
$month =~ y/A-Z/a-z/;
if (!$month_idx{$month}) {
$incorrect = 1;
} else {
$month = $month_idx{$month};
}
} elsif (($month < 1) or ($month > 12)) {
$incorrect = 1;
}
$month = "0" . $month if $month =~ /^\d$/;
# Checking Year format
if ($year =~ /^[89]\d$/) {
$year = "19" . $year;
} elsif ($year !~ /^19[89]\d|20[0-9][0-9]$/) {
$incorrect = 1;
}
last;
}
# empty line => end of header
if (/^\s*$/) {
last;
}
}
# Unknown date format/No date
if ($incorrect || !$month || !$year) {
$year = 'UN';
$month = 'KNOWN';
}
# New month
if (!-d "$dest_dir/$year-$month") {
print "\nNew directory $year-$month\n";
`mkdir $dest_dir/$year-$month`;
}
if (!-d "$dest_dir/$year-$month/arctxt") {
`mkdir $dest_dir/$year-$month/arctxt`;
}
$nummsg{$year}{$month}++
while (-e "$dest_dir/$year-$month/arctxt/$nummsg{$year}{$month}");