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