my $_validfields = {} ; # afin que l'ordre des champs soit conservé tie %{$_validfields}, "Tie::IxHash"; %$_validfields = ( 'LENGTH' => { offset => 0, length => 5, format => 'A', default => 175, mandatory => 1 }, 'RECORD FORMAT' => { offset => 5, length => 1, format => 'A', default => ' ', mandatory => 1 }, 'ID' => { offset => 6, length => 20, format => 'A', default => 'GEST', mandatory => 1 }, 'MEDIA' => { offset => 26, length => 2, format => 'A', default => 20, mandatory => 1 }, 'ORIG' => { offset => 28, length => 5, format => 'A', default => 'GEST', mandatory => 1 }, 'STATE' => { offset => 33, length => 1, format => 'A', default => 0, mandatory => 1 }, 'STATUS' => { offset => 34, length => 5, format => 'A', default => '', mandatory => 1 }, 'ERROR RECORD' => { offset => 39, length => 5, format => 'A', default => '', mandatory => 1 }, 'PRIORITY' => { offset => 44, length => 1, format => 'A', default => 9, mandatory => 1 }, 'TARGET SERVER' => { offset => 45, length => 4, format => 'A', default => '', mandatory => 1 }, 'TARGET LINE' => { offset => 49, length => 2, format => 'A', default => '', mandatory => 1 }, 'OUTPUT SC' => { offset => 51, length => 4, format => 'A', default => '', mandatory => 1 }, 'OUTPUT LINE' => { offset => 55, length => 2, format => 'A', default => '', mandatory => 1 }, 'BUNDLE FNAME' => { offset => 57, length => 47, format => 'hA', default => 0x01, mandatory => 1 }, 'DUPS' => { offset => 104, length => 5, format => 'A', default => 1, mandatory => 1 }, 'ORDER INITIATE TS' => { offset => 109, length => 14, format => 'A', default => '', mandatory => 1 }, 'ORDER CREATE TS' => { offset => 123, length => 14, format => 'A', default => '', mandatory => 1 }, 'ORDER READ TS' => { offset => 137, length => 14, format => 'A', default => '', mandatory => 1 }, 'ORDER CC TS' => { offset => 151, format => 'A', default => '', length => 14 }, 'COPIES REQUIRED' => { offset => 165, length => 5, format => 'A', default => '', mandatory => 1 }, 'DISKS PRODUCED' => { offset => 170, length => 5, format => 'A', default => '', mandatory => 1 }, # params optionnels #****v* # COLLATE est le seul paramètre codé par sa valeur binaire # c'est donc un INT et pas un STRING # ( #!%? et le coeur y est) #*** 'COLLATE' => { offset => 175, length => 1, format => 'C', default => 0, mandatory => 0 }, 'RETURN INFO' => { offset => 177, length => 1, format => 'A', default => '', mandatory => 0 }, 'RETURN FILE' => { offset => 178, length => 260, format => 'A', default => '', mandatory => 0 }, 'EXT BUNDLE FNAME' => { offset => 438, length => 260, format => 'A', default => '', mandatory => 0 }, 'EMAIL' => { offset => 698, length => 128, format => 'A', default => '', mandatory => 0 }, 'INPUT BIN' => { offset => 826, length => 2, format => 'A', default => '', mandatory => 0 }, );
Hope this helps.sub validfields { return $_validfields } sub _packdata { #****m* DataFile/_packdata # USAGE # $file->_packdata() # sérialise pour pack() tous les records # d'un fichier #*** my $self = shift ; my @stringrecords ; foreach my $record_ref ( @{ $self->{records} } ) { # il faut déréférencer l'objet record avant de l'appeler my $recdata = $self->_serialize_fields( $$record_ref->getdata( +) ); push @stringrecords, $recdata if $recdata ; } @stringrecords ? return join ( '', @stringrecords ) : return } sub _serialize_fields { #****m* DataFile/serialize_fields # USAGE # $file->_serialize_fields( $data_href ) # sérialise les données d'un record #*** my $self = shift ; my $data = shift ; my $output = ''; my $allfields = $self->validfields() ; # on itère sur tous les champs possibles foreach my $k ( keys %$allfields ) { # on insère la longueur en dernier next if $k eq 'LENGTH' ; my $value ; ( exists $data->{$k} ) ? ( $value = $data->{$k} ) : ( $value = + $allfields->{$k}{default} ) ; # le champ COLLATE est le seul qui soit un BYTE # les champs "noms courts" doivent contenir 0x01 # la longueur est corrigée de la longueur du format $output .= pack( $allfields->{$k}{format}. ( $allfields->{$k}{ +length} - length($allfields->{$k}{format}) + 1 ), $value ); } # on insère la longueur du champ au début my $datalength = length($output) + 5; $output = pack( "A5",$datalength ) . $output ; print $output ; return $output }
In reply to Re: Recreating a binary file from hex representation
by wazoox
in thread Recreating a binary file from hex representation
by choedebeck
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |