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 62 my ($type,$func) = @_;
65 1 50       5 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     28 return ($^V and $^V >= 5.006007) ? @funcs : ();
70             }
71             }
72              
73             # print "defining lvalue subs:\n$prots\n";
74              
75 78     78   614 eval << "EOV" if ($^V and $^V >= 5.006007);
  78     78   164  
  78     78   5434  
  78     78   43329  
  78     78   93564  
  78     78   579  
  78     78   17986  
  78     78   187  
  78     78   356  
  78     78   10756  
  78     78   183  
  78     78   351  
  78     78   10318  
  78     78   190  
  78     78   333  
  78     78   10583  
  78     78   208  
  78     78   394  
  78     78   10915  
  78     78   199  
  78     78   389  
  78     78   11332  
  78     78   177  
  78     78   394  
  78     78   6648  
  78     78   212  
  78     78   476  
  78         6471  
  78         191  
  78         401  
  78         11339  
  78         173  
  78         356  
  78         6441  
  78         239  
  78         356  
  78         11055  
  78         210  
  78         430  
  78         6599  
  78         181  
  78         451  
  78         10940  
  78         189  
  78         770  
  78         11465  
  78         215  
  78         493  
  78         6759  
  78         195  
  78         438  
  78         6641  
  78         233  
  78         472  
  78         6371  
  78         205  
  78         401  
  78         11173  
  78         181  
  78         395  
  78         6897  
  78         191  
  78         390  
  78         11174  
  78         200  
  78         433  
  78         11327  
  78         177  
  78         377  
  78         6446  
  78         204  
  78         371  
  78         10838  
  78         188  
  78         376  
  78         10976  
  78         194  
  78         438  
  78         6668  
  78         231  
  78         437  
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;