File Coverage

blib/lib/DiaColloDB/Client/file.pm
Criterion Covered Total %
statement 9 44 20.4
branch 0 26 0.0
condition 0 13 0.0
subroutine 3 10 30.0
pod 7 7 100.0
total 19 100 19.0


line stmt bran cond sub pod time code
1             ## -*- Mode: CPerl -*-
2             ## File: DiaColloDB::Client::file.pm
3             ## Author: Bryan Jurish <moocow@cpan.org>
4             ## Description: collocation db: client: local dbdir
5              
6             package DiaColloDB::Client::file;
7 2     2   12 use DiaColloDB::Client;
  2         4  
  2         54  
8 2     2   956 use URI;
  2         7608  
  2         48  
9 2     2   10 use strict;
  2         4  
  2         1040  
10              
11             ##==============================================================================
12             ## Globals & Constants
13              
14             our @ISA = qw(DiaColloDB::Client);
15              
16             ##==============================================================================
17             ## Constructors etc.
18              
19             ## $cli = CLASS_OR_OBJECT->new(%args)
20             ## $cli = CLASS_OR_OBJECT->new($url, %args)
21             ## + %args, object structure:
22             ## (
23             ## ##-- DiaColloDB::Client: options
24             ## url => $url, ##-- local url; query form is used as db parameters ##-- CONTINUE HERE: adjust dstar web params to auto-set ddcServer!
25             ## ##
26             ## ##-- DiaColloDB::Client::file
27             ## db => $db, ##-- underlying DiaColloDB object
28             ## )
29              
30             ##==============================================================================
31             ## I/O: open/close
32              
33             ## $cli_or_undef = $cli->open_file($file_url,%opts)
34             ## $cli_or_undef = $cli->open_file()
35             ## + opens a local file url
36             ## + may re-bless() $cli into an appropriate package
37             ## + OVERRIDE in subclasses supporting file urls
38             sub open_file {
39 0     0 1   my ($cli,$url,%opts) = @_;
40 0 0         $cli = $cli->new() if (!ref($cli));
41 0 0         $cli->close() if ($cli->opened);
42 0   0       $cli->{url} = $url = ($url // $cli->{url});
43 0           my $uri = URI->new($url);
44 0   0       my $path = ($uri->authority//'') . ($uri->path//'');
      0        
45 0           my %dbopts = ($cli->dbOptions, $uri->query_form());
46              
47             ##-- check whether the path looks like an rc-file; if so, try to open it as one
48 0 0 0       return $cli->open_rcfile($cli->{url},%opts)
49             if (!-d $path && !-e "$path/header.json");
50              
51 0 0         $cli->{db} = DiaColloDB->new(%dbopts,dbdir=>$path)
52             or $cli->logconfess("open_file() failed to open DB directory $path: $!");
53 0           return $cli;
54             }
55              
56             ## $cli_or_undef = $cli->close()
57             ## + default just returns $cli
58             sub close {
59 0     0 1   my $cli = shift;
60 0 0         $cli->{db}->close() if ($cli->{db});
61 0           delete @$cli{qw(db)};
62 0           return $cli;
63             }
64              
65             ## $bool = $cli->opened()
66             ## + default just checks for $cli->{url}
67             sub opened {
68 0   0 0 1   return ref($_[0]) && $_[0]{db} && $_[0]{db}->opened();
69             }
70              
71             ##==============================================================================
72             ## db-info
73              
74             ## \%info = $cli->dbinfo()
75             sub dbinfo {
76 0     0 1   my $cli = shift;
77 0 0         $cli->logconfess($cli->{error}="profile(): no db opened!") if (!$cli->opened);
78 0           delete $cli->{error};
79 0 0         $cli->{error} = $cli->{db}{error} if (!defined(my $info = $cli->{db}->dbinfo(@_)));
80 0           return $info;
81             }
82              
83             ##==============================================================================
84             ## Profiling
85              
86             ##--------------------------------------------------------------
87             ## Profiling: Generic
88              
89             ## $mprf = $cli->profile($relation, %opts)
90             ## + get a relation profile for selected items as a DiaColloDB::Profile::Multi object
91             ## + %opts: as for DiaColloDB::profile()
92             sub profile {
93 0     0 1   my $cli = shift;
94 0 0         $cli->logconfess($cli->{error}="profile(): no db opened!") if (!$cli->opened);
95 0           delete $cli->{error};
96 0 0         $cli->{error} = $cli->{db}{error} if (!defined(my $mp = $cli->{db}->profile(@_)));
97 0           return $mp;
98             }
99              
100             ##--------------------------------------------------------------
101             ## Profiling: extend (pass-2 for multi-clients)
102              
103             ## $mprf = $cli->extend($relation, %opts)
104             ## + get an extension-profile for selected items as a DiaColloDB::Profile::Multi object
105             ## + %opts: as for DiaColloDB::extend()
106             ## + sets $cli->{error} on error
107             sub extend {
108 0     0 1   my $cli = shift;
109 0 0         $cli->logconfess($cli->{error}="extend(): no db opened!") if (!$cli->opened);
110 0           delete $cli->{error};
111 0 0         $cli->{error} = $cli->{db}{error} if (!defined(my $mp = $cli->{db}->extend(@_)));
112 0           return $mp;
113             }
114              
115              
116             ##--------------------------------------------------------------
117             ## Profiling: Comparison (diff)
118              
119             ## $mprf = $cli->compare($relation, %opts)
120             ## + get a relation comparison profile for selected items as a DiaColloDB::Profile::MultiDiff object
121             ## + %opts: as for DiaColloDB::compare()
122             sub compare {
123 0     0 1   my $cli = shift;
124 0 0         $cli->logconfess($cli->{error}="compare(): no db opened!") if (!$cli->opened);
125 0           delete $cli->{error};
126 0 0         $cli->{error} = $cli->{db}{error} if (!defined(my $mp = $cli->{db}->compare(@_)));
127 0           return $mp;
128             }
129              
130             ##==============================================================================
131             ## Footer
132             1;
133              
134             __END__
135              
136              
137              
138