Thread Hilfestellung bei Problem mit package (20 answers)
Opened by jan99 at 2015-03-27 08:06

jan99
 2015-04-02 08:50
#180517 #180517
User since
2008-09-18
439 Artikel
BenutzerIn
[default_avatar]
Hallo Raubtier,

Du hast recht - anfangs ging es um ein Problem mit dem "Betrieb" des Packages und zwischenzeitlich sind daraus OO-Fragen gekommen.

Um den aktuellen Stand des Postings nochmal darzulegen für ich am Ende nochmal meinen Code ein wie derzeit vorliegt. Damit dieser gegenüber dem Anfang nicht mehr so lang ist habe ich einige Sub-Funktionen die derzeit nicht zur Diskussion stehen rausgenommen.

Es geht darum das es eine OO-Logfunktion geben soll (auch wenn wie hier angemerkt OO vielleicht etwas überzogen ist) bei welcher die Befehlszeilenfensterausgabe und Dateiausgabe über die Parameter Log und Shell gesteuert werden können.

Der gesamte Grundcode stammt aus einer Funktion die mal funktioniert hat.

Derzeit ist mein Problem das die Funktion WRITE immer, und damit doppelt, in die Befehlszeile ausgibt und der Fehler vermutlich irgendwo im Bereich open liegen mag. So meine Vermutung.

Aber irgendwie komme ich nicht weiter und ich würde mich sehr freuen, wenn mir einer nochmal aufzeigen kann wo der Fehler liegt. Ich finde diesen nicht.

Vielleicht finde ich eine Hilfestellung im Osternest.

Gruß Jan

... hier der Code

Code (perl): (dl )
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
# Funktionen für das Loggen von Programmen
# Jan Tappenbeck, 2015
#
#
# Historie
# 2015-03-27  von Privat übernommen

package EBL::ebl_reporting;

use strict;
use warnings;
use IO::File;
#use Time::localtime;
require Time::localtime; 
use 5.14.0;

sub new { bless({ log_on => 1, shell_on => 1 }, shift) }

sub show_status {
    my $self=shift;
    print "Log: ", $self->log(), ", Shell: ", $self->shell()."\n";
}


sub open
{
  my $class=shift;
  my $log_file=shift;

  # Referenz auf STDOUT
  my $fh=\*STDOUT;

  # wenn object und kein File => neuer Name = alter Name
  if(ref $class && !$log_file)
  {
    $log_file=$class->{file};
    $class->{fh}->close();
  }

  # versuchen Fh zu öffnen
  if($log_file) {
    my $ofh=IO::File->new();
    my $mode='>';
    $mode='>>' if( ref $class );
    if($ofh->open($log_file,$mode) ) {
      $fh=$ofh;
    } else {
      $fh->print("ERROR open $log_file ($!)\nwrite to STDOUT\n");
    }
  }

  # objektwerte neu setzen wenn objekt
  if( ref $class ) {
    $class->{fh}=$fh;
    $class->{file}=$log_file;
    return $class;
  }

  # neues Objekt
  return bless({ fh=>$fh, file=>$log_file, on=>1 },$class);
}

# log(1) => logging an
# log(0) => logging aus
# log() => aktueller Status
sub log
{
  my $self=shift;
  $self->{log_on}=shift() if(@_);
  return $self->{log_on};
}

# shell(1) => zusätzliche Shell-Ausgabe an
# shell(0) => zusätzliche Shell-Ausgabe aus
# shell() => aktueller Status
sub shell
{
  my $self=shift;
  $self->{shell_on}=shift() if(@_);
  return $self->{shell_on};
}

# filename
sub file   { shift->{file}; }

# filehandle
sub fh     { shift->{fh}; }

# write to file mit optionaler Ausgabe auf die Shell
sub write {
  my ($self, $msg) = @_;
  $self->fh->print($msg."\n") if $self->log(); 
  print($msg."\n") if $self->shell(); 
}#end-write


# close filehandle
sub close  { shift->fh->close(); }

# wahr wenn Datei geöffnet
sub opened { shift->fh->opened(); }

1;
perl-Greenhorn - Win7 64bit / strawberry (ehem. activeperl) - www.OpenStreetMap.de

View full thread Hilfestellung bei Problem mit package