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
package Hgltools;
use strict;
use warnings;
use English '-no_match_vars';
use Carp;
use feature qw/switch/;
use Readonly;
use vars qw($VERSION @ISA @EXPORT_OK);
if ( eval 'use Hglreadfile; 1;' ) {push @ISA,'Hglreadfile';};
require Exporter;
use base qw(Exporter);
@EXPORT_OK = qw ();
sub new {
my @opt = @_;
my $shelf = {};
my $class = $opt[0];
my $args = $opt[1];
$class = ref($class) || $class;
bless $shelf, $class;
return $shelf;
} # end sub new
$VERSION = '0.01'
1;
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
package Hglreadfile;
use strict;
use warnings;
use English '-no_match_vars';
use Carp;
use feature qw/switch/;
use Readonly;
require Exporter;
use vars qw($VERSION @ISA @EXPORT_OK);
use base qw(Exporter);
@EXPORT_OK = qw (_readfile);
sub new {
my @opt = @_;
my $shelf = {};
my $class = $opt[0];
my $args = $opt[1];
$class = ref($class) || $class;
bless $shelf, $class;
return $shelf;
} # end sub new
sub _readfile {
my ($shelf,$args) = @_;
my $file = \$args->{'file'};
my @content = ();
if ( not ( -e ${$file} ) ) { return ('filenotexist'); }
open my $FH , '<', ${$file} or croak "can't open ${$file} for _readfile $ERRNO";
while (<$FH>) {
chomp;
push @content,$_;
}
close $FH or croak $ERRNO;
return (@content);
}
1;
if ( eval 'use Hglreadfile; 1;' ) {push @ISA,'Hglreadfile';};
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
package FileRole; use strict; use warnings; use Carp; use Role::Basic; sub readfile { my ($self,$args) = @_; my $file = $args->{file}; if ( !$file || !-e $file ) { return 'filenotexists'; } open my $fh, '<', $args->{file} or croak "can't open $file for readfile $!"; my @lines = <$fh>; close $fh; return @lines; } 1;
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
package TestClass; use strict; use warnings; use Role::Basic 'with'; eval{ with qw(FileRole); }; sub new { my ($class) = @_; my $self = bless {}, $class; return $self; } 1;
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
#!/usr/bin/perl use strict; use warnings; use lib qw(lib); use TestClass; my $obj = TestClass->new; if ( $obj->DOES( 'FileRole' ) ) { my @lines = $obj->readfile({ file => $0 }); print @lines; }
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
package Hgltools;
use strict;
use warnings;
use English '-no_match_vars';
use Carp;
use feature qw/switch/;
use Readonly;
our $VERSION = '0.01';
our @ISA = qw(Exporter);
our @EXPORT_OK = ();
if ( eval 'use Hglreadfile; 1;' ) { push @EXPORT_OK,'_readfile'; }
require Exporter;
use base qw(Exporter);
sub new {
my ($class,$args) = @_;
my $shelf = {};
$class = ref($class) || $class;
bless $shelf,$class;
return $shelf;
} # end sub new
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
package Hglreadfile;
# $Revision: 00001 $
# $Source: /home/glaess/perl/hgltools/Hglreadfile.pm $
# $Id: Holger Glaess $
use strict;
use warnings;
use English '-no_match_vars';
use Carp;
our $VERSION = '0.01';
our @ISA = qw(Exporter);
our @EXPORT = qw (_readfile);
our @EXPORT_OK = qw (_readfile);
sub new {
my @opt = @_;
my $shelf = {};
my $class = $opt[0];
my $args = $opt[1];
$class = ref($class) || $class;
bless $shelf, $class;
return $shelf;
} # end sub new
sub _readfile {
my ($shelf,$args) = @_;
my $file = \$args->{'file'};
my @content = ();
if ( not ( -e ${$file} ) ) { return ('filenotexist'); }
open my $FH , '<', ${$file} or croak "can't open ${$file} for _readfile $ERRNO";
while (<$FH>) {
chomp;
push @content,$_;
}
close $FH or croak $ERRNO;
return (@content);
}
1;
( $obj->can( 'readfile' ) )
2011-06-01T10:09:12 mark05wo gibt es documentation zu can ?
2011-06-01T09:11:53 mark05thema moose bzw Role ist fuer mich erstmal tabu da kein core modul.