File Coverage

blib/lib/PDL/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             PDL::Lvalue - declare PDL lvalue subs
4              
5             =head1 DESCRIPTION
6              
7             Declares a subset of PDL 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 PDL::Lvalue; # automatically done with all PDL loaders
24              
25             =head1 FUNCTIONS
26              
27             =cut
28              
29             package PDL::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 'PDL', \\&PDL::$_, 'lvalue';"}
40             @funcs;
41              
42             =head2 subs
43              
44             =for ref
45              
46             test if routine is a known PDL lvalue sub
47              
48             =for example
49              
50             print "slice is an lvalue sub" if PDL::Lvalue->subs('slice');
51              
52             returns the list of PDL lvalue subs if no routine name is given, e.g.
53              
54             @lvfuncs = PDL::Lvalue->subs;
55              
56             It can be used in scalar context to find out if your
57             PDL has lvalue subs:
58              
59             print 'has lvalue subs' if PDL::Lvalue->subs;
60              
61             =cut
62              
63             sub subs {
64 1     1 1 84 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     48 return ($^V and $^V >= 5.006007) ? @funcs : ();
70             }
71             }
72              
73             # print "defining lvalue subs:\n$prots\n";
74              
75 122     122   970 eval << "EOV" if ($^V and $^V >= 5.006007);
  122     122   329  
  122     122   8698  
  122     122   74273  
  122     122   156794  
  122     122   1035  
  122     122   29942  
  122     122   299  
  122     122   593  
  122     122   17286  
  122     122   281  
  122     122   591  
  122     122   16274  
  122     122   333  
  122     122   567  
  122     122   15998  
  122     122   288  
  122     122   555  
  122     122   17359  
  122     122   286  
  122     122   574  
  122     122   17670  
  122     122   320  
  122     122   618  
  122     122   10784  
  122     122   342  
  122     122   651  
  122         10458  
  122         349  
  122         619  
  122         18295  
  122         301  
  122         591  
  122         10399  
  122         335  
  122         708  
  122         17717  
  122         320  
  122         646  
  122         10409  
  122         309  
  122         734  
  122         17636  
  122         285  
  122         649  
  122         17524  
  122         321  
  122         961  
  122         10833  
  122         323  
  122         751  
  122         10657  
  122         309  
  122         704  
  122         10468  
  122         334  
  122         641  
  122         17659  
  122         307  
  122         622  
  122         10564  
  122         353  
  122         766  
  122         17439  
  122         304  
  122         653  
  122         18284  
  122         282  
  122         614  
  122         10291  
  122         353  
  122         690  
  122         17711  
  122         285  
  122         656  
  122         17639  
  122         293  
  122         609  
  122         10356  
  122         302  
  122         611  
76             { package PDL;
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 PDL distribution. If this file is
88             separated from the PDL distribution, the copyright notice should be
89             included in the file.
90              
91             =cut
92              
93             1;