[svn:p5ee] r14363 - p5ee/trunk/App-Options/lib/App

[spadkins]

Author: spadkins
Date: Mon Aug 30 14:37:21 2010
New Revision: 14363

Modified:
   p5ee/trunk/App-Options/lib/App/Options.pm

Log:
refactor some code to create the determine_app() method, which is used in 
App::Context::ModPerl

Modified: p5ee/trunk/App-Options/lib/App/Options.pm
==============================================================================
--- p5ee/trunk/App-Options/lib/App/Options.pm   (original)
+++ p5ee/trunk/App-Options/lib/App/Options.pm   Mon Aug 30 14:37:21 2010
@@ -532,7 +532,6 @@
     my $prefix_origin = "command line";
 
     # it can be set in environment.
-    # This is the preferred way for Registry and PerlRun webapps.
     if (!$prefix && $ENV{PREFIX}) {
         $prefix = $ENV{PREFIX};
         $prefix_origin = "environment";
@@ -572,28 +571,7 @@
     my $app = $values->{app};
     my $app_origin = "command line";
     if (!$app) {
-        my $path_info = $ENV{PATH_INFO} || "";
-        $path_info =~ s!/+$!!;    # strip off trailing slashes ("/")
-        if ($path_info && $path_info =~ m!^/([^/]+)!) {
-            my $path_info_app = $1;  # first part of PATH_INFO (without 
slashes)
-            if ($ENV{HOME} && -f "$ENV{HOME}/.app/$path_info_app.conf") {
-                $app = $path_info_app;
-                $app_origin = "PATH_INFO=$path_info matches 
$ENV{HOME}/.app/$path_info_app.conf";
-            }
-            elsif (-f "$prog_dir/$path_info_app.conf") {
-                $app = $path_info_app;
-                $app_origin = "PATH_INFO=$path_info matches 
$prog_dir/$path_info_app.conf";
-            }
-            elsif (-f "$prefix/etc/app/$path_info_app.conf") {
-                $app = $path_info_app;
-                $app_origin = "PATH_INFO=$path_info matches 
$prefix/etc/app/$path_info_app.conf";
-            }
-        }
-        if (!$app) {
-            $app = $prog_file;    # start with the full program name
-            $app =~ s/\.[^.]+$//; # strip off trailing file type (i.e. ".pl")
-            $app_origin = "program name ($0)";
-        }
+        ($app, $app_origin) = App::Options->determine_app($prefix, $prog_dir, 
$prog_file, $ENV{PATH_INFO}, $ENV{HOME});
         $values->{app} = $app;
     }
     print STDERR "4. Set app variable. app=[$app] origin=[$app_origin]\n" if 
($debug_options);
@@ -969,6 +947,40 @@
     }
 }
 
+# ($app, $app_origin) = App::Options->determine_app($prefix, $prog_dir, 
$prog_file, $ENV{PATH_INFO}, $ENV{HOME});
+sub determine_app {
+    my ($class, $prefix, $prog_dir, $prog_file, $path_info, $home_dir) = @_;
+    my ($app, $app_origin);
+    $path_info ||= "";
+    $path_info =~ s!/+$!!;    # strip off trailing slashes ("/")
+    if ($path_info && $path_info =~ m!^/([^/]+)!) {
+        my $path_info_app = $1;  # first part of PATH_INFO (without slashes)
+        if ($home_dir && -f "$home_dir/.app/$path_info_app.conf") {
+            $app = $path_info_app;
+            $app_origin = "PATH_INFO=$path_info matches 
$home_dir/.app/$path_info_app.conf";
+        }
+        elsif (-f "$prog_dir/$path_info_app.conf") {
+            $app = $path_info_app;
+            $app_origin = "PATH_INFO=$path_info matches 
$prog_dir/$path_info_app.conf";
+        }
+        elsif (-f "$prefix/etc/app/$path_info_app.conf") {
+            $app = $path_info_app;
+            $app_origin = "PATH_INFO=$path_info matches 
$prefix/etc/app/$path_info_app.conf";
+        }
+    }
+    if (!$app) {
+        $app = $prog_file;    # start with the full program name
+        $app =~ s/\.[^.]+$//; # strip off trailing file type (i.e. ".pl")
+        $app_origin = "program name ($0)";
+    }
+    if (wantarray) {
+        return($app, $app_origin);
+    }
+    else {
+        return($app);
+    }
+}
+
 sub print_usage {
     my ($self, $values, $init_args) = @_;
     $values = {} if (!$values);