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       6 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     52 return ($^V and $^V >= 5.006007) ? @funcs : ();
70             }
71             }
72              
73             # print "defining lvalue subs:\n$prots\n";
74              
75 122     122   1012 eval << "EOV" if ($^V and $^V >= 5.006007);
  122     122   322  
  122     122   8481  
  122     122   72979  
  122     122   152434  
  122     122   855  
  122     122   30332  
  122     122   285  
  122     122   589  
  122     122   16583  
  122     122   268  
  122     122   579  
  122     122   16293  
  122     122   302  
  122     122   523  
  122     122   15921  
  122     122   302  
  122     122   529  
  122     122   17000  
  122     122   272  
  122     122   577  
  122     122   17463  
  122     122   281  
  122     122   650  
  122     122   10710  
  122     122   297  
  122     122   671  
  122         10658  
  122         311  
  122         600  
  122         17894  
  122         405  
  122         654  
  122         10478  
  122         308  
  122         607  
  122         17899  
  122         295  
  122         612  
  122         10606  
  122         277  
  122         685  
  122         18006  
  122         282  
  122         634  
  122         17675  
  122         301  
  122         858  
  122         11214  
  122         311  
  122         747  
  122         10316  
  122         283  
  122         769  
  122         10501  
  122         304  
  122         642  
  122         17765  
  122         285  
  122         705  
  122         10355  
  122         344  
  122         692  
  122         17506  
  122         257  
  122         696  
  122         18081  
  122         296  
  122         642  
  122         10086  
  122         322  
  122         642  
  122         17375  
  122         271  
  122         594  
  122         17522  
  122         296  
  122         613  
  122         10174  
  122         314  
  122         624  
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;