1use warnings;
2use strict;
3
4package Jifty::Util;
5
6=head1 NAME
7
8Jifty::Util - Things that don't fit anywhere else
9
10=head1 DESCRIPTION
11
12
13=cut
14
15use Jifty ();
16use File::Spec ();
17use File::ShareDir ();
18use Cwd ();
19
20use vars qw/%ABSOLUTE_PATH $JIFTY_ROOT $SHARE_ROOT $APP_ROOT/;
21
22
23=head2 absolute_path PATH
24
25C<absolute_path> converts PATH into an absolute path, relative to the
26application's root (as determined by L</app_root>)  This can be called
27as an object or class method.
28
29=cut
30
31sub absolute_path {
32    my $self = shift;
33    my $path = shift || '';
34
35
36    return $ABSOLUTE_PATH{$path} if (exists $ABSOLUTE_PATH{$path});
37    $path = $self->canonicalize_path($path);
38    return $ABSOLUTE_PATH{$path} = File::Spec->rel2abs($path , Jifty::Util->app_root);
39}
40
41
42=head2 canonicalize_path PATH
43
44Takes a "path" style /foo/bar/baz and returns a canonicalized (but not necessarily absolute)
45version of the path.  Always use C</> as the separator, even on platforms which recognizes
46both C</> and C<\> as valid separators in PATH.
47
48=cut 
49
50sub canonicalize_path {
51    my $self = shift;
52    my $path = shift;
53    my $keepempty = shift;
54
55    my @path = File::Spec->splitdir($path);
56
57    my @newpath;
58
59    for (@path)  {
60        # If we have an empty part and it's not the root, skip it.
61        if ( @newpath and ($_ =~ /^(?:\.|)$/)) {
62            next;
63        }
64        elsif( $_ ne '..')  {
65            push @newpath, $_ ;
66        } else {
67            pop @newpath;
68        }
69    }
70
71    push @newpath, '' if $keepempty and @path and $path[-1] eq '';
72    return join("/",@newpath);
73}
74
75
76=head2 jifty_root
77
78Returns the root directory that Jifty has been installed into.
79Uses %INC to figure out where Jifty.pm is.
80
81=cut
82
83sub jifty_root {
84    my $self = shift;
85    unless ($JIFTY_ROOT) {
86        my ($vol,$dir,$file) = File::Spec->splitpath($INC{"Jifty.pm"});
87        $JIFTY_ROOT = File::Spec->rel2abs("$vol$dir");
88    }
89    return ($JIFTY_ROOT);
90}
91
92
93=head2 share_root
94
95Returns the 'share' directory of the installed Jifty module.  This is
96currently only used to store the common Mason components, CSS, and JS
97of Jifty and it's plugins.
98
99=cut
100
101sub share_root {
102    my $self = shift;
103    unless (defined $SHARE_ROOT) {
104        # Try for the local version, first
105        my @root = File::Spec->splitdir($self->jifty_root); # lib
106        pop @root; # Jifty-version
107        $SHARE_ROOT = File::Spec->catdir(@root,"share");
108        undef $SHARE_ROOT unless defined $SHARE_ROOT and -d $SHARE_ROOT and -d File::Spec->catdir($SHARE_ROOT,"web");
109
110        # If that doesn't pass inspection, try File::ShareDir::dist_dir
111        $SHARE_ROOT ||= eval { File::Spec->rel2abs( File::ShareDir::dist_dir('Jifty') )};
112        undef $SHARE_ROOT unless defined $SHARE_ROOT and -d $SHARE_ROOT and -d File::Spec->catdir($SHARE_ROOT,"web");
113    }
114
115    die "Can't locate Jifty share root!" unless defined $SHARE_ROOT;
116    return ($SHARE_ROOT);
117}
118
119=head2 app_root
120
121Returns the application's root path.  This is done by returning
122$ENV{'JIFTY_APP_ROOT'} if it exists.  If not, Jifty tries searching
123upward from the current directory, looking for a directory which
124contains a C<bin/jifty>.  Failing that, it searches upward from
125wherever the executable was found.
126
127It C<die>s if it can only find C</usr> or C</usr/local> which fit
128these criteria.
129
130=cut
131
132sub app_root {
133    my $self = shift;
134    my %args = @_;
135
136    return $ENV{'JIFTY_APP_ROOT'} if ($ENV{'JIFTY_APP_ROOT'});
137    return $APP_ROOT if ($APP_ROOT);
138
139    my @roots;
140
141    push( @roots, Cwd::cwd() );
142
143    eval { Jifty::Util->require('FindBin') };
144    if ( my $err = $@ ) {
145        #warn $@;
146    } else {
147        push @roots, $FindBin::Bin;
148    }
149
150    Jifty::Util->require('ExtUtils::MM') if $^O =~ /(?:MSWin32|cygwin|os2)/;
151    Jifty::Util->require('Config');
152    for my $root_path (@roots) {
153        my ($volume, $dirs) = File::Spec->splitpath($root_path, 'no_file');
154        my @root = File::Spec->splitdir($dirs);
155        while (@root) {
156            my $try = File::Spec->catpath($volume, File::Spec->catdir( @root, "bin", "jifty" ), '');
157            if (# XXX: Just a quick hack
158                # MSWin32's 'maybe_command' sees only file extension.
159                # Maybe we should check 'jifty.bat' instead on Win32,
160                # if it is (or would be) provided.
161                # Also, /usr/bin or /usr/local/bin should be taken from
162                # %Config{bin} or %Config{scriptdir} or something like that
163                # for portablility.
164                # Note that to compare files in Win32 we have to ignore the case
165                (-e $try or (($^O =~ /(?:MSWin32|cygwin|os2)/) and MM->maybe_command($try)))
166                and lc($try) ne lc(File::Spec->catdir($Config::Config{bin}, "jifty"))
167                and lc($try) ne lc(File::Spec->catdir($Config::Config{scriptdir}, "jifty")) )
168            {
169                return $APP_ROOT = File::Spec->catpath($volume, File::Spec->catdir(@root), '');
170            }
171            pop @root;
172        }
173    }
174    warn "Can't guess application root from current path ("
175        . Cwd::cwd()
176        . ") or bin path ($FindBin::Bin)\n" unless $args{quiet};
177    return ''; # returning undef causes tons of 'uninitialized...' warnings.
178}
179
180=head2 is_app_root PATH
181
182Returns a boolean indicating whether the path passed in is the same path as
183the app root. Useful if you're recursing up a directory tree and want to
184stop when you've hit the root. It does not attempt to handle symbolic links.
185
186=cut
187
188sub is_app_root
189{
190    my $self = shift;
191    my $path = shift;
192    my $app_root = $self->app_root;
193
194    my $rel = File::Spec->abs2rel( $path, $app_root );
195
196    return $rel eq File::Spec->curdir;
197}
198
199=head2 default_app_name
200
201Returns the default name of the application.  This is the name of the
202application's root directory, as defined by L</app_root>.
203
204=cut
205
206sub default_app_name {
207    my $self = shift;
208    my @root = File::Spec->splitdir( Jifty::Util->app_root);
209    my $name =  pop @root;
210
211    # Jifty-0.10211 should become Jifty
212    $name = $1 if $name =~ /^(.*?)-(.*\..*)$/;
213
214    # But don't actually allow "Jifty" as the name
215    $name = "JiftyApp" if lc $name eq "jifty";
216
217    return $name;
218}
219
220=head2 make_path PATH
221
222When handed a directory, creates that directory, starting as far up the
223chain as necessary. (This is what 'mkdir -p' does in your shell).
224
225=cut
226
227sub make_path {
228    my $self = shift;
229    my $whole_path = shift;
230    return 1 if (-d $whole_path);
231    Jifty::Util->require('File::Path');
232
233    local $@;
234    eval { File::Path::mkpath([$whole_path]) };
235
236    if ($@) {
237        Jifty->log->fatal("Unable to make path: $whole_path: $@")
238    }
239}
240
241=head2 require PATH
242
243Uses L<UNIVERSAL::require> to require the provided C<PATH>.
244Additionally, logs any failures at the C<error> log level.
245
246=cut
247
248sub require {
249    my $self = shift;
250    my $module = shift;
251    $self->_require( module => $module,  quiet => 0);
252}
253
254sub _require {
255    my $self = shift;
256    my %args = ( module => undef, quiet => undef, @_);
257    my $class = $args{'module'};
258
259    # Quick hack to silence warnings.
260    # Maybe some dependencies were lost.
261    unless ($class) {
262        Jifty->log->error(sprintf("no class was given at %s line %d\n", (caller)[1,2]));
263        return 0;
264    }
265
266    return 1 if $self->already_required($class);
267
268    # .pm might already be there in a weird interaction in Module::Pluggable
269    my $file = $class;
270    $file .= ".pm"
271        unless $file =~ /\.pm$/;
272
273    $file =~ s/::/\//g;
274
275    my $retval = eval  {CORE::require "$file"} ;
276    my $error = $@;
277    if (my $message = $error) {
278        $message =~ s/ at .*?\n$//;
279        if ($args{'quiet'} and $message =~ /^Can't locate $file/) {
280            return 0;
281        }
282        elsif ( $error !~ /^Can't locate $file/) {
283            die $error;
284        } else {
285            Jifty->log->error(sprintf("$message at %s line %d\n", (caller(1))[1,2]));
286            return 0;
287        }
288    }
289
290    # If people forget the '1;' line in the dispatcher, don't eit them
291    if ($class =~ /::Dispatcher$/ and ref $retval eq "ARRAY") {
292        Jifty->log->error("$class did not return a true value; assuming it was a dispatcher rule");
293        Jifty::Dispatcher::_push_rule($class, $_) for @{$retval};
294    }
295
296    return 1;
297}
298
299=head2 try_to_require Module
300
301This method works just like L</require>, except that it suppresses the error message
302in cases where the module isn't found.
303
304=cut
305
306sub  try_to_require {
307    my $self = shift;
308    my $module = shift;
309    $self->_require( module => $module,  quiet => 1);
310}
311
312
313=head2 already_required class
314
315Helper function to test whether a given class has already been loaded.
316
317=cut
318
319sub already_required {
320    my ($self, $class) = @_;
321    $class =~ s{::}{/}g;
322    return ( $INC{"$class.pm"} ? 1 : 0);
323}
324
325=head2 generate_uuid
326
327Generate a new UUID using B<Data::UUID>.
328
329=cut
330
331my $Data_UUID_instance;
332sub generate_uuid {
333    ($Data_UUID_instance ||= do {
334        require Data::UUID;
335        Data::UUID->new;
336    })->create_str;
337}
338
339=head2 reference_to_data Object
340
341Provides a saner output format for models than
342C<MyApp::Model::Foo=HASH(0x1800568)>.
343
344=cut
345
346sub reference_to_data {
347    my ($self, $obj) = @_;
348    (my $model = ref($obj)) =~ s/::/./g;
349    my $id = $obj->id;
350
351    # probably a file extension, from the REST rewrite
352    my $extension = '';
353    if (Jifty->web->request &&
354        Jifty->web->request->env->{HTTP_ACCEPT} =~ m/^\w+$/) {
355        $extension = '.'.Jifty->web->request->env->{HTTP_ACCEPT};
356    }
357
358    return {
359        jifty_model_reference => 1,
360        id                    => $obj->id,
361        model                 => $model,
362        url                   => Jifty->web->url(path => "/=/model/$model/id/$id$extension"),
363    };
364}
365
366=head2 stringify LIST
367
368Takes a list of values and forces them into strings.  Right now all it does
369is concatenate them to an empty string, but future versions might be more
370magical.
371
372=cut
373
374sub stringify {
375    my $self = shift;
376
377    my @r;
378
379    for (@_) {
380        if (UNIVERSAL::isa($_, 'Jifty::Record')) {
381            push @r, Jifty::Util->reference_to_data($_);
382        }
383        if (UNIVERSAL::isa($_, 'Jifty::DateTime') && $_->is_date) {
384            push @r, $_->ymd;
385        }
386        elsif (defined $_) {
387            push @r, '' . $_; # force stringification
388        }
389        else {
390            push @r, undef;
391        }
392    }
393
394    return wantarray ? @r : $r[-1];
395}
396
397=head1 AUTHOR
398
399Various folks at Best Practical Solutions, LLC.
400
401=cut
402
4031;
404