/usr/share/perl5/Audio/Nama/Object.pm is in nama 1.208-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 | package Audio::Nama::Object;
use Modern::Perl;
use Carp;
use Audio::Nama::Assign qw(json_out);
use Storable qw(dclone);
use Data::Dumper::Concise;
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 = 0+@{"${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 $_ { \$_[0]->{$_} }"
} @_;
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;
print $self->dump
}
sub dump {
my $self = shift;
my $output = Dumper($self);
return $output;
}
sub as_hash {
my $self = shift;
my $class = ref $self;
bless $self, 'HASH'; # easy magic
my %guts = %{ $self };
bless $self, $class;
$guts{class} = $class if is_legal_key(ref $self, 'class');
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);
|