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 )