File Coverage

blib/lib/Tie/File/Indexed/JSON.pm
Criterion Covered Total %
statement 25 25 100.0
branch 6 8 75.0
condition 3 5 60.0
subroutine 8 8 100.0
pod 4 5 80.0
total 46 51 90.2


line stmt bran cond sub pod time code
1             ##-*- Mode: CPerl -*-
2             ##
3             ## File: Tie/File/Indexed/JSON.pm
4             ## Author: Bryan Jurish
5             ## Description: tied array access to indexed data files: JSON-encoded data structures
6              
7             package Tie::File::Indexed::JSON;
8 2     2   13771 use Tie::File::Indexed;
  2         3  
  2         44  
9 2     2   14 use JSON;
  2         0  
  2         9  
10 2     2   193 use strict;
  2         2  
  2         490  
11              
12             ##======================================================================
13             ## Globals
14              
15             our @ISA = qw(Tie::File::Indexed);
16              
17             ##======================================================================
18             ## Constructors etc.
19              
20             ## $tfi = CLASS->new(%opts)
21             ## $tfi = CLASS->new($file,%opts)
22             ## + new %opts, object structure:
23             ## (
24             ## json => $json, ##-- JSON object or HASH-ref of options
25             ## )
26              
27             ## \%defaults = CLASS_OR_OBJECT->defaults()
28             ## + default attributes for constructor
29             sub defaults {
30             return (
31 1     1 1 5 $_[0]->SUPER::defaults,
32             json => {utf8=>1, relaxed=>1, allow_nonref=>1, allow_unknown=>1, allow_blessed=>1, convert_blessed=>1, pretty=>0, canonical=>0},
33             );
34             }
35              
36             ##--------------------------------------------------------------
37             ## Utilities: JSON
38              
39             ## $json = $aj->json()
40             ## + returns json codec
41             sub json {
42 1 50   1 0 4 return $_[0]{json} if (UNIVERSAL::isa($_[0]{json}, 'JSON'));
43 1         11 my $json = JSON->new;
44 1   50     1 foreach (grep {$json->can($_)} keys %{$_[0]{json}//{}}) {
  8         27  
  1         6  
45 8         16 $json->can($_)->($json,$_[0]{json}{$_});
46             }
47 1         2 return $_[0]{json} = $json;
48             }
49              
50             ##======================================================================
51             ## Object API: overrides
52              
53             ##--------------------------------------------------------------
54             ## Object API: overrides: open/close
55              
56             ## $tfi_or_undef = $tfi->open($file,$mode)
57             ## $tfi_or_undef = $tfi->open($file)
58             ## $tfi_or_undef = $tfi->open()
59             ## + opens file(s)
60             sub open {
61 1     1 1 1 my $tfi = shift;
62 1 50       5 return undef if (!$tfi->SUPER::open(@_));
63              
64             ##-- ensure 'json' object is defined
65 1         3 $tfi->json();
66 1         7 return $tfi;
67             }
68              
69             ##======================================================================
70             ## Subclass API: Data I/O
71              
72             ## $bool = $tfi->writeData($utf8_string)
73             ## + override transparently encodes $data using the JSON module
74             sub writeData {
75 7 100   7 1 14 return 1 if (!defined($_[1])); ##-- don't waste space on undef
76 6         47 return $_[0]{datfh}->print( $_[0]{json}->encode($_[1]) );
77             }
78              
79             ## $data_or_undef = $tfi->readData($length)
80             ## + override decodes stored data using the JSON module
81             sub readData {
82 7 100 66 7 1 29 return undef if ($_[1]==0 || !defined(my $buf=$_[0]->SUPER::readData($_[1])));
83 5         30 return $_[0]{json}->decode($buf);
84             }
85              
86              
87             1; ##-- be happpy