oEdtk
view release on metacpan or search on metacpan
lib/oEdtk/Main.pm view on Meta::CPAN
package oEdtk::Main;
use strict;
use warnings;
use Exporter;
our $VERSION =1.8122; # release number : Y.YMMS -> Year, Month, Sequence
our @ISA = qw(Exporter);
our @EXPORT = qw(
c7Flux
date2time
fmt_address
fmt_address_sender
fmt_monetary
prodEdtk_Current_Rec
prodEdtk_Previous_Rec
prodEtk_rec_cdata_join
recEdtk_erase
recEdtk_join_tmplte
recEdtk_post_process
recEdtk_redefine
toC7date
oe_app_usage
oe_CAP_sans_accents
oe_cdata_table_build
oe_char_xlate
oe_clean_addr_line
oe_close_fo
oe_compo_link
oe_compo_set_value
oe_corporation_get
oe_corporation_set
oe_corporation_tag
oe_csv2data_handles
oe_data_build
oe_date_biggest
oe_date_smallest
oe_define_TeX_output
oe_define_Compuset_output
oe_env_var_completion
oe_fmt_date
oe_ID_LDOC
oe_iso_country
oe_list_encodings
oe_new_job
oe_now_time
oe_num_sign_x
oe_num2txt_us
oe_open_fi_IN
oe_open_fo_OUT
oe_outmngr_compo_run
oe_outmngr_full_run
oe_outmngr_output_run
oe_process_ref_rec
oe_rec_motif
oe_rec_output
oe_rec_pre_process
oe_rec_process
oe_round
oe_set_sys_date
oe_to_date
oe_trimp_space
oe_trt_ref_rec
oe_uc_sans_accents
oe_unique_data_name
*OUT *IN @DATATAB $LAST_ENR
%motifs %ouTags %evalSsTrt
);
use POSIX qw(mkfifo);
use Date::Calc qw(Add_Delta_Days Delta_Days Date_to_Time Today Gmtime Week_of_Year);
use Encode;
use File::Basename;
use Getopt::Long;
use List::MoreUtils qw(uniq);
use List::Util qw(reduce);
use Math::Round qw(nearest);
use Sys::Hostname;
use oEdtk;
require oEdtk::libC7;
require oEdtk::Outmngr;
require oEdtk::TexDoc;
use oEdtk::Dict;
use oEdtk::Config qw(config_read);
lib/oEdtk/Main.pm view on Meta::CPAN
$motifs{$Rec_ID} ||="";
$offsetRec ||=0;
$lenRec ||="";
# SI MOTIF D'EXTRACTION DU TYPE D'ENREGISTREMENT N'EST PAS CONNU,
# ET SI IL N'Y A AUCUN PRE TRAITEMENT ASSOCIÉ AU TYPE D'ENREGISTREMENT,
# ALORS LE TYPE D'ENREGISTREMENT N'EST PAS CONNU
#
# CE CONTRÔLE PERMET DE DÉFINIR DYNAMIQUEMENT UN TYPE D'ENREGISTREMENT EN FOCNTION DU CONTEXTE
# C'EST A DIRE QU'UN ENREGISTREMENT TYPÉ "1" POURRA AVOIR DES CARACTÉRISITQUES DIFFÉRENTES
# EN FONCTION DU TYPE D'ENREGISTREMENT TRAITÉ PRÉCÉDEMMENT.
# CES CARACTÉRISITIQUES PEUVENT ÊTRE DÉFINIES AU MOMENT DU PRÉ TRAITEMENT.
#
if ($motifs{$Rec_ID} eq "" && !($evalSsTrt{$Rec_ID}[0])) {
warn "INFO : oe_trt_ref_rec() > LIGNE $. REC. >$Rec_ID< (offset $offsetRec) UNKNOWN\n";
return 0;
}
$PREVIOUS_REC =$CURRENT_REC;
$CURRENT_REC =$Rec_ID;
# STEP 0 : EVAL PRE TRAITEMENT de $refLigne
&{$evalSsTrt{$Rec_ID}[0]}($refLigne) if $evalSsTrt{$Rec_ID}[0];
# ON S'ASSURE DE BIEN VIDER LE TABLEAU DE LECTURE DE L'ENREGISTREMENT PRECEDENT
undef @DATATAB;
# EVENTUELLEMENT SUPPRESSION DES DONNEES NON UTILES (OFFSET ET HORS DATA UTILES (lenData))
${$refLigne}=~s/^.{$offsetRec}(.{1,$lenRec}).*/$1/ if ($offsetRec > 0);
# ECLATEMENT DE L'ENREGISTREMENT EN CHAMPS
@DATATAB =unpack ($motifs{$Rec_ID},${$refLigne})
or die "ERROR: oe_trt_ref_rec() > LIGNE $. typEnr >$Rec_ID< motif >$motifs{$Rec_ID}< UNKNOWN\n";
# STEP 1 : EVAL TRAITEMENT CHAMPS
&{$evalSsTrt{$Rec_ID}[1]} if $evalSsTrt{$Rec_ID}[1];
# STRUCTURATION DE L'ENREGISTREMENT POUR SORTIE
if ($ouTags{$Rec_ID} ne "-1"){
${$refLigne} ="${TAG_OPEN}a${Rec_ID}${TAG_CLOSE}";
${$refLigne} .=sprintf ($ouTags{$Rec_ID},@DATATAB)
or die "ERROR: oe_trt_ref_rec() > LIGNE $. typEnr >$Rec_ID< ouTags >$ouTags{$Rec_ID}<\n";
${$refLigne} .="${TAG_OPEN}e${Rec_ID}${TAG_CLOSE}\n";
} else {
${$refLigne}="";
}
$LAST_ENR=$Rec_ID;
# STEP 2 : EVAL POST TRAITEMENT
&{$evalSsTrt{$Rec_ID}[2]} if $evalSsTrt{$Rec_ID}[2];
# ÉVENTUELLEMENT AJOUT DE DONNÉES COMPLÉMENTAIRES
${$refLigne} .=$PUSH_VALUE;
$PUSH_VALUE ="";
${$refLigne} =~s/\s{2,}/ /g; # CONCATÉNATION DES BLANCS
#$LAST_ENR=$Rec_ID;
return 1, $Rec_ID;
}
sub prodEtk_rec_cdata_join ($){ # migrer prodEtk_rec_cdata_join
$PUSH_VALUE .=shift;
1;
}
sub prodEdtk_Previous_Rec () { # migrer oe_previous_rec
return $PREVIOUS_REC;
}
sub prodEdtk_Current_Rec () { # migrer oe_current_rec
return $CURRENT_REC;
}
################################################################################
sub oe_round ($;$){
# http://perl.enstimac.fr/allpod/fr-5.6.0/perlfaq4.pod
# http://perl.enstimac.fr/DocFr/perlfaq4.html
# http://www.linux-kheops.com/doc/perl/faq-perl-enstimac/perlfaq4.html
# Perl n'est pas en faute. C'est pareil qu'en C. L'IEEE dit que nous devons faire comme ça. Les nombres en Perl dont la valeur absolue est un entier inférieur à 2**31 (sur les machines 32 bit) fonctionneront globalement comme des entiers mathématiqu...
my $value = shift;
my $multiple= shift;
my $decimal;#= shift;
#if (!(defined $decimal)){$decimal = 2;} # decimal peut valoir 0 (decimal converti en entier)
if (!(defined $multiple)){$multiple = .01;} # $multiple peut valoir 0 (decimal converti en entier)
if ($multiple=~/^0\./){
$decimal=length($multiple)-2;
}elsif ($multiple=~/^\./){
$decimal=length($multiple)-1;
} else {
$decimal = 0;
}
my $motif = "%.0${decimal}f";
#my $multiple=1/(10**$decimal);
$value = nearest ($multiple, $value);
return sprintf ($motif, $value);
}
sub oe_num_sign_x(\$;$) { # migrer oe_num_sign_x
# traitement des montants signés alphanumeriques
# recoit : une reference a une variable alphanumerique
# un nombre de décimal après la virgule (optionnel, 0 par défaut)
my ($refMontant, $decimal)=@_;
${$refMontant} ||="";
$decimal ||=0;
# controle de la validite de la valeur transmise
${$refMontant}=~s/\s+//g;
if (${$refMontant} eq "" || ${$refMontant} eq 0) {
${$refMontant} =0;
return 1;
} elsif (${$refMontant}=~/\D{2,}/){
warn "INFO : value (${$refMontant}) not numeric.\n";
return -1;
}
my %hXVal;
lib/oEdtk/Main.pm view on Meta::CPAN
if (!defined($wdate1)) {
warn "INFO : Unexpected date format: \"$date1\" should be dd/mm/yyyy. Date ignored\n";
return 1;
}
if (!defined($wdate2)) {
warn "INFO : Unexpected date format: \"$date2\" should be dd/mm/yyyy. Date ignored\n";
return -1;
}
return $wdate1 <=> $wdate2;
}
sub oe_date_smallest($$) {
my ($date1, $date2) = @_;
if (oe_date_compare($date1, $date2) <= 0) {
return $date1;
} else {
return $date2;
}
}
sub oe_date_biggest($$) {
my ($date1, $date2) = @_;
if (oe_date_compare($date1, $date2) <= 0) {
return $date2;
} else {
return $date1;
}
}
sub oe_num2txt_us(\$) {
# traitement des montants au format Texte
# le séparateur de décimal "," est transformé en "." pour les commandes de chargement US / C7
# le séparateur de millier "." ou " " est supprimé
# recoit : une variable alphanumerique formattée pour l'affichage
# $value = oe_num2txt_us($value);
# ou par référence
# oe_num2txt_us($value);
my $refValue = shift;
${$refValue}||="";
if (${$refValue}){
${$refValue}=~s/\s+//g; # suppression des blancs
${$refValue}=~s/\.//g; # suppression des séparateurs de milliers
${$refValue}=~s/\,/\./g; # remplacement du séparateur de décimal
${$refValue}=~s/(.*)(\-)$/$2$1/;# éventuellement on met le signe négatif devant
} else {
${$refValue}=0;
}
return ${$refValue};
}
# NE SERT PLUS À RIEN DANS LE CONTEXTE LaTeX
sub oe_compo_set_value ($;$){ # oe_cdata_set
my ($value, $noedit) = @_;
# A RETIRER : CERTAINS NUM SONT DÉJÀ US
# -> oe_compo_set_value($value) => oe_compo_set_value(oe_num2txt_us($value))
my $result = $TAG_L_SET . oe_num2txt_us($value);
if (!$noedit) {
$result .= $TAG_R_SET;
}
return $result;
}
# NE SERT PLUS À RIEN DANS LE CONTEXTE LaTeX
sub oe_cdata_table_build($@){ # oe_xdata_table_build
my $name = shift;
my @DATATAB = shift;
my $cdata="";
for (my $i = 0; $i <= $#DATATAB; $i++) {
my $elem = sprintf("%.6s%0.2d", $name, $i);
$cdata .= oe_data_build($elem, $DATATAB[$i] || "");
}
#warn "\n";
return $cdata;
}
sub oe_include_build ($$){ # dans le cadre nettoyage code C7 il faudra raccourcir ces appels
my ($name, $path)= @_;
#import oEdtk::TexDoc;
my $tag = oEdtk::TexDoc->new();
$tag->include($name, $path);
return $tag;
}
# NE SERT PLUS À RIEN DANS LE CONTEXTE LaTeX
# mais utilisé dans Main.pm => nettoyer
sub oe_data_build($;$) { #oe_xdata_build
my ($name, $val)= @_;
if ($TAG_MODE eq 'TEX') {
my $tag = oEdtk::TexTag->new($name, $val);
return $tag->emit();
}
# POUR COMPUSET
my $data = "";
if (defined $val) {
# s'il s'agit d'une variable numérique
if ($val =~ /^[\d\.]+$/) {
$data = $TAG_OPEN . $TAG_MARKER . $name . $TAG_ASSIGN . $TAG_L_SET .
$val . $TAG_ASSIGN_CLOS . $TAG_CLOSE;
} else {
$data = $TAG_OPEN . $TAG_MARKER . $name . $TAG_ASSIGN .
$val . $TAG_ASSIGN_CLOS . $TAG_CLOSE;
}
} elsif (defined $name) {
$data = $TAG_OPEN . $name . $TAG_CLOSE;
}
return $data;
}
sub oe_app_usage() { # migrer oe_app_usage
my $app="";
$0=~/([\w-]+[\.plmex]*$)/;
$1 ? $app="application.pl" : $app=$1;
print STDOUT << "EOF";
Usage : $app </source/input/file.dat> [job] [options]
Usage : $app --noinputfiles [job] [options]
options :
--massmail to confirm mass treatment
--edms to confirm edms treatment
--cgi
these values depend on ED_REFIDDOC config table
(example : omgr treatment confirmation)
--input_code input caracters encoding
(ie : --input_code=iso-8859-1)
--noinputfiles no data file needed for treatment
--help this message
( run in 0.858 second using v1.01-cache-2.11-cpan-9789f410c06 )