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       4 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 123     123   991 eval << "EOV" if ($^V and $^V >= 5.006007);
  123     123   330  
  123     123   9004  
  123     123   75513  
  123     123   157886  
  123     123   910  
  123     123   30265  
  123     123   318  
  123     123   602  
  123     123   17159  
  123     123   297  
  123     123   603  
  123     123   16441  
  123     123   287  
  123     123   641  
  123     123   16438  
  123     123   299  
  123     123   611  
  123     123   17216  
  123     123   306  
  123     123   641  
  123     123   17742  
  123     123   362  
  123     123   1049  
  123     123   10878  
  123     123   334  
  123     123   698  
  123         10593  
  123         310  
  123         653  
  123         18714  
  123         288  
  123         692  
  123         10641  
  123         342  
  123         668  
  123         18076  
  123         321  
  123         585  
  123         10894  
  123         310  
  123         638  
  123         18175  
  123         333  
  123         696  
  123         18351  
  123         295  
  123         754  
  123         11212  
  123         300  
  123         841  
  123         10753  
  123         343  
  123         837  
  123         10449  
  123         312  
  123         704  
  123         18034  
  123         326  
  123         627  
  123         10510  
  123         296  
  123         716  
  123         17912  
  123         342  
  123         706  
  123         18113  
  123         306  
  123         681  
  123         10403  
  123         331  
  123         665  
  123         17596  
  123         298  
  123         622  
  123         17902  
  123         293  
  123         670  
  123         10617  
  123         327  
  123         689  
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;