|  line  | 
 stmt  | 
 bran  | 
 cond  | 
 sub  | 
 pod  | 
 time  | 
 code  | 
| 
1
 | 
  
 
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Perinci::Sub::Convert::v;  | 
| 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our $DATE = '2019-04-15'; # DATE  | 
| 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our $VERSION = '0.030'; # VERSION  | 
| 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
6
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
53247
 | 
 use 5.010001;  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
7
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
6
 | 
 use strict;  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
27
 | 
    | 
| 
8
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
4
 | 
 use warnings;  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
32
 | 
    | 
| 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
10
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
 
 | 
6
 | 
 use Exporter qw(import);  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1
 | 
    | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
445
 | 
    | 
| 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our @EXPORT_OK = qw(convert_property_v);  | 
| 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our %SPEC;  | 
| 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 $SPEC{convert_property_v} = {  | 
| 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     v => 1.1,  | 
| 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     summary => 'Convert v1.0 Rinci function metadata to v1.1',  | 
| 
18
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     args => {  | 
| 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         meta => {  | 
| 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             schema  => 'hash*', # XXX defhash  | 
| 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             req     => 1,  | 
| 
22
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             pos     => 0,  | 
| 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         },  | 
| 
24
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         new => {  | 
| 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             summary => 'New version',  | 
| 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             schema  => ['float*', default => '1.1'],  | 
| 
27
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         },  | 
| 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     },  | 
| 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     result_naked => 1,  | 
| 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 };  | 
| 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub convert_property_v {  | 
| 
32
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
  
1
  
 | 
128
 | 
     my %args = @_;  | 
| 
33
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
34
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
     my $meta = $args{meta};  | 
| 
35
 | 
1
 | 
 
 | 
  
 50
  
 | 
 
 | 
 
 | 
6
 | 
     my $old  = $meta->{v} // 1.0;  | 
| 
36
 | 
1
 | 
 
 | 
  
 50
  
 | 
 
 | 
 
 | 
4
 | 
     my $new  = $args{new} // 1.1;  | 
| 
37
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
38
 | 
1
 | 
  
 50
  
 | 
  
 33
  
 | 
 
 | 
 
 | 
6
 | 
     die "Can only convert v 1.0 -> 1.1" unless $old == 1.0 && $new == 1.1;  | 
| 
39
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
40
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
     $meta->{v} = $new;  | 
| 
41
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
42
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     # convert args  | 
| 
43
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
2
 | 
     if ($meta->{args}) {  | 
| 
44
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
         for my $argname (sort keys %{$meta->{args}}) {  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
6
 | 
    | 
| 
45
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
             my $oldarg = $meta->{args}{$argname};  | 
| 
46
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
             my $newarg = {};  | 
| 
47
 | 
2
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
8
 | 
             if (ref($oldarg) eq 'ARRAY') {  | 
| 
 
 | 
 
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
48
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
                 for (qw/summary description/) {  | 
| 
49
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                     $newarg->{$_} = $oldarg->[1]{$_}  | 
| 
50
 | 
2
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
5
 | 
                         if defined $oldarg->[1]{$_};  | 
| 
51
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
                     delete $oldarg->[1]{$_};  | 
| 
52
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 }  | 
| 
53
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
4
 | 
                 if (defined $oldarg->[1]{arg_pos}) {  | 
| 
54
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
                     $newarg->{pos} = $oldarg->[1]{arg_pos};  | 
| 
55
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
                     delete $oldarg->[1]{arg_pos};  | 
| 
56
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 }  | 
| 
57
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
2
 | 
                 if (defined $oldarg->[1]{arg_greedy}) {  | 
| 
58
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
                     $newarg->{slurpy} = $oldarg->[1]{arg_greedy};  | 
| 
59
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
                     delete $oldarg->[1]{arg_greedy};  | 
| 
60
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 }  | 
| 
61
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
3
 | 
                 if (defined $oldarg->[1]{arg_complete}) {  | 
| 
62
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
                     $newarg->{completion} = $oldarg->[1]{arg_complete};  | 
| 
63
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
                     delete $oldarg->[1]{arg_complete};  | 
| 
64
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 }  | 
| 
65
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
2
 | 
                 if (defined $oldarg->[1]{arg_aliases}) {  | 
| 
66
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
                     $newarg->{cmdline_aliases} = $oldarg->[1]{arg_aliases};  | 
| 
67
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
                     for my $al (keys %{ $newarg->{cmdline_aliases} }) {  | 
| 
 
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
68
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
                         my $als = $newarg->{cmdline_aliases}{$al};  | 
| 
69
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
3
 | 
                         if ($als->{code}) {  | 
| 
70
 | 
  
0
  
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
                             die join(  | 
| 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                                 "",  | 
| 
72
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                                 "Can't convert arg_aliases '$al' because ",  | 
| 
73
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                                 "it has 'code', this must be converted ",  | 
| 
74
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                                 "manually due to change of arguments ",  | 
| 
75
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                                 "(now only receives \\\%args)",  | 
| 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                             );  | 
| 
77
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                         }  | 
| 
78
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                     }  | 
| 
79
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
                     delete $oldarg->[1]{arg_aliases};  | 
| 
80
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 }  | 
| 
81
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             } elsif (!ref($oldarg)) {  | 
| 
82
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                 # do nothing  | 
| 
83
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             } else {  | 
| 
84
 | 
0
 | 
 
 | 
 
 | 
 
 | 
 
 | 
0
 | 
                 die "Can't handle v1.0 args property ".  | 
| 
85
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
                     "(arg '$argname' not array/scalar)";  | 
| 
86
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
             }  | 
| 
87
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
             $newarg->{schema} = $oldarg;  | 
| 
88
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
             $meta->{args}{$argname} = $newarg;  | 
| 
89
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
90
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
91
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
92
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
3
 | 
     if ($meta->{result}) {  | 
| 
93
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
         $meta->{result} = {schema=>$meta->{result}};  | 
| 
94
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
95
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
96
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
37
 | 
     $meta->{_note} = "Converted from v1.0 by ".__PACKAGE__.  | 
| 
97
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         " on ".scalar(localtime);  | 
| 
98
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
99
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
5
 | 
     $meta;  | 
| 
100
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
101
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
102
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 1;  | 
| 
103
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 # ABSTRACT: Convert v1.0 Rinci function metadata to v1.1  | 
| 
104
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
105
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 __END__  |