diff options
Diffstat (limited to 'perllib')
| -rw-r--r-- | perllib/Carp/Always.pm | 162 | ||||
| -rw-r--r-- | perllib/FixMyStreet.pm | 65 | ||||
| -rw-r--r-- | perllib/FixMyStreet/App.pm | 123 | ||||
| -rw-r--r-- | perllib/FixMyStreet/App/Controller/About.pm | 31 | ||||
| -rw-r--r-- | perllib/FixMyStreet/App/Controller/Root.pm | 80 | ||||
| -rw-r--r-- | perllib/FixMyStreet/App/View/Web.pm | 45 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Cobrand.pm | 71 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Cobrand/Barnet.pm | 79 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Cobrand/Default.pm | 510 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Cobrand/EmptyHomes.pm | 70 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Cobrand/FiksGataMi.pm | 38 | ||||
| -rw-r--r-- | perllib/Problems.pm | 10 | ||||
| -rw-r--r-- | perllib/local/lib.pm | 844 |
13 files changed, 1966 insertions, 162 deletions
diff --git a/perllib/Carp/Always.pm b/perllib/Carp/Always.pm deleted file mode 100644 index 68bcaee52..000000000 --- a/perllib/Carp/Always.pm +++ /dev/null @@ -1,162 +0,0 @@ - -package Carp::Always; - -use 5.006; -use strict; -use warnings; - -our $VERSION = '0.09'; - -use Carp qw(verbose); # makes carp() cluck and croak() confess - -sub _warn { - if ($_[-1] =~ /\n$/s) { - my $arg = pop @_; - $arg =~ s/ at .*? line .*?\n$//s; - push @_, $arg; - } - warn &Carp::longmess; -} - -sub _die { - if ($_[-1] =~ /\n$/s) { - my $arg = pop @_; - $arg =~ s/ at .*? line .*?\n$//s; - push @_, $arg; - } - die &Carp::longmess; -} - -my %OLD_SIG; - -BEGIN { - @OLD_SIG{qw(__DIE__ __WARN__)} = @SIG{qw(__DIE__ __WARN__)}; - $SIG{__DIE__} = \&_die; - $SIG{__WARN__} = \&_warn; -} - -END { - @SIG{qw(__DIE__ __WARN__)} = @OLD_SIG{qw(__DIE__ __WARN__)}; -} - -1; -__END__ - -=head1 NAME - -Carp::Always - Warns and dies noisily with stack backtraces - -=head1 SYNOPSIS - - use Carp::Always; - -makes every C<warn()> and C<die()> complains loudly in the calling package -and elsewhere. More often used on the command line: - - perl -MCarp::Always script.pl - -=head1 DESCRIPTION - -This module is meant as a debugging aid. It can be -used to make a script complain loudly with stack backtraces -when warn()ing or die()ing. - -Here are how stack backtraces produced by this module -looks: - - # it works for explicit die's and warn's - $ perl -MCarp::Always -e 'sub f { die "arghh" }; sub g { f }; g' - arghh at -e line 1 - main::f() called at -e line 1 - main::g() called at -e line 1 - - # it works for interpreter-thrown failures - $ perl -MCarp::Always -w -e 'sub f { $a = shift; @a = @$a };' \ - -e 'sub g { f(undef) }; g' - Use of uninitialized value in array dereference at -e line 1 - main::f('undef') called at -e line 2 - main::g() called at -e line 2 - -In the implementation, the C<Carp> module does -the heavy work, through C<longmess()>. The -actual implementation sets the signal hooks -C<$SIG{__WARN__}> and C<$SIG{__DIE__}> to -emit the stack backtraces. - -Oh, by the way, C<carp> and C<croak> when requiring/using -the C<Carp> module are also made verbose, behaving -like C<cloak> and C<confess>, respectively. - -=head2 EXPORT - -Nothing at all is exported. - -=head1 ACKNOWLEDGMENTS - -This module was born as a reaction to a release -of L<Acme::JavaTrace> by Sébastien Aperghis-Tramoni. -Sébastien also has a newer module called -L<Devel::SimpleTrace> with the same code and fewer flame -comments on docs. The pruning of the uselessly long -docs of this module were prodded by Michael Schwern. - -Schwern and others told me "the module name stinked" - -it was called C<Carp::Indeed>. After thinking long -and not getting nowhere, I went with nuffin's suggestion -and now it is called C<Carp::Always>. -C<Carp::Indeed> which is now deprecate -lives in its own distribution (which won't go anywhere -but will stay there as a redirection to this module). - -=head1 SEE ALSO - -=over 4 - -=item * - -L<Carp> - -=item * - -L<Acme::JavaTrace> and L<Devel::SimpleTrace> - -=back - -Please report bugs via CPAN RT -http://rt.cpan.org/NoAuth/Bugs.html?Dist=Carp-Always. - -=head1 BUGS - -Every (un)deserving module has its own pet bugs. - -=over 4 - -=item * - -This module does not play well with other modules which fusses -around with C<warn>, C<die>, C<$SIG{'__WARN__'}>, -C<$SIG{'__DIE__'}>. - -=item * - -Test scripts are good. I should write more of these. - -=item * - -I don't know if this module name is still a bug as it was -at the time of C<Carp::Indeed>. - -=back - -=head1 AUTHOR - -Adriano Ferreira, E<lt>ferreira@cpan.orgE<gt> - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2005-2007 by Adriano R. Ferreira - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut diff --git a/perllib/FixMyStreet.pm b/perllib/FixMyStreet.pm new file mode 100644 index 000000000..daa9de334 --- /dev/null +++ b/perllib/FixMyStreet.pm @@ -0,0 +1,65 @@ +package FixMyStreet; + +use strict; +use warnings; + +use Path::Class; +my $ROOT_DIR = file(__FILE__)->parent->parent->absolute->resolve; + +use Readonly; + +use mySociety::Config; + +# load the config file and store the contents in a readonly hash +mySociety::Config::set_file( __PACKAGE__->path_to("conf/general") ); +Readonly::Hash my %CONFIG, %{ mySociety::Config::get_list() }; + +=head1 NAME + +FixMyStreet + +=head1 DESCRIPTION + +FixMyStreet is a webite where you can report issues and have them routed to the +correct authority so that they can be fixed. + +Thus module has utility functions for the FMS project. + +=head1 METHODS + +=head2 path_to + + $path = FixMyStreet->path_to( 'conf/general' ); + +Returns an absolute Path::Class object representing the path to the arguments in +the FixMyStreet directory. + +=cut + +sub path_to { + my $class = shift; + return $ROOT_DIR->file(@_); +} + +=head2 config + + my $config_hash_ref = FixMyStreet->config(); + my $config_value = FixMyStreet->config($key); + +Returns a hashref to the config values. This is readonly so any attempt to +change it will fail. + +Or you can pass it a key and it will return the value for that key, or undef if +it can't find it. + +=cut + +sub config { + my $class = shift; + return \%CONFIG unless scalar @_; + + my $key = shift; + return exists $CONFIG{$key} ? $CONFIG{$key} : undef; +} + +1; diff --git a/perllib/FixMyStreet/App.pm b/perllib/FixMyStreet/App.pm new file mode 100644 index 000000000..bc9bd7672 --- /dev/null +++ b/perllib/FixMyStreet/App.pm @@ -0,0 +1,123 @@ +package FixMyStreet::App; +use Moose; +use namespace::autoclean; + +use Catalyst::Runtime 5.80; +use FixMyStreet; +use FixMyStreet::Cobrand; +use Memcached; +use Problems; + +use Catalyst qw/ + ConfigLoader + Static::Simple + /; + +extends 'Catalyst'; + +our $VERSION = '0.01'; + +# Configure the application. +# +# Note that settings in fixmystreet_app.conf (or other external +# configuration file that you set up manually) take precedence +# over this when using ConfigLoader. Thus configuration +# details given here can function as a default configuration, +# with an external configuration file acting as an override for +# local deployment. + +__PACKAGE__->config( + + # get the config from the core object + %{ FixMyStreet->config() }, + + name => 'FixMyStreet::App', + + # Disable deprecated behavior needed by old applications + disable_component_resolution_regex_fallback => 1, + + # Serve anything in web dir that is not a .cgi script + static => { # + include_path => [ FixMyStreet->path_to("web") . "" ], + ignore_extensions => ['cgi'], + } +); + +# Start the application +__PACKAGE__->setup(); + +=head1 NAME + +FixMyStreet::App - Catalyst based application + +=head1 SYNOPSIS + + script/fixmystreet_app_server.pl + +=head1 DESCRIPTION + +FixMyStreet.com codebase + +=head1 METHODS + +=head2 cobrand + + $cobrand = $c->cobrand(); + +Returns the cobrand object. If not already determined this request finds it and +caches it to the stash. + +=cut + +sub cobrand { + my $c = shift; + return $c->stash->{cobrand} ||= $c->_get_cobrand(); +} + +sub _get_cobrand { + my $c = shift; + my $host = $c->req->uri->host; + my $cobrand_class = FixMyStreet::Cobrand->get_class_for_host($host); + return $cobrand_class->new( { request => $c->req } ); +} + +=head2 setup_cobrand + + $cobrand = $c->setup_cobrand(); + +Work out which cobrand we should be using. Set the environment correctly - eg +template paths + +=cut + +sub setup_cobrand { + my $c = shift; + my $cobrand = $c->cobrand; + + # append the cobrand templates to the include path + $c->stash->{additional_template_paths} = + [ $cobrand->path_to_web_templates . '' ]; + + my $host = $c->req->uri->host; + my $lang = + $host =~ /^en\./ ? 'en-gb' + : $host =~ /cy/ ? 'cy' + : undef; + + # set the language and the translation file to use + $cobrand->set_lang_and_domain( $lang, 1 ); + + Problems::set_site_restriction_with_cobrand_object($cobrand); + + Memcached::set_namespace( FixMyStreet->config('BCI_DB_NAME') . ":" ); + + return $cobrand; +} + +=head1 SEE ALSO + +L<FixMyStreet::App::Controller::Root>, L<Catalyst> + +=cut + +1; diff --git a/perllib/FixMyStreet/App/Controller/About.pm b/perllib/FixMyStreet/App/Controller/About.pm new file mode 100644 index 000000000..42a0ed18e --- /dev/null +++ b/perllib/FixMyStreet/App/Controller/About.pm @@ -0,0 +1,31 @@ +package FixMyStreet::App::Controller::About; +use Moose; +use namespace::autoclean; + +BEGIN { extends 'Catalyst::Controller'; } + +=head1 NAME + +FixMyStreet::App::Controller::About - Catalyst Controller + +=head1 DESCRIPTION + +Catalyst Controller. + +=head1 METHODS + +=cut + +=head2 index + +=cut + +sub index : Path : Args(0) { + my ( $self, $c ) = @_; + + # don't need to do anything here - should just pass through. +} + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/perllib/FixMyStreet/App/Controller/Root.pm b/perllib/FixMyStreet/App/Controller/Root.pm new file mode 100644 index 000000000..42ac856c6 --- /dev/null +++ b/perllib/FixMyStreet/App/Controller/Root.pm @@ -0,0 +1,80 @@ +package FixMyStreet::App::Controller::Root; +use Moose; +use namespace::autoclean; + +BEGIN { extends 'Catalyst::Controller' } + +__PACKAGE__->config( namespace => '' ); + +=head1 NAME + +FixMyStreet::App::Controller::Root - Root Controller for FixMyStreet::App + +=head1 DESCRIPTION + +[enter your description here] + +=head1 METHODS + +=head2 auto + +Set up general things for this instance + +=cut + +sub auto : Private { + my ( $self, $c ) = @_; + + # decide which cobrand this request should use + $c->setup_cobrand(); + + return 1; +} + +=head2 index + +=cut + +sub index : Path : Args(0) { + my ( $self, $c ) = @_; + $c->res->body('index'); +} + +=head2 default + +Forward to the standard 404 error page + +=cut + +sub default : Path { + my ( $self, $c ) = @_; + $c->detach('/page_not_found'); +} + +=head2 page_not_found + + $c->detach('/page_not_found'); + +Display a 404 page. + +=cut + +sub page_not_found : Private { + my ( $self, $c ) = @_; + + $c->stash->{template} = 'errors/page_not_found.html'; + $c->response->status(404); +} + +=head2 end + +Attempt to render a view, if needed. + +=cut + +sub end : ActionClass('RenderView') { +} + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/perllib/FixMyStreet/App/View/Web.pm b/perllib/FixMyStreet/App/View/Web.pm new file mode 100644 index 000000000..306e4c5a7 --- /dev/null +++ b/perllib/FixMyStreet/App/View/Web.pm @@ -0,0 +1,45 @@ +package FixMyStreet::App::View::Web; +use base 'Catalyst::View::TT'; + +use strict; +use warnings; + +use mySociety::Locale; +use FixMyStreet; + +__PACKAGE__->config( + TEMPLATE_EXTENSION => '.html', + INCLUDE_PATH => [ # + FixMyStreet->path_to( 'templates', 'web', 'default' ), + ], + render_die => 1, + expose_methods => ['loc'], +); + +=head1 NAME + +FixMyStreet::App::View::Web - TT View for FixMyStreet::App + +=head1 DESCRIPTION + +TT View for FixMyStreet::App. + +=cut + +=head2 loc + + [% loc('Some text to localize') %] + +Passes the text to the localisation engine for translations. + +FIXME - currently just passes through. + +=cut + +sub loc { + my ( $self, $c, @args ) = @_; + return _(@args); +} + +1; + diff --git a/perllib/FixMyStreet/Cobrand.pm b/perllib/FixMyStreet/Cobrand.pm new file mode 100644 index 000000000..91155db6e --- /dev/null +++ b/perllib/FixMyStreet/Cobrand.pm @@ -0,0 +1,71 @@ +# Copyright (c) 2009 UK Citizens Online Democracy. All rights reserved. +# Email: evdb@mysociety.org. WWW: http://www.mysociety.org + +package FixMyStreet::Cobrand; + +use strict; +use warnings; + +use FixMyStreet; +use Carp; + +use Module::Pluggable + sub_name => '_cobrands', + search_path => ['FixMyStreet::Cobrand'], + require => 1; + +my @ALL_COBRAND_CLASSES = __PACKAGE__->_cobrands; + +=head2 get_allowed_cobrands + +Return an array reference of allowed cobrand subdomains + +=cut + +sub get_allowed_cobrands { + my $allowed_cobrand_string = FixMyStreet->config('ALLOWED_COBRANDS'); + my @allowed_cobrands = split( /\|/, $allowed_cobrand_string ); + return \@allowed_cobrands; +} + +=head2 available_cobrand_classes + + @available_cobrand_classes = + FixMyStreet::Cobrand->available_cobrand_classes(); + +Return an array of all the classes that were found and that have monikers that +match the values from get_allowed_cobrands. + +=cut + +sub available_cobrand_classes { + my $class = shift; + + my %allowed = map { $_ => 1 } @{ $class->get_allowed_cobrands }; + my @avail = grep { $allowed{ $_->moniker } } @ALL_COBRAND_CLASSES; + + return @avail; +} + +=head2 get_class_for_host + + $cobrand_class = FixMyStreet::Cobrand->get_class_for_host( $host ); + +Given a host determine which cobrand we should be using. + +=cut + +sub get_class_for_host { + my $class = shift; + my $host = shift; + + foreach my $avail ( $class->available_cobrand_classes ) { + my $moniker = $avail->moniker; + return $avail if $host =~ m{$moniker}; + } + + # if none match then use the default + return 'FixMyStreet::Cobrand::Default'; +} + +1; diff --git a/perllib/FixMyStreet/Cobrand/Barnet.pm b/perllib/FixMyStreet/Cobrand/Barnet.pm new file mode 100644 index 000000000..7f8638c21 --- /dev/null +++ b/perllib/FixMyStreet/Cobrand/Barnet.pm @@ -0,0 +1,79 @@ +package FixMyStreet::Cobrand::Barnet; +use base 'FixMyStreet::Cobrand::Default'; + +use strict; +use warnings; + +use Carp; +use URI::Escape; +use mySociety::VotingArea; + +sub site_restriction { + return ( "and council='2489'", 'barnet' ); +} + +sub base_url { + my $base_url = mySociety::Config::get('BASE_URL'); + if ( $base_url !~ /barnet/ ) { + $base_url =~ s{http://(?!www\.)}{http://barnet.}g; + $base_url =~ s{http://www\.}{http://barnet.}g; + } + return $base_url; +} + +sub site_title { + my ($self) = @_; + return 'Barnet Council FixMyStreet'; +} + +sub enter_postcode_text { + my ( $self ) = @_; + return 'Enter a Barnet postcode, or street name and area:'; +} + +sub council_check { + my ( $self, $params, $q, $context ) = @_; + my $councils; + if ( $params->{all_councils} ) { + $councils = $params->{all_councils}; + } + elsif ( defined $params->{lat} ) { + my $parent_types = $mySociety::VotingArea::council_parent_types; + $councils = mySociety::MaPit::call( + 'point', + "4326/$params->{lon},$params->{lat}", + type => $parent_types + ); + } + my $council_match = defined $councils->{2489}; + if ($council_match) { + return 1; + } + my $url = 'http://www.fixmystreet.com/'; + $url .= 'alert' if $context eq 'alert'; + $url .= '?pc=' . URI::Escape::uri_escape( $q->param('pc') ) + if $q->param('pc'); + my $error_msg = "That location is not covered by Barnet. +Please visit <a href=\"$url\">the main FixMyStreet site</a>."; + return ( 0, $error_msg ); +} + +# All reports page only has the one council. +sub all_councils_report { + return 0; +} + +sub disambiguate_location { + my ( $self, $s, $q ) = @_; + $s = "ll=51.612832,-0.218169&spn=0.0563,0.09&$s"; + return $s; +} + +sub recent_photos { + my ( $self, $num, $lat, $lon, $dist ) = @_; + $num = 2 if $num == 3; + return Problems::recent_photos( $num, $lat, $lon, $dist ); +} + +1; + diff --git a/perllib/FixMyStreet/Cobrand/Default.pm b/perllib/FixMyStreet/Cobrand/Default.pm new file mode 100644 index 000000000..608a754f7 --- /dev/null +++ b/perllib/FixMyStreet/Cobrand/Default.pm @@ -0,0 +1,510 @@ +package FixMyStreet::Cobrand::Default; + +use strict; +use warnings; +use FixMyStreet; + +use Carp; + +=head2 new + + my $cobrand = $class->new; + my $cobrand = $class->new( { request => $c->req } ); + +Create a new cobrand object, optionally setting the web request. + +You probably shouldn't need to do this and should get the cobrand object via a +method in L<FixMyStreet::Cobrand> instead. + +=cut + +sub new { + my $class = shift; + my $self = shift || {}; + return bless $self, $class; +} + +=head2 moniker + + $moniker = $cobrand_class->moniker(); + +Returns a moniker that can be used to identify this cobrand. By default this is +the last part of the class name lowercased - eg 'F::C::SomeCobrand' becomes +'somecobrand'. + +=cut + +sub moniker { + my $class = ref( $_[0] ) || $_[0]; # deal with object or class + my ($last_part) = $class =~ m{::(\w+)$}; + return lc($last_part); +} + +=head2 q + + $request = $cobrand->q; + +Often the cobrand needs access to the request so we add it at the start by +passing it to ->new. If the request has not been set and you call this (or a +method that needs it) then it croaks. This is probably because you are trying to +use a request-related method out of a request-context. + +=cut + +sub q { + my $self = shift; + return $self->{request} + || croak "No request has been set" + . " - should you be calling this method outside of a web request?"; +} + +=head2 path_to_web_templates + + $path = $cobrand->path_to_web_templates( ); + +Returns the path to the templates for this cobrand - by default +"templates/web/$moniker" + +=cut + +sub path_to_web_templates { + my $self = shift; + return FixMyStreet->path_to( 'templates/web', $self->moniker ); +} + +=head1 site_restriction + +Return a site restriction clause and a site key if the cobrand uses a subset of +the FixMyStreet data. Parameter is any extra data the cobrand needs. Returns an +empty string and site key 0 if the cobrand uses all the data. + +=cut + +sub site_restriction { return ( "", 0 ) } + +=head2 contact_restriction + +Return a contact restriction clause if the cobrand uses a subset of the +FixMyStreet contact data. + +=cut + +sub contact_restriction { + ''; +} + +=head2 base_url_for_emails + +Return the base url to use in links in emails for the cobranded version of the +site, parameter is extra data. + +=cut + +sub base_url_for_emails { + my $self = shift; + return $self->base_url; +} + +=head2 admin_base_url + +Base URL for the admin interface. + +=cut + +sub admin_base_url { 0 } + +=head2 writetothem_url + +URL for writetothem; parameter is COBRAND_DATA. + +=cut + +sub writetothem_url { 0 } + +=head2 base_url + +Return the base url for the cobranded version of the site + +=cut + +sub base_url { mySociety::Config::get('BASE_URL') } + +=head2 enter_postcode_text + +Return the text that prompts the user to enter their postcode/place name. +Parameter is QUERY + +=cut + +sub enter_postcode_text { '' } + +=head2 set_lang_and_domain + + $cobrand->set_lang_and_domain( $lang, $unicode ) + +Set the language and domain of the site based on the cobrand and host. + +=cut + +sub set_lang_and_domain { + my ( $self, $lang, $unicode ) = @_; + mySociety::Locale::negotiate_language( + 'en-gb,English,en_GB|nb,Norwegian,nb_NO', $lang ); # XXX Testing + mySociety::Locale::gettext_domain( 'FixMyStreet', $unicode ); + mySociety::Locale::change(); +} + +=head2 alert_list_options + +Return HTML for a list of alert options for the cobrand, given QUERY and +OPTIONS. + +=cut + +sub alert_list_options { 0 } + +=head2 recent_photos + +Return N recent photos. If EASTING, NORTHING and DISTANCE are supplied, the +photos must be attached to problems within DISTANCE of the point defined by +EASTING and NORTHING. + +=cut + +sub recent_photos { + my $self = shift; + return Problems::recent_photos(@_); +} + +=head2 recent + +Return recent problems on the site. + +=cut + +sub recent { + my $self = shift; + return Problems::recent(@_); +} + +=head2 front_stats + +Given a QUERY, return a block of html for showing front stats for the site + +=cut + +sub front_stats { + my $self = shift; + return Problems::front_stats(@_); +} + +=head2 disambiguate_location + +Given a STRING ($_[1]) representing a location and a QUERY, return a string that +includes any disambiguating information available + +=cut + +sub disambiguate_location { "$_[1]&gl=uk" } + +=head2 prettify_epoch + +Parameter is EPOCHTIME + +=cut + +sub prettify_epoch { 0 } + +=head2 form_elements + +Parameters are FORM_NAME, QUERY. Return HTML for any extra needed elements for +FORM_NAME + +=cut + +sub form_elements { '' } + +=head2 cobrand_data_for_generic_update + +Parameter is UPDATE_DATA, a reference to a hash of non-cobranded update data. +Return cobrand extra data for the update + +=cut + +sub cobrand_data_for_generic_update { '' } + +=head2 cobrand_data_for_generic_update + +Parameter is PROBLEM_DATA, a reference to a hash of non-cobranded problem data. +Return cobrand extra data for the problem + +=cut + +sub cobrand_data_for_generic_problem { '' } + +=head2 extra_problem_data + +Parameter is QUERY. Return a string of extra data to be stored with a problem + +=cut + +sub extra_problem_data { '' } + +=head2 extra_update_data + +Parameter is QUERY. Return a string of extra data to be stored with an update + +=cut + +sub extra_update_data { '' } + +=head2 extra_alert_data + +Parameter is QUERY. Return a string of extra data to be stored with an alert + +=cut + +sub extra_alert_data { '' } + +=head2 extra_data + +Given a QUERY, extract any extra data required by the cobrand + +=cut + +sub extra_data { '' } + +=head2 extra_params + +Given a QUERY, return a hash of extra params to be included in any URLs in links +produced on the page returned by that query. + +=cut + +sub extra_params { '' } + +=head2 extra_problem_meta_text + +Returns any extra text to be displayed with a PROBLEM. + +=cut + +sub extra_problem_meta_text { '' } + +=head2 extra_update_meta_text + +Returns any extra text to be displayed with an UPDATE. + +=cut + +sub extra_update_meta_text { '' } + +=head2 url + +Given a URL ($_[1]), QUERY, EXTRA_DATA, return a URL with any extra params +needed appended to it. + +=cut + +sub url { $_[1] } + +=head2 header_params + +Return any params to be added to responses + +=cut + +sub header_params { return {} } + +=head2 root_path_js + +Parameter is QUERY. Return some js to set the root path from which AJAX queries +should be made. + +=cut + +sub root_path_js { 'var root_path = "";' } + +=head2 site_title + +Return the title to be used in page heads. + +=cut + +sub site_title { '' } + +=head2 on_map_list_limit + +Return the maximum number of items to be given in the list of reports on the map + +=cut + +sub on_map_list_limit { return undef; } + +=head2 allow_photo_upload + +Return a boolean indicating whether the cobrand allows photo uploads + +=cut + +sub allow_photo_upload { return 1; } + +=head2 allow_crosssell_adverts + +Return a boolean indicating whether the cobrand allows the display of crosssell +adverts + +=cut + +sub allow_crosssell_adverts { return 1; } + +=head2 allow_photo_display + +Return a boolean indicating whether the cobrand allows photo display + +=cut + +sub allow_photo_display { return 1; } + +=head2 allow_update_reporting + +Return a boolean indication whether users should see links next to updates +allowing them to report them as offensive. + +=cut + +sub allow_update_reporting { return 0; } + +=head2 geocoded_string_check + +Parameters are LOCATION, QUERY. Return a boolean indicating whether the +string LOCATION passes the cobrands checks. + +=cut + +sub geocoded_string_check { return 1; } + +=head2 council_check + +Paramters are COUNCILS, QUERY, CONTEXT. Return a boolean indicating whether +COUNCILS pass any extra checks. CONTEXT is where we are on the site. + +=cut + +sub council_check { return ( 1, '' ); } + +=head2 feed_xsl + +Return an XSL to be used in rendering feeds + +=cut + +sub feed_xsl { '/xsl.xsl' } + +=head2 all_councils_report + +Return a boolean indicating whether the cobrand displays a report of all +councils + +=cut + +sub all_councils_report { 1 } + +=head2 ask_ever_reported + +Return a boolean indicating whether people should be asked whether this is the +first time they' ve reported a problem + +=cut + +sub ask_ever_reported { 1 } + +=head2 admin_pages + +List of names of pages to display on the admin interface + +=cut + +sub admin_pages { 0 } + +=head2 admin_show_creation_graph + +Show the problem creation graph in the admin interface +=cut + +sub admin_show_creation_graph { 1 } + +=head2 area_types, area_min_generation + +The MaPit types this site handles + +=cut + +sub area_types { return qw(DIS LBO MTD UTA CTY COI); } +sub area_min_generation { 10 } + +=head2 contact_name, contact_email + +Return the contact name or email for the cobranded version of the site (to be +used in emails). + +=cut + +sub contact_name { $_[0]->get_cobrand_conf('CONTACT_NAME') } +sub contact_email { $_[0]->get_cobrand_conf('CONTACT_EMAIL') } + +=head2 get_cobrand_conf COBRAND KEY + +Get the value for KEY from the config file for COBRAND + +=cut + +sub get_cobrand_conf { + my ( $self, $key ) = @_; + my $value = undef; + my $cobrand_moniker = $self->moniker; + + my $cobrand_config_file = + FixMyStreet->path_to("conf/cobrands/$cobrand_moniker/general"); + my $normal_config_file = FixMyStreet->path_to('conf/general'); + + if ( -e $cobrand_config_file ) { + + # FIXME - don't rely on the config file name - should + # change mySociety::Config so that it can return values from a + # particular config file instead + mySociety::Config::set_file("$cobrand_config_file"); + my $config_key = $key . "_" . uc($cobrand_moniker); + $value = mySociety::Config::get( $config_key, undef ); + mySociety::Config::set_file("$normal_config_file"); + } + + # If we didn't find a value use one from normal config + if ( !defined($value) ) { + $value = mySociety::Config::get($key); + } + + return $value; +} + +=item email_host + +Return if we are the virtual host that sends email for this cobrand + +=cut + +sub email_host { + my $self = shift; + my $cobrand_moniker_uc = uc( $self->moniker ); + + my $email_vhost = + mySociety::Config::get("EMAIL_VHOST_$cobrand_moniker_uc") + || mySociety::Config::get("EMAIL_VHOST") + || ''; + + return $email_vhost + && "http://$email_vhost" eq mySociety::Config::get("BASE_URL"); +} + +1; + diff --git a/perllib/FixMyStreet/Cobrand/EmptyHomes.pm b/perllib/FixMyStreet/Cobrand/EmptyHomes.pm new file mode 100644 index 000000000..6b907cbd0 --- /dev/null +++ b/perllib/FixMyStreet/Cobrand/EmptyHomes.pm @@ -0,0 +1,70 @@ +package FixMyStreet::Cobrand::EmptyHomes; +use base 'FixMyStreet::Cobrand::Default'; + +use strict; +use warnings; + +use FixMyStreet; +use mySociety::Locale; +use Carp; + +=item + +Return the base url for this cobranded site + +=cut + +sub base_url { + my $base_url = FixMyStreet->config('BASE_URL'); + if ( $base_url !~ /emptyhomes/ ) { + $base_url =~ s/http:\/\//http:\/\/emptyhomes\./g; + } + return $base_url; +} + +sub admin_base_url { + return 'https://secure.mysociety.org/admin/emptyhomes/'; +} + +sub area_types { + return qw(DIS LBO MTD UTA LGD COI); # No CTY +} + +=item set_lang_and_domain LANG UNICODE + +Set the language and text domain for the site based on the query and host. + +=cut + +sub set_lang_and_domain { + my ( $self, $lang, $unicode ) = @_; + mySociety::Locale::negotiate_language( + 'en-gb,English,en_GB|cy,Cymraeg,cy_GB', $lang ); + mySociety::Locale::gettext_domain( 'FixMyStreet-EmptyHomes', $unicode ); + mySociety::Locale::change(); +} + +=item site_title + +Return the title to be used in page heads + +=cut + +sub site_title { + my ($self) = @_; + return _('Report Empty Homes'); +} + +=item feed_xsl + +Return the XSL file path to be used for feeds' + +=cut + +sub feed_xsl { + my ($self) = @_; + return '/xsl.eha.xsl'; +} + +1; + diff --git a/perllib/FixMyStreet/Cobrand/FiksGataMi.pm b/perllib/FixMyStreet/Cobrand/FiksGataMi.pm new file mode 100644 index 000000000..25a4ad83c --- /dev/null +++ b/perllib/FixMyStreet/Cobrand/FiksGataMi.pm @@ -0,0 +1,38 @@ +package FixMyStreet::Cobrand::FiksGataMi; +use base 'FixMyStreet::Cobrand::Default'; + +use strict; +use warnings; + +use Carp; + +sub set_lang_and_domain { + my ( $self, $lang, $unicode ) = @_; + mySociety::Locale::negotiate_language( + 'en-gb,English,en_GB|nb,Norwegian,nb_NO', 'nb' ); + mySociety::Locale::gettext_domain( 'FixMyStreet', $unicode ); + mySociety::Locale::change(); +} + +sub enter_postcode_text { + my ( $self, $q ) = @_; + return _('Enter a nearby postcode, or street name and area:'); +} + +# Is also adding language parameter +sub disambiguate_location { + my ( $self, $s, $q ) = @_; + $s = "hl=no&gl=no&$s"; + return $s; +} + +sub area_types { + return ( 'NKO', 'NFY' ); +} + +sub area_min_generation { + return ''; +} + +1; + diff --git a/perllib/Problems.pm b/perllib/Problems.pm index 3710c3a95..111583fd5 100644 --- a/perllib/Problems.pm +++ b/perllib/Problems.pm @@ -35,6 +35,16 @@ sub set_site_restriction { } } +# Set the site restrictions using the new cobrand style - no need to special +# case 'fixmystreet' as default cobrand takes care of that. +sub set_site_restriction_with_cobrand_object { + my $cobrand = shift; + + my $cobrand_data = $cobrand->extra_data; + ( $site_restriction, $site_key ) = + $cobrand->site_restriction($cobrand_data); +} + sub current_timestamp { my $current_timestamp = dbh()->selectrow_array('select ms_current_timestamp()'); return "'$current_timestamp'::timestamp"; diff --git a/perllib/local/lib.pm b/perllib/local/lib.pm new file mode 100644 index 000000000..65e5365a6 --- /dev/null +++ b/perllib/local/lib.pm @@ -0,0 +1,844 @@ +use strict; +use warnings; + +package local::lib; + +use 5.008001; # probably works with earlier versions but I'm not supporting them + # (patches would, of course, be welcome) + +use File::Spec (); +use File::Path (); +use Carp (); +use Config; + +our $VERSION = '1.008001'; # 1.8.1 + +our @KNOWN_FLAGS = qw(--self-contained); + +sub import { + my ($class, @args) = @_; + + # Remember what PERL5LIB was when we started + my $perl5lib = $ENV{PERL5LIB} || ''; + + my %arg_store; + for my $arg (@args) { + # check for lethal dash first to stop processing before causing problems + if ($arg =~ /−/) { + die <<'DEATH'; +WHOA THERE! It looks like you've got some fancy dashes in your commandline! +These are *not* the traditional -- dashes that software recognizes. You +probably got these by copy-pasting from the perldoc for this module as +rendered by a UTF8-capable formatter. This most typically happens on an OS X +terminal, but can happen elsewhere too. Please try again after replacing the +dashes with normal minus signs. +DEATH + } + elsif(grep { $arg eq $_ } @KNOWN_FLAGS) { + (my $flag = $arg) =~ s/--//; + $arg_store{$flag} = 1; + } + elsif($arg =~ /^--/) { + die "Unknown import argument: $arg"; + } + else { + # assume that what's left is a path + $arg_store{path} = $arg; + } + } + + if($arg_store{'self-contained'}) { + die "FATAL: The local::lib --self-contained flag has never worked reliably and the original author, Mark Stosberg, was unable or unwilling to maintain it. As such, this flag has been removed from the local::lib codebase in order to prevent misunderstandings and potentially broken builds. The local::lib authors recommend that you look at the lib::core::only module shipped with this distribution in order to create a more robust environment that is equivalent to what --self-contained provided (although quite possibly not what you originally thought it provided due to the poor quality of the documentation, for which we apologise).\n"; + } + + $arg_store{path} = $class->resolve_path($arg_store{path}); + $class->setup_local_lib_for($arg_store{path}); + + for (@INC) { # Untaint @INC + next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc. + m/(.*)/ and $_ = $1; + } +} + +sub pipeline; + +sub pipeline { + my @methods = @_; + my $last = pop(@methods); + if (@methods) { + \sub { + my ($obj, @args) = @_; + $obj->${pipeline @methods}( + $obj->$last(@args) + ); + }; + } else { + \sub { + shift->$last(@_); + }; + } +} + +=begin testing + +#:: test pipeline + +package local::lib; + +{ package Foo; sub foo { -$_[1] } sub bar { $_[1]+2 } sub baz { $_[1]+3 } } +my $foo = bless({}, 'Foo'); +Test::More::ok($foo->${pipeline qw(foo bar baz)}(10) == -15); + +=end testing + +=cut + +sub _uniq { + my %seen; + grep { ! $seen{$_}++ } @_; +} + +sub resolve_path { + my ($class, $path) = @_; + $class->${pipeline qw( + resolve_relative_path + resolve_home_path + resolve_empty_path + )}($path); +} + +sub resolve_empty_path { + my ($class, $path) = @_; + if (defined $path) { + $path; + } else { + '~/perl5'; + } +} + +=begin testing + +#:: test classmethod setup + +my $c = 'local::lib'; + +=end testing + +=begin testing + +#:: test classmethod + +is($c->resolve_empty_path, '~/perl5'); +is($c->resolve_empty_path('foo'), 'foo'); + +=end testing + +=cut + +sub resolve_home_path { + my ($class, $path) = @_; + return $path unless ($path =~ /^~/); + my ($user) = ($path =~ /^~([^\/]+)/); # can assume ^~ so undef for 'us' + my $tried_file_homedir; + my $homedir = do { + if (eval { require File::HomeDir } && $File::HomeDir::VERSION >= 0.65) { + $tried_file_homedir = 1; + if (defined $user) { + File::HomeDir->users_home($user); + } else { + File::HomeDir->my_home; + } + } else { + if (defined $user) { + (getpwnam $user)[7]; + } else { + if (defined $ENV{HOME}) { + $ENV{HOME}; + } else { + (getpwuid $<)[7]; + } + } + } + }; + unless (defined $homedir) { + Carp::croak( + "Couldn't resolve homedir for " + .(defined $user ? $user : 'current user') + .($tried_file_homedir ? '' : ' - consider installing File::HomeDir') + ); + } + $path =~ s/^~[^\/]*/$homedir/; + $path; +} + +sub resolve_relative_path { + my ($class, $path) = @_; + $path = File::Spec->rel2abs($path); +} + +=begin testing + +#:: test classmethod + +local *File::Spec::rel2abs = sub { shift; 'FOO'.shift; }; +is($c->resolve_relative_path('bar'),'FOObar'); + +=end testing + +=cut + +sub setup_local_lib_for { + my ($class, $path) = @_; + $path = $class->ensure_dir_structure_for($path); + if ($0 eq '-') { + $class->print_environment_vars_for($path); + exit 0; + } else { + $class->setup_env_hash_for($path); + @INC = _uniq(split($Config{path_sep}, $ENV{PERL5LIB}), @INC); + } +} + +sub install_base_bin_path { + my ($class, $path) = @_; + File::Spec->catdir($path, 'bin'); +} + +sub install_base_perl_path { + my ($class, $path) = @_; + File::Spec->catdir($path, 'lib', 'perl5'); +} + +sub install_base_arch_path { + my ($class, $path) = @_; + File::Spec->catdir($class->install_base_perl_path($path), $Config{archname}); +} + +sub ensure_dir_structure_for { + my ($class, $path) = @_; + unless (-d $path) { + warn "Attempting to create directory ${path}\n"; + } + File::Path::mkpath($path); + # Need to have the path exist to make a short name for it, so + # converting to a short name here. + $path = Win32::GetShortPathName($path) if $^O eq 'MSWin32'; + + return $path; +} + +sub INTERPOLATE_ENV () { 1 } +sub LITERAL_ENV () { 0 } + +sub guess_shelltype { + my $shellbin = 'sh'; + if(defined $ENV{'SHELL'}) { + my @shell_bin_path_parts = File::Spec->splitpath($ENV{'SHELL'}); + $shellbin = $shell_bin_path_parts[-1]; + } + my $shelltype = do { + local $_ = $shellbin; + if(/csh/) { + 'csh' + } else { + 'bourne' + } + }; + + # Both Win32 and Cygwin have $ENV{COMSPEC} set. + if (defined $ENV{'COMSPEC'} && $^O ne 'cygwin') { + my @shell_bin_path_parts = File::Spec->splitpath($ENV{'COMSPEC'}); + $shellbin = $shell_bin_path_parts[-1]; + $shelltype = do { + local $_ = $shellbin; + if(/command\.com/) { + 'win32' + } elsif(/cmd\.exe/) { + 'win32' + } elsif(/4nt\.exe/) { + 'win32' + } else { + $shelltype + } + }; + } + return $shelltype; +} + +sub print_environment_vars_for { + my ($class, $path) = @_; + print $class->environment_vars_string_for($path); +} + +sub environment_vars_string_for { + my ($class, $path) = @_; + my @envs = $class->build_environment_vars_for($path, LITERAL_ENV); + my $out = ''; + + # rather basic csh detection, goes on the assumption that something won't + # call itself csh unless it really is. also, default to bourne in the + # pathological situation where a user doesn't have $ENV{SHELL} defined. + # note also that shells with funny names, like zoid, are assumed to be + # bourne. + + my $shelltype = $class->guess_shelltype; + + while (@envs) { + my ($name, $value) = (shift(@envs), shift(@envs)); + $value =~ s/(\\")/\\$1/g; + $out .= $class->${\"build_${shelltype}_env_declaration"}($name, $value); + } + return $out; +} + +# simple routines that take two arguments: an %ENV key and a value. return +# strings that are suitable for passing directly to the relevant shell to set +# said key to said value. +sub build_bourne_env_declaration { + my $class = shift; + my($name, $value) = @_; + return qq{export ${name}="${value}"\n}; +} + +sub build_csh_env_declaration { + my $class = shift; + my($name, $value) = @_; + return qq{setenv ${name} "${value}"\n}; +} + +sub build_win32_env_declaration { + my $class = shift; + my($name, $value) = @_; + return qq{set ${name}=${value}\n}; +} + +sub setup_env_hash_for { + my ($class, $path) = @_; + my %envs = $class->build_environment_vars_for($path, INTERPOLATE_ENV); + @ENV{keys %envs} = values %envs; +} + +sub build_environment_vars_for { + my ($class, $path, $interpolate) = @_; + return ( + PERL_LOCAL_LIB_ROOT => $path, + PERL_MB_OPT => "--install_base ${path}", + PERL_MM_OPT => "INSTALL_BASE=${path}", + PERL5LIB => join($Config{path_sep}, + $class->install_base_arch_path($path), + $class->install_base_perl_path($path), + (($ENV{PERL5LIB}||()) ? + ($interpolate == INTERPOLATE_ENV + ? ($ENV{PERL5LIB}) + : (($^O ne 'MSWin32') ? '$PERL5LIB' : '%PERL5LIB%' )) + : ()) + ), + PATH => join($Config{path_sep}, + $class->install_base_bin_path($path), + ($interpolate == INTERPOLATE_ENV + ? ($ENV{PATH}||()) + : (($^O ne 'MSWin32') ? '$PATH' : '%PATH%' )) + ), + ) +} + +=begin testing + +#:: test classmethod + +File::Path::rmtree('t/var/splat'); + +$c->ensure_dir_structure_for('t/var/splat'); + +ok(-d 't/var/splat'); + +=end testing + +=encoding utf8 + +=head1 NAME + +local::lib - create and use a local lib/ for perl modules with PERL5LIB + +=head1 SYNOPSIS + +In code - + + use local::lib; # sets up a local lib at ~/perl5 + + use local::lib '~/foo'; # same, but ~/foo + + # Or... + use FindBin; + use local::lib "$FindBin::Bin/../support"; # app-local support library + +From the shell - + + # Install LWP and its missing dependencies to the '~/perl5' directory + perl -MCPAN -Mlocal::lib -e 'CPAN::install(LWP)' + + # Just print out useful shell commands + $ perl -Mlocal::lib + export PERL_MB_OPT='--install_base /home/username/perl5' + export PERL_MM_OPT='INSTALL_BASE=/home/username/perl5' + export PERL5LIB='/home/username/perl5/lib/perl5/i386-linux:/home/username/perl5/lib/perl5' + export PATH="/home/username/perl5/bin:$PATH" + +=head2 The bootstrapping technique + +A typical way to install local::lib is using what is known as the +"bootstrapping" technique. You would do this if your system administrator +hasn't already installed local::lib. In this case, you'll need to install +local::lib in your home directory. + +If you do have administrative privileges, you will still want to set up your +environment variables, as discussed in step 4. Without this, you would still +install the modules into the system CPAN installation and also your Perl scripts +will not use the lib/ path you bootstrapped with local::lib. + +By default local::lib installs itself and the CPAN modules into ~/perl5. + +Windows users must also see L</Differences when using this module under Win32>. + +1. Download and unpack the local::lib tarball from CPAN (search for "Download" +on the CPAN page about local::lib). Do this as an ordinary user, not as root +or administrator. Unpack the file in your home directory or in any other +convenient location. + +2. Run this: + + perl Makefile.PL --bootstrap + +If the system asks you whether it should automatically configure as much +as possible, you would typically answer yes. + +In order to install local::lib into a directory other than the default, you need +to specify the name of the directory when you call bootstrap, as follows: + + perl Makefile.PL --bootstrap=~/foo + +3. Run this: (local::lib assumes you have make installed on your system) + + make test && make install + +4. Now we need to setup the appropriate environment variables, so that Perl +starts using our newly generated lib/ directory. If you are using bash or +any other Bourne shells, you can add this to your shell startup script this +way: + + echo 'eval $(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)' >>~/.bashrc + +If you are using C shell, you can do this as follows: + + /bin/csh + echo $SHELL + /bin/csh + perl -I$HOME/perl5/lib/perl5 -Mlocal::lib >> ~/.cshrc + +If you passed to bootstrap a directory other than default, you also need to give that as +import parameter to the call of the local::lib module like this way: + + echo 'eval $(perl -I$HOME/foo/lib/perl5 -Mlocal::lib=$HOME/foo)' >>~/.bashrc + +After writing your shell configuration file, be sure to re-read it to get the +changed settings into your current shell's environment. Bourne shells use +C<. ~/.bashrc> for this, whereas C shells use C<source ~/.cshrc>. + +If you're on a slower machine, or are operating under draconian disk space +limitations, you can disable the automatic generation of manpages from POD when +installing modules by using the C<--no-manpages> argument when bootstrapping: + + perl Makefile.PL --bootstrap --no-manpages + +To avoid doing several bootstrap for several Perl module environments on the +same account, for example if you use it for several different deployed +applications independently, you can use one bootstrapped local::lib +installation to install modules in different directories directly this way: + + cd ~/mydir1 + perl -Mlocal::lib=./ + eval $(perl -Mlocal::lib=./) ### To set the environment for this shell alone + printenv ### You will see that ~/mydir1 is in the PERL5LIB + perl -MCPAN -e install ... ### whatever modules you want + cd ../mydir2 + ... REPEAT ... + +For multiple environments for multiple apps you may need to include a modified +version of the C<< use FindBin >> instructions in the "In code" sample above. +If you did something like the above, you have a set of Perl modules at C<< +~/mydir1/lib >>. If you have a script at C<< ~/mydir1/scripts/myscript.pl >>, +you need to tell it where to find the modules you installed for it at C<< +~/mydir1/lib >>. + +In C<< ~/mydir1/scripts/myscript.pl >>: + + use strict; + use warnings; + use local::lib "$FindBin::Bin/.."; ### points to ~/mydir1 and local::lib finds lib + use lib "$FindBin::Bin/../lib"; ### points to ~/mydir1/lib + +Put this before any BEGIN { ... } blocks that require the modules you installed. + +=head2 Differences when using this module under Win32 + +To set up the proper environment variables for your current session of +C<CMD.exe>, you can use this: + + C:\>perl -Mlocal::lib + set PERL_MB_OPT=--install_base C:\DOCUME~1\ADMINI~1\perl5 + set PERL_MM_OPT=INSTALL_BASE=C:\DOCUME~1\ADMINI~1\perl5 + set PERL5LIB=C:\DOCUME~1\ADMINI~1\perl5\lib\perl5;C:\DOCUME~1\ADMINI~1\perl5\lib\perl5\MSWin32-x86-multi-thread + set PATH=C:\DOCUME~1\ADMINI~1\perl5\bin;%PATH% + + ### To set the environment for this shell alone + C:\>perl -Mlocal::lib > %TEMP%\tmp.bat && %TEMP%\tmp.bat && del %TEMP%\temp.bat + ### instead of $(perl -Mlocal::lib=./) + +If you want the environment entries to persist, you'll need to add then to the +Control Panel's System applet yourself or use L<App::local::lib::Win32Helper>. + +The "~" is translated to the user's profile directory (the directory named for +the user under "Documents and Settings" (Windows XP or earlier) or "Users" +(Windows Vista or later)) unless $ENV{HOME} exists. After that, the home +directory is translated to a short name (which means the directory must exist) +and the subdirectories are created. + +=head1 RATIONALE + +The version of a Perl package on your machine is not always the version you +need. Obviously, the best thing to do would be to update to the version you +need. However, you might be in a situation where you're prevented from doing +this. Perhaps you don't have system administrator privileges; or perhaps you +are using a package management system such as Debian, and nobody has yet gotten +around to packaging up the version you need. + +local::lib solves this problem by allowing you to create your own directory of +Perl packages downloaded from CPAN (in a multi-user system, this would typically +be within your own home directory). The existing system Perl installation is +not affected; you simply invoke Perl with special options so that Perl uses the +packages in your own local package directory rather than the system packages. +local::lib arranges things so that your locally installed version of the Perl +packages takes precedence over the system installation. + +If you are using a package management system (such as Debian), you don't need to +worry about Debian and CPAN stepping on each other's toes. Your local version +of the packages will be written to an entirely separate directory from those +installed by Debian. + +=head1 DESCRIPTION + +This module provides a quick, convenient way of bootstrapping a user-local Perl +module library located within the user's home directory. It also constructs and +prints out for the user the list of environment variables using the syntax +appropriate for the user's current shell (as specified by the C<SHELL> +environment variable), suitable for directly adding to one's shell +configuration file. + +More generally, local::lib allows for the bootstrapping and usage of a +directory containing Perl modules outside of Perl's C<@INC>. This makes it +easier to ship an application with an app-specific copy of a Perl module, or +collection of modules. Useful in cases like when an upstream maintainer hasn't +applied a patch to a module of theirs that you need for your application. + +On import, local::lib sets the following environment variables to appropriate +values: + +=over 4 + +=item PERL_MB_OPT + +=item PERL_MM_OPT + +=item PERL5LIB + +=item PATH + +PATH is appended to, rather than clobbered. + +=back + +These values are then available for reference by any code after import. + +=head1 CREATING A SELF-CONTAINED SET OF MODULES + +See L<lib::core::only> for one way to do this - but note that +there are a number of caveats, and the best approach is always to perform a +build against a clean perl (i.e. site and vendor as close to empty as possible). + +=head1 METHODS + +=head2 ensure_dir_structure_for + +=over 4 + +=item Arguments: $path + +=item Return value: None + +=back + +Attempts to create the given path, and all required parent directories. Throws +an exception on failure. + +=head2 print_environment_vars_for + +=over 4 + +=item Arguments: $path + +=item Return value: None + +=back + +Prints to standard output the variables listed above, properly set to use the +given path as the base directory. + +=head2 build_environment_vars_for + +=over 4 + +=item Arguments: $path, $interpolate + +=item Return value: \%environment_vars + +=back + +Returns a hash with the variables listed above, properly set to use the +given path as the base directory. + +=head2 setup_env_hash_for + +=over 4 + +=item Arguments: $path + +=item Return value: None + +=back + +Constructs the C<%ENV> keys for the given path, by calling +L</build_environment_vars_for>. + +=head2 install_base_perl_path + +=over 4 + +=item Arguments: $path + +=item Return value: $install_base_perl_path + +=back + +Returns a path describing where to install the Perl modules for this local +library installation. Appends the directories C<lib> and C<perl5> to the given +path. + +=head2 install_base_arch_path + +=over 4 + +=item Arguments: $path + +=item Return value: $install_base_arch_path + +=back + +Returns a path describing where to install the architecture-specific Perl +modules for this local library installation. Based on the +L</install_base_perl_path> method's return value, and appends the value of +C<$Config{archname}>. + +=head2 install_base_bin_path + +=over 4 + +=item Arguments: $path + +=item Return value: $install_base_bin_path + +=back + +Returns a path describing where to install the executable programs for this +local library installation. Based on the L</install_base_perl_path> method's +return value, and appends the directory C<bin>. + +=head2 resolve_empty_path + +=over 4 + +=item Arguments: $path + +=item Return value: $base_path + +=back + +Builds and returns the base path into which to set up the local module +installation. Defaults to C<~/perl5>. + +=head2 resolve_home_path + +=over 4 + +=item Arguments: $path + +=item Return value: $home_path + +=back + +Attempts to find the user's home directory. If installed, uses C<File::HomeDir> +for this purpose. If no definite answer is available, throws an exception. + +=head2 resolve_relative_path + +=over 4 + +=item Arguments: $path + +=item Return value: $absolute_path + +=back + +Translates the given path into an absolute path. + +=head2 resolve_path + +=over 4 + +=item Arguments: $path + +=item Return value: $absolute_path + +=back + +Calls the following in a pipeline, passing the result from the previous to the +next, in an attempt to find where to configure the environment for a local +library installation: L</resolve_empty_path>, L</resolve_home_path>, +L</resolve_relative_path>. Passes the given path argument to +L</resolve_empty_path> which then returns a result that is passed to +L</resolve_home_path>, which then has its result passed to +L</resolve_relative_path>. The result of this final call is returned from +L</resolve_path>. + +=head1 A WARNING ABOUT UNINST=1 + +Be careful about using local::lib in combination with "make install UNINST=1". +The idea of this feature is that will uninstall an old version of a module +before installing a new one. However it lacks a safety check that the old +version and the new version will go in the same directory. Used in combination +with local::lib, you can potentially delete a globally accessible version of a +module while installing the new version in a local place. Only combine "make +install UNINST=1" and local::lib if you understand these possible consequences. + +=head1 LIMITATIONS + +The perl toolchain is unable to handle directory names with spaces in it, +so you cant put your local::lib bootstrap into a directory with spaces. What +you can do is moving your local::lib to a directory with spaces B<after> you +installed all modules inside your local::lib bootstrap. But be aware that you +cant update or install CPAN modules after the move. + +Rather basic shell detection. Right now anything with csh in its name is +assumed to be a C shell or something compatible, and everything else is assumed +to be Bourne, except on Win32 systems. If the C<SHELL> environment variable is +not set, a Bourne-compatible shell is assumed. + +Bootstrap is a hack and will use CPAN.pm for ExtUtils::MakeMaker even if you +have CPANPLUS installed. + +Kills any existing PERL5LIB, PERL_MM_OPT or PERL_MB_OPT. + +Should probably auto-fixup CPAN config if not already done. + +Patches very much welcome for any of the above. + +On Win32 systems, does not have a way to write the created environment variables +to the registry, so that they can persist through a reboot. + +=head1 TROUBLESHOOTING + +If you've configured local::lib to install CPAN modules somewhere in to your +home directory, and at some point later you try to install a module with C<cpan +-i Foo::Bar>, but it fails with an error like: C<Warning: You do not have +permissions to install into /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux at +/usr/lib64/perl5/5.8.8/Foo/Bar.pm> and buried within the install log is an +error saying C<'INSTALL_BASE' is not a known MakeMaker parameter name>, then +you've somehow lost your updated ExtUtils::MakeMaker module. + +To remedy this situation, rerun the bootstrapping procedure documented above. + +Then, run C<rm -r ~/.cpan/build/Foo-Bar*> + +Finally, re-run C<cpan -i Foo::Bar> and it should install without problems. + +=head1 ENVIRONMENT + +=over 4 + +=item SHELL + +=item COMSPEC + +local::lib looks at the user's C<SHELL> environment variable when printing out +commands to add to the shell configuration file. + +On Win32 systems, C<COMSPEC> is also examined. + +=back + +=head1 SUPPORT + +IRC: + + Join #local-lib on irc.perl.org. + +=head1 AUTHOR + +Matt S Trout <mst@shadowcat.co.uk> http://www.shadowcat.co.uk/ + +auto_install fixes kindly sponsored by http://www.takkle.com/ + +=head1 CONTRIBUTORS + +Patches to correctly output commands for csh style shells, as well as some +documentation additions, contributed by Christopher Nehren <apeiron@cpan.org>. + +Doc patches for a custom local::lib directory, more cleanups in the english +documentation and a L<german documentation|POD2::DE::local::lib> contributed by Torsten Raudssus +<torsten@raudssus.de>. + +Hans Dieter Pearcey <hdp@cpan.org> sent in some additional tests for ensuring +things will install properly, submitted a fix for the bug causing problems with +writing Makefiles during bootstrapping, contributed an example program, and +submitted yet another fix to ensure that local::lib can install and bootstrap +properly. Many, many thanks! + +pattern of Freenode IRC contributed the beginnings of the Troubleshooting +section. Many thanks! + +Patch to add Win32 support contributed by Curtis Jewell <csjewell@cpan.org>. + +Warnings for missing PATH/PERL5LIB (as when not running interactively) silenced +by a patch from Marco Emilio Poleggi. + +Mark Stosberg <mark@summersault.com> provided the code for the now deleted +'--self-contained' option. + +Documentation patches to make win32 usage clearer by +David Mertens <dcmertens.perl@gmail.com> (run4flat). + +Brazilian L<portuguese translation|POD2::PT_BR::local::lib> and minor doc patches contributed by Breno +G. de Oliveira <garu@cpan.org>. + +=head1 COPYRIGHT + +Copyright (c) 2007 - 2010 the local::lib L</AUTHOR> and L</CONTRIBUTORS> as +listed above. + +=head1 LICENSE + +This library is free software and may be distributed under the same terms +as perl itself. + +=cut + +1; |