/usr/share/perl5/EB/Import.pm is in eekboek 2.00.03-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 | #! perl -- -*- coding: utf-8 -*-
use utf8;
# Import.pm -- Import EekBoek administratie
# RCS Info : $Id: Import.pm,v 1.11 2009/10/14 21:14:02 jv Exp $
# Author : Johan Vromans
# Created On : Tue Feb 7 11:56:50 2006
# Last Modified By: Johan Vromans
# Last Modified On: Wed Oct 14 23:06:21 2009
# Update Count : 89
# Status : Unknown, Use with caution!
package main;
our $cfg;
our $dbh;
package EB::Import;
use strict;
use warnings;
our $VERSION = sprintf "%d.%03d", q$Revision: 1.11 $ =~ /(\d+)/g;
use EB;
use EB::Format; # needs to be setup before we can use Schema
my $ident;
sub do_import {
my ($self, $cmdobj, $opts) = @_;
require EB::Tools::Schema;
my $dir = $opts->{dir};
if ( defined $dir ) {
die("?".__x("Directory {dir} bestaat niet",
dir => $dir)."\n") unless -d $dir;
die("?".__x("Geen toegang tot directory {dir}",
dir => $dir)."\n") unless -r _ || -x _;
-r "$dir/schema.dat"
or die("?".__x("Bestand \"{file}\" ontbreekt ({err})",
file => "schema.dat", err => $!)."\n");
# Do not open these with :encoding(utf-8) -- we'll do it ourselves.
open(my $relaties, "<", "$dir/relaties.eb")
or die("?".__x("Bestand \"{file}\" ontbreekt ({err})",
file => "relaties.eb", err => $!)."\n");
open(my $opening, "<", "$dir/opening.eb")
or die("?".__x("Bestand \"{file}\" ontbreekt ({err})",
file => "opening.eb", err => $!)."\n");
open(my $mutaties, "<", "$dir/mutaties.eb")
or die("?".__x("Bestand \"{file}\" ontbreekt ({err})",
file => "mutaties.eb", err => $!)."\n");
# To temporary suspend journaling.
my $jnl_state = $cfg->val(qw(preferences journal), undef);
# Create DB.
$dbh->cleardb if $opts->{clean};
# Schema.
EB::Tools::Schema->create("$dir/schema.dat");
$dbh->setup;
$cmdobj->_plug_cmds;
# Relaties, Opening, Mutaties.
# Remember: These are executed in LIFO.
$cmdobj->attach_lines(["journal --quiet $jnl_state"]) if $jnl_state;
$cmdobj->attach_file($mutaties);
$cmdobj->attach_file($opening);
$cmdobj->attach_file($relaties);
$cmdobj->attach_lines(["journal --quiet 0"]) if $jnl_state;
return;
}
my $inp = $opts->{file};
if ( defined $inp ) {
# die("?"._T("Import van bestand is nog niet geïmplementeerd")."\n");
eval { require Archive::Zip }
or die("?"._T("Module Archive::Zip, nodig voor import van file, is niet beschikbaar")."\n");
open(my $zipf, "<", $inp)
or die("?".__x("Bestand \"{file}\" is niet beschikbaar ({err})",
file => $inp, err => $!)."\n");
binmode($zipf);
my $zip = Archive::Zip->new;
my $status = $zip->read($zipf);
die("?".__x("Fout {code} tijdens het lezen van {file}",
code => $status, file => $inp)."\n") if $status;
my $c = $zip->zipfileComment;
if ( $c ) {
warn("$inp: $c\n");
}
my $fail;
my $d_schema = $zip->contents("schema.dat");
unless ( $d_schema ) {
warn("?".__x("Het schema ontbreekt in bestand {file}",
file => $inp)."\n");
$fail++;
}
my $d_relaties = $zip->contents("relaties.eb");
unless ( $d_relaties ) {
warn("?".__x("De relatiegegevens ontbreken in bestand {file}",
file => $inp)."\n");
$fail++;
}
my $d_opening = $zip->contents("opening.eb");
unless ( $d_opening ) {
warn("?".__x("De openingsgegevens ontbreken in bestand {file}",
file => $inp)."\n");
$fail++;
}
my $d_mutaties = $zip->contents("mutaties.eb");
unless ( $d_mutaties ) {
warn("?".__x("De mutatiegegevens ontbreken in bestand {file}",
file => $inp)."\n");
$fail++;
}
close($zipf);
die("?"._T("DE IMPORT IS NIET UITGEVOERD")."\n") if $fail;
foreach ( $d_mutaties, $d_relaties, $d_opening, $d_schema ) {
# Do not recode, the input loop will do that for us.
$_ = [ map { "$_\n" } split(/[\n\r]+/, $_) ];
}
eval {
# Create DB.
$dbh->cleardb if $opts->{clean};
# Schema.
EB::Tools::Schema->_create(sub { shift(@$d_schema) });
$dbh->setup;
$cmdobj->_plug_cmds;
# Relaties, Opening, Mutaties. In reverse order.
$cmdobj->attach_lines($d_mutaties);
$cmdobj->attach_lines($d_opening );
$cmdobj->attach_lines($d_relaties);
};
return $@;
}
die("?ASSERT ERROR: missing --dir / --file in Import\n");
}
1;
|