/usr/share/perl5/Audio/Nama/Object.pm is in nama 1.078-2.
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 | package Audio::Nama::Object;
use Modern::Perl;
use Carp;
use Audio::Nama::Assign qw(yaml_out);
no strict; # Enable during dev and testing
BEGIN {
require 5.004;
$Audio::Nama::Object::VERSION = '1.04';
}
sub import {
return unless shift eq 'Audio::Nama::Object';
my $pkg = caller;
my $child = !! @{"${pkg}::ISA"};
eval join '',
"package $pkg;\n",
' use vars qw(%_is_field); ',
' map{ $_is_field{$_}++ } @_;',
($child ? () : "\@${pkg}::ISA = 'Audio::Nama::Object';\n"),
map {
defined and ! ref and /^[^\W\d]\w*$/s
or die "Invalid accessor name '$_'";
"sub $_ { return \$_[0]->{$_} }\n"
} @_;
die "Failed to generate $pkg" if $@;
return 1;
}
sub new {
my $class = shift;
bless { @_ }, $class;
}
sub is_legal_key {
# The behavior I want here is:
#
# Example class hierachy: Audio::Nama::Object, Audio::Nama::Wav, Audio::Nama::Track, Audio::Nama::SimpleTrack
# By inheriting from Track, SimpleTrack gets all the
# attributes of Track and Wav, without having to include
# them in the Track class definition
my ($class, $key) = @_;
$class = ref $class if ref $class; # support objects
return 1 if ${"$class\::_is_field"}{$key};
my ($parent_class) = @{"$class\::ISA"};
return unless $parent_class and $parent_class !~ /Object::Tiny/;
# this should be:
# return unless $parent_class and $parent_class !~ /Object/;
is_legal_key($parent_class,$key);
}
sub set {
my $self = shift;
my $class = ref $self;
#print "class: $class, args: @_\n";
croak "odd number of arguments ",join "\n--\n" ,@_ if @_ % 2;
my %new_vals = @_;
map{
$self->{$_} = $new_vals{$_} ;
my $key = $_;
is_legal_key(ref $self, $key) or croak "illegal key: $_ for object of type ", ref $self;
} keys %new_vals;
}
sub dumpp {
my $self = shift;
my $class = ref $self;
bless $self, 'HASH'; # easy magic
my $output = yaml_out $self;
print "Object class: $class\n";
print $output, "\n";
bless $self, $class; # restore
}
sub dump {
my $self = shift;
my $class = ref $self;
bless $self, 'HASH'; # easy magic
my $output = yaml_out $self;
bless $self, $class; # restore
return $output;
}
sub hashref {
my $self = shift;
my $class = ref $self;
bless $self, 'HASH'; # easy magic
#print yaml_out $self; return;
my %guts = %{ $self };
#print join " ", %guts; return;
#my @keys = keys %guts;
#map{ $output->{$_} or $output->{$_} = '~' } @keys;
bless $self, $class; # restore
return \%guts;
}
1;
__END__
=pod
=head1 NAME
Audio::Nama::Object - Class builder
=head1 SYNOPSIS
# Define a class
package Foo;
use Audio::Nama::Object qw{ bux baz };
1;
# Use the class
my $object = Foo->new( bux => 1 );
$object->set( bux => 2);
print "bux is " . $object->bux . "\n";
# Define a subclass (automatically inherits parent attributes)
package Bar;
our @ISA = 'Foo';
my $lonely_bar = Bar->new();
$lonely_bar->set(bux => 3);
|