File Coverage

lib/Badger/Workplace.pm
Criterion Covered Total %
statement 21 26 80.7
branch 3 8 37.5
condition 4 12 33.3
subroutine 5 6 83.3
pod 4 5 80.0
total 37 57 64.9


line stmt bran cond sub pod time code
1             package Badger::Workplace;
2              
3             use Badger::Class
4 4         44 version => 0.01,
5             debug => 0,
6             base => 'Badger::Base',
7             import => 'class',
8             utils => 'Dir resolve_uri', # resolve_uri truelike falselike params self_params extend',
9             constants => 'SLASH',
10             accessors => 'root urn',
11             alias => {
12             directory => \&dir,
13 4     4   551 };
  4         10  
14              
15              
16             #-----------------------------------------------------------------------------
17             # Initialisation methods
18             #-----------------------------------------------------------------------------
19              
20             sub init {
21 1     1 1 5 my ($self, $config) = @_;
22 1         5 $self->init_workplace($config);
23 1         2 return $self;
24             }
25              
26             sub init_workplace {
27 1     1 0 4 my ($self, $config) = @_;
28              
29             # The mkdir flag is used to indicate the special case where the root
30             # directory (and perhaps other support files, data, etc) don't yet exist
31             # because some other bit of code is in the process of creating it anew.
32 1   50     7 my $mkdir = $config->{ mkdir } || 0;
33              
34             # The filespec can be specified to provide a hash of options for files
35 1   50     10 my $filespec = $config->{ filespec } || { };
36              
37             # The root directory must exist unless this is a neophyte in which case
38             # we can create the directory.
39             my $dir = $config->{ root }
40             || $config->{ dir }
41             || $config->{ directory }
42 1   0     11 || return $self->error_msg( missing => 'root directory' );
43 1         5 my $root = Dir($dir, $filespec);
44              
45 1 50       15 if (! $root->exists) {
46 0 0       0 if ($mkdir) {
47 0         0 $root->mkdir;
48             }
49             else {
50 0         0 return $self->error_msg( invalid => root => $dir );
51             }
52             }
53              
54 1         8 $self->{ root } = $root;
55 1   33     14 $self->{ urn } = $config->{ urn } // $root->name;
56 1   33     7 $self->{ uri } = $config->{ uri } // $self->{ urn };
57 1         3 $self->{ mkdir } = $mkdir;
58              
59 1         3 return $self;
60             }
61              
62             #-----------------------------------------------------------------------------
63             # Methods for accessing directories and files relative to the workplace root
64             #-----------------------------------------------------------------------------
65              
66             sub dir {
67 0     0 1 0 my $self = shift;
68             return @_
69 0 0       0 ? $self->root->dir(@_)
70             : $self->root;
71             }
72              
73             sub file {
74 1     1 1 2 my $self = shift;
75 1         15 return $self->root->file(@_);
76             }
77              
78             sub uri {
79 2     2 1 5 my $self = shift;
80             return @_
81             ? sprintf("%s%s", $self->{ uri }, resolve_uri(SLASH, @_))
82 2 100       26 : $self->{ uri };
83             }
84              
85             1;
86              
87             =head1 NAME
88              
89             Badger::Workplace - a place to do work
90              
91             =head1 DESCRIPTION
92              
93             This is a very simple base class for modules that operate on or around
94             a particular filesystem directory. See L for an
95             example of it in us.
96              
97             =head1 CONFIGURATION OPTIONS
98              
99             =head2 root / dir / directory
100              
101             Any of C, C or C can be provided to specify the root
102             directory of the workplace.
103              
104             =head2 urn
105              
106             This option can be set to define a Universal Resource Name (URN) for the
107             workplace for reference purposes. If undefined it defaults to the name of
108             the root directory.
109              
110             =head2 uri
111              
112             This option can be set to define a Universal Resource Identifier (URN) for the
113             workplace for reference purposes. If undefined it defaults to the name of
114             the value of L.
115              
116             =head2 mkdir
117              
118             The object constructor will fail if the root directory specified via L
119             (or C or C) does not exist. Alternately, set the C
120             option to any true value and the directory will be created automatically.
121              
122             =head1 METHODS
123              
124             =head2 dir($name) / directory($name)
125              
126             Returns a L object for a named sub-directory
127             relative to the workplace root.
128              
129             When called with any arguments it returns a L
130             object for the workplace root directory.
131              
132             =head2 file($name)
133              
134             Returns a L object for a named files
135             relative to the workplace root.
136              
137             =head2 uri($path)
138              
139             When called without any arguments this method returns the base URI for the
140             workspace.
141              
142             print $workspace->uri; # e.g. foo
143              
144             When called with a relative URI path as an argument, it returns the URI
145             resolved relative to the project base URI.
146              
147             print $workspace->uri('bar'); # e.g. foo/bar
148              
149             =head1 AUTHOR
150              
151             Andy Wardley L
152              
153             =head1 COPYRIGHT
154              
155             Copyright (C) 2008-2014 Andy Wardley. All Rights Reserved.
156              
157             This module is free software; you can redistribute it and/or modify it
158             under the same terms as Perl itself.
159              
160             =cut