File Coverage

blib/lib/PDLA/Lvalue.pm
Criterion Covered Total %
statement 84 86 97.6
branch 2 4 50.0
condition 1 5 20.0
subroutine 28 28 100.0
pod 1 1 100.0
total 116 124 93.5


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             PDLA::Lvalue - declare PDLA lvalue subs
4              
5             =head1 DESCRIPTION
6              
7             Declares a subset of PDLA functions so that they
8             can be used as lvalue subs. In particular, this allows
9             simpler constructs such as
10              
11             $x->slice(',(0)') .= 1;
12              
13             instead of the clumsy
14              
15             (my $tmp = $x->slice(',(0)')) .= 1;
16              
17             This will only work if your perl supports lvalue subroutines
18             (i.e. versions >= v5.6.0). Note that lvalue subroutines
19             are currently regarded experimental.
20              
21             =head1 SYNOPSIS
22              
23             use PDLA::Lvalue; # automatically done with all PDLA loaders
24              
25             =head1 FUNCTIONS
26              
27             =cut
28              
29             package PDLA::Lvalue;
30              
31             # list of functions that can be used as lvalue subs
32             # extend as necessary
33             my @funcs = qw/ clump diagonal dice dice_axis dummy flat
34             index index2d indexND indexNDb mslice mv
35             nslice nslice_if_pdl nnslice polyfillv px
36             range rangeb reorder reshape sever slice
37             where whereND xchg /;
38              
39             my $prots = join "\n", map {"use attributes 'PDLA', \\&PDLA::$_, 'lvalue';"}
40             @funcs;
41              
42             =head2 subs
43              
44             =for ref
45              
46             test if routine is a known PDLA lvalue sub
47              
48             =for example
49              
50             print "slice is an lvalue sub" if PDLA::Lvalue->subs('slice');
51              
52             returns the list of PDLA lvalue subs if no routine name is given, e.g.
53              
54             @lvfuncs = PDLA::Lvalue->subs;
55              
56             It can be used in scalar context to find out if your
57             PDLA has lvalue subs:
58              
59             print 'has lvalue subs' if PDLA::Lvalue->subs;
60              
61             =cut
62              
63             sub subs {
64 1     1 1 63 my ($type,$func) = @_;
65 1 50       3 if (defined $func) {
66 0         0 $func =~ s/^.*:://;
67 0   0     0 return ($^V and $^V >= 5.006007) && scalar grep {$_ eq $func} @funcs;
68             } else {
69 1 50 33     27 return ($^V and $^V >= 5.006007) ? @funcs : ();
70             }
71             }
72              
73             # print "defining lvalue subs:\n$prots\n";
74              
75 77     77   569 eval << "EOV" if ($^V and $^V >= 5.006007);
  77     77   187  
  77     77   5025  
  77     77   40762  
  77     77   89720  
  77     77   598  
  77     77   17414  
  77     77   185  
  77     77   353  
  77     77   10325  
  77     77   185  
  77     77   350  
  77     77   9970  
  77     77   219  
  77     77   354  
  77     77   10236  
  77     77   187  
  77     77   411  
  77     77   10481  
  77     77   206  
  77     77   340  
  77     77   11135  
  77     77   170  
  77     77   439  
  77     77   6332  
  77     77   189  
  77     77   459  
  77         6329  
  77         229  
  77         394  
  77         10669  
  77         177  
  77         372  
  77         6063  
  77         180  
  77         350  
  77         10461  
  77         165  
  77         410  
  77         6101  
  77         225  
  77         508  
  77         10654  
  77         188  
  77         469  
  77         10830  
  77         190  
  77         530  
  77         6355  
  77         221  
  77         411  
  77         6078  
  77         227  
  77         447  
  77         5984  
  77         189  
  77         405  
  77         10499  
  77         182  
  77         353  
  77         6475  
  77         216  
  77         398  
  77         10339  
  77         171  
  77         383  
  77         11226  
  77         167  
  77         410  
  77         6260  
  77         187  
  77         364  
  77         10327  
  77         182  
  77         356  
  77         10308  
  77         225  
  77         380  
  77         6111  
  77         197  
  77         399  
76             { package PDLA;
77             no warnings qw(misc);
78             $prots
79             }
80             EOV
81              
82             =head1 AUTHOR
83              
84             Copyright (C) 2001 Christian Soeller (c.soeller@auckland.ac.nz). All
85             rights reserved. There is no warranty. You are allowed to redistribute
86             this software / documentation under certain conditions. For details,
87             see the file COPYING in the PDLA distribution. If this file is
88             separated from the PDLA distribution, the copyright notice should be
89             included in the file.
90              
91             =cut
92              
93             1;