diff options
author | ivan <ivan> | 2008-07-21 18:58:47 +0000 |
---|---|---|
committer | ivan <ivan> | 2008-07-21 18:58:47 +0000 |
commit | 9a90f2af0663c9b4e9611e044fd25349425d1aec (patch) | |
tree | de7eb7c71cc2b9af7fa0a17d0606043383d67cca /FS/FS | |
parent | 516ee97512ba48c43302a5d9a49e354260b027be (diff) |
add framework for running Mason components standalone
Diffstat (limited to 'FS/FS')
-rw-r--r-- | FS/FS/CGI.pm | 18 | ||||
-rw-r--r-- | FS/FS/Mason.pm | 371 | ||||
-rw-r--r-- | FS/FS/Mason/Request.pm | 78 |
3 files changed, 462 insertions, 5 deletions
diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index 96047f667..7ad1dc28f 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -194,16 +194,24 @@ sub myexit { } } -=item popurl LEVEL +=item popurl LEVEL [URL] -Returns current URL with LEVEL levels of path removed from the end (default 0). +Returns current (or, optionally, passed) URL with LEVEL levels of path removed +from the end (default 0). =cut sub popurl { - my($up)=@_; - my $cgi = &FS::UID::cgi; - my $url_string = $cgi->isa('Apache') ? $cgi->uri : $cgi->url; + my $up = shift; + + my $url_string; + if ( scalar(@_) ) { + $url_string = shift; + } else { + my $cgi = &FS::UID::cgi; + $url_string = $cgi->isa('Apache') ? $cgi->uri : $cgi->url; + } + $url_string =~ s/\?.*//; my $url = new URI::URL ( $url_string ); my(@path)=$url->path_components; diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm new file mode 100644 index 000000000..219f6b738 --- /dev/null +++ b/FS/FS/Mason.pm @@ -0,0 +1,371 @@ +package FS::Mason; + +use strict; +use vars qw( @ISA @EXPORT_OK ); +use Exporter; +use HTML::Mason 1.27; #http://www.masonhq.com/?ApacheModPerl2Redirect +use HTML::Mason::Interp; +use HTML::Mason::Compiler::ToObject; + +@ISA = qw( Exporter ); +@EXPORT_OK = qw( mason_interps ); + +=head1 NAME + +FS::Mason - Initialize the Mason environment + +=head1 SYNOPSIS + + use FS::Mason qw( mason_interps ); + + my( $fs_interp, $rt_interp ) = mason_interps('apache'); + + #OR + + my( $fs_interp, $rt_interp ) = mason_interps('standalone'); #XXX name? + +=head1 DESCRIPTION + +Initializes the Mason environment, loads all Freeside and RT libraries, etc. + +=cut + +# List of modules that you want to use from components (see Admin +# manual for details) +{ + package HTML::Mason::Commands; + + use strict; + use vars qw( %session ); + use CGI 3.29 qw(-private_tempfiles); #3.29 to fix RT attachment problems + #use CGI::Carp qw(fatalsToBrowser); + use CGI::Cookie; + use List::Util qw( max min ); + use Data::Dumper; + use Date::Format; + use Date::Parse; + use Time::Local; + use Time::Duration; + use DateTime; + use DateTime::Format::Strptime; + use Lingua::EN::Inflect qw(PL); + use Tie::IxHash; + use URI::URL; + use URI::Escape; + use HTML::Entities; + use HTML::TreeBuilder; + use HTML::FormatText; + use JSON; + use MIME::Base64; + use IO::Handle; + use IO::File; + use IO::Scalar; + #not actually using this yet anyway...# use IPC::Run3 0.036; + use Net::Whois::Raw qw(whois); + if ( $] < 5.006 ) { + eval "use Net::Whois::Raw 0.32 qw(whois)"; + die $@ if $@; + } + use Text::CSV_XS; + use Spreadsheet::WriteExcel; + use Business::CreditCard 0.30; #for mask-aware cardtype() + use NetAddr::IP; + use String::Approx qw(amatch); + use Chart::LinesPoints; + use Chart::Mountain; + use Color::Scheme; + use HTML::Widgets::SelectLayers 0.07; #should go away in favor of + #selectlayers.html + use Locale::Country; + use Business::US::USPS::WebTools::AddressStandardization; + use FS; + use FS::UID qw( getotaker dbh datasrc driver_name ); + use FS::Record qw( qsearch qsearchs fields dbdef + str2time_sql str2time_sql_closing + ); + use FS::Conf; + use FS::CGI qw(header menubar table itable ntable idiot + eidiot myexit http_header); + use FS::UI::Web qw(svc_url); + use FS::UI::Web::small_custview qw(small_custview); + use FS::UI::bytecount; + use FS::Msgcat qw(gettext geterror); + use FS::Misc qw( send_email send_fax states_hash counties state_label ); + use FS::Report::Table::Monthly; + use FS::TicketSystem; + + use FS::agent; + use FS::agent_type; + use FS::domain_record; + use FS::cust_bill; + use FS::cust_bill_pay; + use FS::cust_credit; + use FS::cust_credit_bill; + use FS::cust_main qw(smart_search); + use FS::cust_main_county; + use FS::cust_pay; + use FS::cust_pkg; + use FS::part_pkg_taxclass; + use FS::cust_pkg_reason; + use FS::cust_refund; + use FS::cust_credit_refund; + use FS::cust_pay_refund; + use FS::cust_svc; + use FS::nas; + use FS::part_bill_event; + use FS::part_event; + use FS::part_event_condition; + use FS::part_pkg; + use FS::part_referral; + use FS::part_svc; + use FS::part_svc_router; + use FS::part_virtual_field; + use FS::pay_batch; + use FS::pkg_svc; + use FS::port; + use FS::queue qw(joblisting); + use FS::raddb; + use FS::session; + use FS::svc_acct; + use FS::svc_acct_pop qw(popselector); + use FS::acct_rt_transaction; + use FS::svc_domain; + use FS::svc_forward; + use FS::svc_www; + use FS::router; + use FS::addr_block; + use FS::svc_broadband; + use FS::svc_external; + use FS::type_pkgs; + use FS::part_export; + use FS::part_export_option; + use FS::export_svc; + use FS::msgcat; + use FS::rate; + use FS::rate_region; + use FS::rate_prefix; + use FS::payment_gateway; + use FS::agent_payment_gateway; + use FS::XMLRPC; + use FS::payby; + use FS::cdr; + use FS::inventory_class; + use FS::inventory_item; + use FS::pkg_category; + use FS::pkg_class; + use FS::access_user; + use FS::access_user_pref; + use FS::access_group; + use FS::access_usergroup; + use FS::access_groupagent; + use FS::access_right; + use FS::AccessRight; + use FS::svc_phone; + use FS::reason_type; + use FS::reason; + use FS::cust_main_note; + use FS::tax_class; + use FS::cust_tax_location; + use FS::part_pkg_taxproduct; + use FS::part_pkg_taxoverride; + use FS::part_pkg_taxrate; + use FS::tax_rate; + + if ( %%%RT_ENABLED%%% ) { + eval ' + use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" ); + use vars qw($Nobody $SystemUser); + use RT; + use RT::Tickets; + use RT::Transactions; + use RT::Users; + use RT::CurrentUser; + use RT::Templates; + use RT::Queues; + use RT::ScripActions; + use RT::ScripConditions; + use RT::Scrips; + use RT::Groups; + use RT::GroupMembers; + use RT::CustomFields; + use RT::CustomFieldValues; + use RT::ObjectCustomFieldValues; + + #blah. manually updated from RT::Interface::Web::Handler + use RT::Interface::Web; + use MIME::Entity; + use Text::Wrapper; + use Time::ParseDate; + use Time::HiRes; + use HTML::Scrubber; + + #blah. not even in RT::Interface::Web::Handler, just in + #html/NoAuth/css/dhandler and rt-test-dependencies. ask for it here + #to throw a real error instead of just a mysterious unstyled RT + use CSS::Squish 0.06; + + #slow, unreliable, segfaults and is optional + #see rt/html/Ticket/Elements/ShowTransactionAttachments + #use Text::Quoted; + + #?#use File::Path qw( rmtree ); + #?#use File::Glob qw( bsd_glob ); + #?#use File::Spec::Unix; + + '; + die $@ if $@; + } + + *CGI::redirect = sub { + my $self = shift; + my $cookie = ''; + if ( $_[0] eq '-cookie' ) { #this isn't actually used at the moment + (my $x, $cookie) = (shift, shift); + $HTML::Mason::r->err_headers_out->add( 'Set-cookie' => $cookie ); + } + my $location = shift; + + use vars qw($m); + + # false laziness w/below + if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect + + my $page = + qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!. + '<BR><BR><PRE>'. + ( UNIVERSAL::can(dbh, 'sprintProfile') + ? encode_entities(dbh->sprintProfile()) + : 'DBIx::Profile missing sprintProfile method;'. + 'unpatched or too old?' ). + #"\n\n". &sprintAutoProfile(). '</PRE>'. + "\n\n". '</PRE>'. + '</BODY></HTML>'; + dbh->{'private_profile'} = {}; + return $page; + + } else { #normal redirect + + $m->redirect($location); + ''; + + } + + }; + + sub include { + use vars qw($m); + $m->scomp(@_); + } + + sub errorpage { + use vars qw($m); + $m->comp('/elements/errorpage.html', @_); + } + + sub redirect { + my( $location ) = @_; + use vars qw($m); + $m->clear_buffer; + #false laziness w/above + if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect + + $m->print( + qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!. + '<BR><BR><PRE>'. + ( UNIVERSAL::can(dbh, 'sprintProfile') + ? encode_entities(dbh->sprintProfile()) + : 'DBIx::Profile missing sprintProfile method;'. + 'unpatched or too old?' ). + #"\n\n". &sprintAutoProfile(). '</PRE>'. + "\n\n". '</PRE>'. + '</BODY></HTML>' + ); + dbh->{'private_profile'} = {}; + + } else { #normal redirect + + $m->redirect($location); + + } + + } + +} # end package HTML::Mason::Commands; + +=head1 SUBROUTINE + +=over 4 + +=item mason_interps [ MODE ] + +Returns a list consisting of two HTML::Mason::Interp objects, the first for +Freeside pages, and the second for RT pages. + +#MODE can be 'apache' or 'standalone'. If not specified, defaults to 'apache'. + +=cut + +sub mason_interps { + my $mode = shift || 'apache'; + my %opt = @_; + + #my $request_class = 'HTML::Mason::Request'. + #( $mode eq 'apache' ? '::ApacheHandler' : '' ); + my $request_class = 'FS::Mason::Request'; + + #not entirely sure it belongs here, but what the hey + if ( %%%RT_ENABLED%%% ) { + RT::LoadConfig(); + } + + my %interp = ( + request_class => $request_class, + data_dir => '%%%MASONDATA%%%', + error_mode => 'output', + error_format => 'html', + ignore_warnings_expr => '.', + comp_root => [ + [ 'freeside'=>'%%%FREESIDE_DOCUMENT_ROOT%%%' ], + [ 'rt' =>'%%%FREESIDE_DOCUMENT_ROOT%%%/rt' ], + ], + ); + + $interp{out_method} = $opt{outbuf} if $mode eq 'standalone' && $opt{outbuf}; + + my $fs_interp = new HTML::Mason::Interp ( + %interp, + escape_flags => { 'js_string' => sub { + #${$_[0]} =~ s/(['\\\n])/'\\'.($1 eq "\n" ? 'n' : $1)/ge; + ${$_[0]} =~ s/(['\\])/\\$1/g; + ${$_[0]} =~ s/\n/\\n/g; + ${$_[0]} = "'". ${$_[0]}. "'"; + } + }, + ); + + my $rt_interp = new HTML::Mason::Interp ( + %interp, + escape_flags => { 'h' => \&RT::Interface::Web::EscapeUTF8 }, + compiler => HTML::Mason::Compiler::ToObject->new( + default_escape_flags => 'h', + allow_globals => [qw(%session)], + ), + ); + + ( $fs_interp, $rt_interp ); + +} + +=back + +=head1 BUGS + +Lurking in the darkness... + +=head1 SEE ALSO + +L<HTML::Mason>, L<FS>, L<RT> + +=cut + +1; diff --git a/FS/FS/Mason/Request.pm b/FS/FS/Mason/Request.pm new file mode 100644 index 000000000..0a1df874a --- /dev/null +++ b/FS/FS/Mason/Request.pm @@ -0,0 +1,78 @@ +package FS::Mason::Request; + +use strict; +use warnings; +use vars qw( $FSURL $QUERY_STRING ); +use base 'HTML::Mason::Request'; + +$FSURL = 'http://Set/FS_Mason_Request_FSURL/in_standalone_mode/'; +$QUERY_STRING = ''; + +sub new { + my $class = shift; + + my $superclass = $HTML::Mason::ApacheHandler::VERSION ? + 'HTML::Mason::Request::ApacheHandler' : + $HTML::Mason::CGIHandler::VERSION ? + 'HTML::Mason::Request::CGI' : + 'HTML::Mason::Request'; + + $class->alter_superclass( $superclass ); + + #huh... shouldn't alter_superclass take care of this for us? + __PACKAGE__->valid_params( %{ $superclass->valid_params() } ); + + my %opt = @_; + my $mode = $superclass =~ /Apache/i ? 'apache' : 'standalone'; + freeside_setup($opt{'comp'}, $mode); + + $class->SUPER::new(@_); + +} + +sub freeside_setup { + + my( $filename, $mode ) = @_; + + #warn "initializing for $filename\n"; + + if ( $filename !~ /\/rt\/.*NoAuth/ ) { #not RT images/JS + + package HTML::Mason::Commands; + use vars qw( $cgi $p $fsurl ); + use FS::UID qw( cgisuidsetup ); + use FS::CGI qw( popurl rooturl ); + + if ( $mode eq 'apache' ) { + $cgi = new CGI; + &cgisuidsetup($cgi); + #&cgisuidsetup($r); + $fsurl = rooturl(); + $p = popurl(2); + } elsif ( $mode eq 'standalone' ) { + $cgi = new CGI $FS::Mason::Request::QUERY_STRING; #better keep setting + #if you set it once + $FS::UID::cgi = $cgi; + $fsurl = $FS::Mason::Request::FSURL; #kludgy, but what the hell + $p = popurl(2, "$fsurl$filename"); + } else { + die "unknown mode $mode"; + } + + } elsif ( $filename =~ /\/rt\/REST\/.*NoAuth/ ) { + + package HTML::Mason::Commands; #? + use FS::UID qw( adminsuidsetup ); + + #need to log somebody in for the mail gw + + ##old installs w/fs_selfs or selfserv?? + #&adminsuidsetup('fs_selfservice'); + + &adminsuidsetup('fs_queue'); + + } + +} + +1; |