--- /dev/null
+New in 1.4.2:
+
+- Customer self-service server and interface. Signup and passwd servers
+ integrated into self-service server.
+ (more self-service functionality in 1.5)
+
+- Billing:
+ - typeset postscript invoices using LaTeX templates,
+ http://www.sisd.com/~ivan/invoice.pdf
+ - CVV2/CID support
+ - Business::OnlinePayment "recurring_billing" flag is set for
+ subsequent credit card transactions; some processors (AuthorizeNet,
+ others?) use this to waive the CVV2 requirement.
+ - Explicit invoice terms ("payable upon receipt" / Net XX) and a
+ calculated due date if used
+ - per-agent invoice templates (VISPs...)
+ (per-agent email From: addresses in 1.5)
+ - per-package suspend
+ - remove spurious "Setup" printed on invoice line items on one-time
+ package charges
+
+- New/updated reports:
+ - Financial: A/R Aging Summary, prepaid income, payment reports broken
+ down by credit card type, expired credit cards
+ - Resller:
+ - agent list now includes number of active and cancelled customers,
+ links to a list of the specified customers
+ - per-agent reporting for packages
+ - hide display of disabled packages from agent type browse
+ - number of signups in various time periods broken down by advertising
+ source: today, past week, 30/60/90 days, 6 months, 1 year and grand
+ total.
+ - Package and service definitions by # active
+
+- Exports:
+ - DNS automatic synchronization of reverse-ARPA records
+ - postfix export updated, communigate_pro export added
+ - shellcommands defaults now have commands for suspension and
+ unsuspension on Linux and FreeBSD
+ - ISPMan integration
+ - sql_generic price plan for charging based on a configurable SQL
+ query
+ - export module change - modules are now self contained, add new
+ exports in one file.
+
+- Back office interface:
+ - Customer view backported from 1.5, much nicer date/status view, no
+ longer separates payments/credits applied against multiple invoices,
+ package view removed and integrated into customer view
+ - popup calendar option added to date inputs
+ - access number list now includes number of accounts and links to a
+ list
+ - re-email invoice link
+ - redid mail forward edit screen
+
+Bugfixes, misc:
+- fix html quoting problems editing complicated exports
+
+- work around bug in FreeBSD pw(1) command which could corrupt
+ passwd / master.passwd files
+- fix time online view for time/data charging for sqlradius_withdomain
+ exports
+- Do our own whois query instead of linking to geektools
+- in service definitions, shell field is now a dropdown of legal shells
+- system_usernames configuration value to prohibit modification/deletion
+ of specific usernames
+- sendmail import
+
+- schema patchkits to enable functionality for current installs:
+ tax, CVV, pkg_svc?, svc_forward?
+ CVV:
+ ALTER TABLE cust_main ADD paycvv varchar(4) NULL;
+ ALTER TABLE h_cust_main ADD paycvv varchar(4) NULL;
+ ./dbdef-create ivan
+
Contains "JS Calendar" v0.9.3 <http://dynarch.com/mishoo/calendar.epl>
by Mihai Bazon <mishoo@infoiasi.ro> licensed under the terms of the GNU LGPL.
+Latex invoice template based on a template from eBills
+<http://ebills.sourceforge.net/> by Mark Asplen-Taylor <mark@asplen.co.uk>,
+licensed under the terms fo the GNU GPL.
+
Everything else is my (Ivan Kohler <ivan@420.am>) fault.
=head1 Remote API modules
+L<FS::SelfService>
+
L<FS::SignupClient>
L<FS::SessionClient>
-L<FS::MailAdminServer>
+L<FS::MailAdminServer> (deprecated in favor of the self-service server)
=head2 Command-line utilities
<META HTTP-Equiv="Expires" Content="0">
</HEAD>
<BODY BGCOLOR="#e8e8e8"$etc>
- <FONT SIZE=7>
+ <FONT SIZE=6>
$title
</FONT>
<BR><BR>
sub popurl {
my($up)=@_;
my $cgi = &FS::UID::cgi;
- my $url = new URI::URL ( $cgi->isa('Apache') ? $cgi->uri : $cgi->url );
+ my $url_string = $cgi->isa('Apache') ? $cgi->uri : $cgi->url;
+ $url_string =~ s/\?.*//;
+ my $url = new URI::URL ( $url_string );
my(@path)=$url->path_components;
splice @path, 0-$up;
$url->path_components(@path);
'MyAccount/list_pkgs' => \&list_pkgs,
'MyAccount/order_pkg' => \&order_pkg,
'MyAccount/cancel_pkg' => \&cancel_pkg,
+ 'MyAccount/charge' => \&charge,
);
use vars qw( @cust_main_editable_fields );
);
#store in db?
-my $cache = new Cache::SharedMemoryCache();
+my $cache = new Cache::SharedMemoryCache( {
+ 'namespace' => 'FS::ClientAPI::MyAccount',
+} );
-#false laziness w/FS::ClientAPI::passwd::passwd (needs to handle encrypted pw)
+#false laziness w/FS::ClientAPI::passwd::passwd
sub login {
my $p = shift;
my $svc_domain = qsearchs('svc_domain', { 'domain' => $p->{'domain'} } )
- or return { error => "Domain not found" };
+ or return { error => 'Domain '. $p->{'domain'}. ' not found' };
- my $svc_acct =
- ( length($p->{'password'}) < 13
- && qsearchs( 'svc_acct', { 'username' => $p->{'username'},
- 'domsvc' => $svc_domain->svcnum,
- '_password' => $p->{'password'} } )
- )
- || qsearchs( 'svc_acct', { 'username' => $p->{'username'},
- 'domsvc' => $svc_domain->svcnum,
- '_password' => $p->{'password'} } );
-
- unless ( $svc_acct ) { return { error => 'Incorrect password.' } }
+ my $svc_acct = qsearchs( 'svc_acct', { 'username' => $p->{'username'},
+ 'domsvc' => $svc_domain->svcnum, }
+ );
+ return { error => 'User not found.' } unless $svc_acct;
+ return { error => 'Incorrect password.' }
+ unless $svc_acct->check_password($p->{'password'});
my $session = {
'svcnum' => $svc_acct->svcnum,
$cust_pkg->reexport;
}
- return { error => '' };
+ return { error => '', pkgnum => $cust_pkg->pkgnum };
}
use Tie::RefHash;
use FS::Conf;
use FS::Record qw(qsearch qsearchs dbdef);
+use FS::Msgcat qw(gettext);
use FS::agent;
use FS::cust_main_county;
use FS::part_pkg;
use FS::cust_pkg;
use FS::svc_acct;
use FS::acct_snarf;
-use FS::Msgcat qw(gettext);
+use FS::queue;
use FS::ClientAPI; #hmm
FS::ClientAPI->register_handlers(
my @acct_snarf;
my $snarfnum = 1;
- while ( length($packet->{"snarf_machine$snarfnum"}) ) {
+ while ( exists($packet->{"snarf_machine$snarfnum"})
+ && length($packet->{"snarf_machine$snarfnum"}) ) {
my $acct_snarf = new FS::acct_snarf ( {
'machine' => $packet->{"snarf_machine$snarfnum"},
'protocol' => $packet->{"snarf_protocol$snarfnum"},
$error = $svc_acct->check;
return { 'error' => $error } if $error;
+ #setup a job dependancy to delay provisioning
+ my $placeholder = new FS::queue ( {
+ 'job' => 'FS::ClientAPI::Signup::__placeholder',
+ 'status' => 'locked',
+ } );
+ $error = $placeholder->insert;
+ return { 'error' => $error } if $error;
+
use Tie::RefHash;
tie my %hash, 'Tie::RefHash';
%hash = ( $cust_pkg => [ $svc_acct ] );
#msgcat
- $error = $cust_main->insert( \%hash, \@invoicing_list, 'noexport' => 1 );
- return { 'error' => $error } if $error;
+ $error = $cust_main->insert(
+ \%hash,
+ \@invoicing_list,
+ 'depend_jobnum' => $placeholder->jobnum,
+ );
+ if ( $error ) {
+ my $perror = $placeholder->delete;
+ $error .= " (Additionally, error removing placeholder: $perror)" if $perror;
+ return { 'error' => $error };
+ }
if ( $conf->exists('signup_server-realtime') ) {
local $FS::svc_Common::noexport_hack = 1;
$cust_main->cancel('quiet'=>1);
+ my $perror = $placeholder->depended_delete;
+ warn "error removing provisioning jobs after decline: $perror" if $perror;
+ unless ( $perror ) {
+ $perror = $placeholder->delete;
+ warn "error removing placeholder after decline: $perror" if $perror;
+ }
+
return { 'error' => '_decline' };
}
}
- $cust_main->reexport;
+
+ $error = $placeholder->delete;
+ return { 'error' => $error } if $error;
return { error => '' };
use strict;
use FS::Record qw(qsearchs);
use FS::svc_acct;
-#use FS::svc_domain;
+use FS::svc_domain;
use FS::ClientAPI; #hmm
FS::ClientAPI->register_handlers(
sub passwd {
my $packet = shift;
- #my $domain = qsearchs('svc_domain', { 'domain' => $packet->{'domain'} } )
- # or return { error => "Domain $domain not found" };
+ my $domain = $FS::ClientAPI::domain || $packet->{'domain'};
+ my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
+ or return { error => "Domain $domain not found" };
my $old_password = $packet->{'old_password'};
my $new_password = $packet->{'new_password'};
my $new_gecos = $packet->{'new_gecos'};
my $new_shell = $packet->{'new_shell'};
-#false laziness w/FS::ClientAPI::MyAccount::login (needs to handle encrypted pw)
- my $svc_acct =
- ( length($old_password) < 13
- && qsearchs( 'svc_acct', { 'username' => $packet->{'username'},
- #'domsvc' => $svc_domain->svcnum,
- '_password' => $old_password } )
- )
- || qsearchs( 'svc_acct', { 'username' => $packet->{'username'},
- #'domsvc' => $svc_domain->svcnum,
- '_password' => $old_password } );
-
- unless ( $svc_acct ) { return { error => 'Incorrect password.' } }
+ #false laziness w/FS::ClientAPI::MyAccount::login
+
+ my $svc_acct = qsearchs( 'svc_acct', { 'username' => $packet->{'username'},
+ 'domsvc' => $svc_domain->svcnum, }
+ );
+ return { error => 'User not found.' } unless $svc_acct;
+ return { error => 'Incorrect password.' }
+ unless $svc_acct->check_password($old_password);
my %hash = $svc_acct->hash;
my $new_svc_acct = new FS::svc_acct ( \%hash );
-e "$dir/$file";
}
+=item config_orbase KEY SUFFIX
+
+Returns the configuration value or values (depending on context) for
+KEY_SUFFIX, if it exists, otherwise for KEY
+
+=cut
+
+sub config_orbase {
+ my( $self, $file, $suffix ) = @_;
+ if ( $self->exists("${file}_$suffix") ) {
+ $self->config("${file}_$suffix");
+ } else {
+ $self->config($file);
+ }
+}
+
=item touch KEY
Creates the specified configuration key if it does not exist.
'type' => 'textarea',
}
} glob($self->dir. '/invoice_latex_*')
+ ),
+ ( map {
+ my $basename = basename($_);
+ $basename =~ /^(.*)$/;
+ $basename = $1;
+ new FS::ConfItem {
+ 'key' => $basename,
+ 'section' => 'billing',
+ 'description' => 'Alternate Notes section for LaTeX typeset PostScript invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.',
+ 'type' => 'textarea',
+ }
+ } glob($self->dir. '/invoice_latexnotes_*')
);
}
},
{
+ 'key' => 'unapplycredits',
+ 'section' => 'UI',
+ 'description' => 'Enable "unapplication" of unclosed credits.',
+ 'type' => 'checkbox',
+ },
+
+ {
'key' => 'dirhash',
'section' => 'shell',
'description' => 'Optional numeric value to control directory hashing. If positive, hashes directories for the specified number of levels from the front of the username. If negative, hashes directories for the specified number of levels from the end of the username. Some examples: <ul><li>1: user -> <a href="#home">/home</a>/u/user<li>2: user -> <a href="#home">/home</a>/u/s/user<li>-1: user -> <a href="#home">/home</a>/r/user<li>-2: user -> <a href="#home">home</a>/r/e/user</ul>',
'type' => 'textarea',
},
+ {
+ 'key' => 'invoice_latexsmallfooter',
+ 'section' => 'billing',
+ 'description' => 'Optional small footer for multi-page LaTeX typeset PostScript invoices.',
+ 'type' => 'textarea',
+ },
+
{
'key' => 'invoice_default_terms',
'section' => 'billing',
'description' => 'Optional default invoice term, used to calculate a due date printed on invoices.',
'type' => 'select',
- 'select_enum' => [ '', 'Payable upon receipt', 'Net 10', 'Net 15', 'Net 30', 'Net 45', 'Net 60' ],
+ 'select_enum' => [ '', 'Payable upon receipt', 'Net 0', 'Net 10', 'Net 15', 'Net 30', 'Net 45', 'Net 60' ],
},
{
},
{
+ 'key' => 'password-noampersand',
+ 'section' => 'password',
+ 'description' => 'Disallow ampersands in passwords',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'password-noexclamation',
+ 'section' => 'password',
+ 'description' => 'Disallow exclamations in passwords (Not setting this could break old text Livingston or Cistron Radius servers)',
+ 'type' => 'checkbox',
+ },
+
+ {
'key' => 'qmailmachines',
'section' => 'deprecated',
'description' => '<b>DEPRECATED</b>, add <i>qmail</i> and <i>shellcommands</i> <a href="../browse/part_export.cgi">exports</a> instead. This option used to export `/var/qmail/control/virtualdomains\', `/var/qmail/control/recipientmap\', and `/var/qmail/control/rcpthosts\'. Setting this option (even if empty) also turns on user `.qmail-extension\' file maintenance in conjunction with the <b>shellmachine</b> option.',
{
'key' => 'report_template',
- 'section' => 'required',
- 'description' => 'Required template file for reports. See the <a href="../docs/billing.html">billing documentation</a> for details.',
+ 'section' => 'deprecated',
+ 'description' => 'Deprecated template file for reports.',
'type' => 'textarea',
},
},
{
+ 'key' => 'legacy_link-steal',
+ 'section' => 'UI',
+ 'description' => 'Allow "stealing" an already-audited service from one customer (or package) to another using the link function.',
+ 'type' => 'checkbox',
+ },
+
+ {
'key' => 'queue_dangerous_controls',
'section' => 'UI',
'description' => 'Enable queue modification controls on account pages and for new jobs. Unless you are a developer working on new export code, you should probably leave this off to avoid causing provisioning problems.',
{
'key' => 'signup_server-realtime',
'section' => '',
- 'description' => 'Run billing for signup server signups immediately, and suspend accounts which subsequently have a balance.',
+ 'description' => 'Run billing for signup server signups immediately, and do not provision accounts which subsequently have a balance.',
'type' => 'checkbox',
},
'description' => 'A list of system usernames that cannot be edited or removed, one per line. Use a bare username to prohibit modification/deletion of the username in any domain, or username@domain to prohibit modification/deletetion of a specific username and domain.',
'type' => 'textarea',
},
+
+ {
+ 'key' => 'disable_autoreverse',
+ 'section' => 'BIND',
+ 'description' => 'Disable automatic synchronization of reverse-ARPA entries.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'svc_www-enable_subdomains',
+ 'section' => '',
+ 'description' => 'Enable selection of specific subdomains for virtual host creation.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'svc_www-usersvc_svcpart',
+ 'section' => '',
+ 'description' => 'Allowable service definition svcparts for virtual hosts, one per line.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'global_unique-username',
+ 'section' => 'username',
+ 'description' => 'Global username uniqueness control: none (usual setting - check uniqueness per exports), username (all usernames are globally unique, regardless of domain or exports), or username@domain (all username@domain pairs are globally unique, regardless of exports)',
+ 'type' => 'select',
+ 'select_enum' => [ 'none', 'username', 'username@domain' ],
+ },
+
);
1;
use File::CounterFile;
use Locale::Country;
use DBI qw(:sql_types);
-use DBIx::DBSchema 0.19;
+use DBIx::DBSchema 0.23;
use FS::UID qw(dbh checkruid getotaker datasrc driver_name);
use FS::SearchCache;
use FS::Msgcat qw(gettext);
sub hash {
my($self) = @_;
+ confess $self. ' -> hash: Hash attribute is undefined'
+ unless defined($self->{'Hash'});
%{ $self->{'Hash'} };
}
=cut
sub replace {
- my ( $new, $old ) = ( shift, shift );
+ my $new = shift;
+
+ my $old;
+ if ( @_ ) {
+ $old = shift;
+ } else {
+ warn "[debug]$me replace called with no arguments; autoloading old record\n"
+ if $DEBUG;
+ my $primary_key = $new->dbdef_table->primary_key;
+ if ( $primary_key ) {
+ $old = qsearchs($new->table, { $primary_key => $new->$primary_key() } )
+ or croak "can't find ". $new->table. ".$primary_key ".
+ $new->$primary_key();
+ } else {
+ croak $new->table. " has no primary key; pass old record as argument";
+ }
+ }
+
warn "[debug]$me $new ->replace $old\n" if $DEBUG;
return "Records not in same table!" unless $new->table eq $old->table;
$old->getfield($_) eq ''
#? "( $_ IS NULL OR $_ = \"\" )"
? ( driver_name =~ /^Pg$/i
- ? "$_ IS NULL"
+ ? "( $_ IS NULL OR $_ = '' ) "
: "( $_ IS NULL OR $_ = \"\" )"
)
: "$_ = ". _quote($old->getfield($_),$old->table,$_)
'';
}
+=item ut_snumber COLUMN
+
+Check/untaint signed numeric data (whole numbers). May not be null. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_snumber {
+ my($self, $field) = @_;
+ $self->getfield($field) =~ /^(-?)\s*(\d+)$/
+ or return "Illegal or empty (numeric) $field: ". $self->getfield($field);
+ $self->setfield($field, "$1$2");
+ '';
+}
+
=item ut_number COLUMN
Check/untaint simple numeric data (whole numbers). May not be null. If there
$self->getfield($field);
$self->setfield($field,$1);
} else {
- $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
- or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
- $self->setfield($field,$1);
+ if ( $self->getfield($field) =~ /^\s*$/ ) {
+ $self->setfield($field,'');
+ } else {
+ $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
+ or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ }
}
'';
}
@ISA = qw(Exporter);
@EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
- getotaker dbh datasrc getsecrets driver_name );
+ getotaker dbh datasrc getsecrets driver_name myconnect );
$freeside_uid = scalar(getpwnam('freeside'));
$ENV{'BASH_ENV'} = '';
croak "Not running uid freeside!" unless checkeuid();
- getsecrets;
- $dbh = DBI->connect($datasrc,$db_user,$db_pass, {
- 'AutoCommit' => 0,
- 'ChopBlanks' => 1,
- } ) or die "DBI->connect error: $DBI::errstr\n";
+
+ $dbh = &myconnect;
foreach ( keys %callback ) {
&{$callback{$_}};
$dbh;
}
+sub myconnect {
+ $dbh = DBI->connect( getsecrets, {'AutoCommit' => 0, 'ChopBlanks' => 1, } )
+ or die "DBI->connect error: $DBI::errstr\n";
+}
+
=item install_callback
A package can install a callback to be run in adminsuidsetup by passing
=back
-=head1 VERSION
-
-$Id: agent.pm,v 1.3.4.2 2003-09-30 15:01:42 ivan Exp $
-
=head1 BUGS
=head1 SEE ALSO
=back
-=head1 VERSION
-
-$Id: agent_type.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
-
=head1 BUGS
=head1 SEE ALSO
use Mail::Internet 1.44;
use Mail::Header;
use Text::Template;
+use File::Temp 0.14;
+use String::ShellQuote;
use FS::UID qw( datasrc );
use FS::Record qw( qsearch qsearchs );
use FS::cust_main;
$balance;
}
-=item send
+=item send [ TEMPLATENAME [ , AGENTNUM ] ]
Sends this invoice to the destinations configured for this customer: send
emails or print. See L<FS::cust_main_invoice>.
+TEMPLATENAME, if specified, is the name of a suffix for alternate invoices.
+
+AGENTNUM, if specified, means that this invoice will only be sent for customers
+of the specified agent.
+
=cut
sub send {
- my($self,$template) = @_;
+ my $self = shift;
+ my $template = scalar(@_) ? shift : '';
+ return '' if scalar(@_) && $_[0] && $self->cust_main->agentnum ne shift;
+
my @print_text = $self->print_text('', $template);
my @invoicing_list = $self->cust_main->invoicing_list;
$!=0;
$message->smtpsend( Host => $smtpmachine )
or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
- or return "(customer # ". $self->custnum. ") can't send invoice email".
- " to ". join(', ', grep { $_ ne 'POST' } @invoicing_list ).
- " via server $smtpmachine with SMTP: $!";
+ or die "(customer # ". $self->custnum. ") can't send invoice email".
+ " to ". join(', ', grep { $_ ne 'POST' } @invoicing_list ).
+ " via server $smtpmachine with SMTP: $!\n";
}
if ( grep { $_ eq 'POST' } @invoicing_list ) { #postal
open(LPR, "|$lpr")
- or return "Can't open pipe to $lpr: $!";
+ or die "Can't open pipe to $lpr: $!\n";
print LPR @print_text;
close LPR
- or return $! ? "Error closing $lpr: $!"
- : "Exit status $? from $lpr";
+ or die $! ? "Error closing $lpr: $!\n"
+ : "Exit status $? from $lpr\n";
}
'';
} );
my $error = $cust_pay->insert;
if ( $error ) {
- # gah, even with transactions.
- my $e = 'WARNING: Card/ACH debited but database not updated - '.
- 'error applying payment, invnum #' . $self->invnum.
- " ($processor): $error";
- warn $e;
- return $e;
- } else {
- return '';
+ $cust_pay->invnum(''); #try again with no specific invnum
+ my $error2 = $cust_pay->insert;
+ if ( $error2 ) {
+ # gah, even with transactions.
+ my $e = 'WARNING: Card/ACH debited but database not updated - '.
+ "error inserting payment ($processor): $error2".
+ ' (previously tried insert with invnum #' . $self->invnum.
+ ": $error )";
+ warn $e;
+ return $e;
+ }
}
+ return ''; #no error
+
#} elsif ( $options{'report_badcard'} ) {
} else {
if ( !$realtime_bop_decline_quiet && $conf->exists('emaildecline')
&& grep { $_ ne 'POST' } $cust_main->invoicing_list
- && ! grep { $_ eq $transaction->error_message }
+ && ! grep { $transaction->error_message =~ /$_/ }
$conf->config('emaildecline-exclude')
) {
my @templ = $conf->config('declinetemplate');
'';
}
+sub _agent_template {
+ my $self = shift;
+
+ my $cust_bill_event = qsearchs( 'part_bill_event',
+ {
+ 'payby' => $self->cust_main->payby,
+ 'plan' => 'send_agent',
+ 'eventcode' => { 'op' => 'LIKE',
+ 'value' => '_%, '. $self->cust_main->agentnum. ');' },
+ },
+ '',
+ 'ORDER BY seconds LIMIT 1'
+ );
+
+ return '' unless $cust_bill_event;
+
+ if ( $cust_bill_event->eventcode =~ /\(\s*'(.*)'\s*,\s*(\d+)\s*\)\;$/ ) {
+ return $1;
+ } else {
+ warn "can't parse eventcode for agent-specific invoice template";
+ return '';
+ }
+
+}
+
=item print_text [ TIME [ , TEMPLATE ] ]
Returns an text invoice, as a list of lines.
sprintf("%10.2f", $balance_due ) ];
#create the template
+ $template ||= $self->_agent_template;
my $templatefile = 'invoice_template';
- $templatefile .= "_$template" if $template;
+ $templatefile .= "_$template" if length($template);
my @invoice_template = $conf->config($templatefile)
- or die "cannot load config file $templatefile";
+ or die "cannot load config file $templatefile";
$invoice_lines = 0;
my $wasfunc = 0;
foreach ( grep /invoice_lines\(\d*\)/, @invoice_template ) { #kludgy
}
-=item print_ps [ TIME [ , TEMPLATE ] ]
+=item print_latex [ TIME [ , TEMPLATE ] ]
-Returns an postscript invoice, as a scalar.
+Internal method - returns a filename of a filled-in LaTeX template for this
+invoice (Note: add ".tex" to get the actual filename).
+
+See print_ps and print_pdf for methods that return PostScript and PDF output.
TIME an optional value used to control the printing of overdue messages. The
default is now. It isn't the date of the invoice; that's the `_date' field.
=cut
#still some false laziness w/print_text
-sub print_ps {
+sub print_latex {
my( $self, $today, $template ) = @_;
$today ||= time;
@buf = ();
#create the template
+ $template ||= $self->_agent_template;
my $templatefile = 'invoice_latex';
- $templatefile .= "_$template" if $template;
+ my $suffix = length($template) ? "_$template" : '';
+ $templatefile .= $suffix;
my @invoice_template = $conf->config($templatefile)
or die "cannot load config file $templatefile";
'zip' => _latex_escape($cust_main->zip),
'country' => _latex_escape($cust_main->country),
'footer' => join("\n", $conf->config('invoice_latexfooter') ),
+ 'smallfooter' => join("\n", $conf->config('invoice_latexsmallfooter') ),
'quantity' => 1,
'terms' => $conf->config('invoice_default_terms') || 'Payable upon receipt',
- 'notes' => join("\n", $conf->config('invoice_latexnotes') ),
+ #'notes' => join("\n", $conf->config('invoice_latexnotes') ),
);
- $invoice_data{'footer'} =~ s/\n+$//;
- $invoice_data{'notes'} =~ s/\n+$//;
-
my $countrydefault = $conf->config('countrydefault') || 'US';
$invoice_data{'country'} = '' if $invoice_data{'country'} eq $countrydefault;
+ #do variable substitutions in notes
+ $invoice_data{'notes'} =
+ join("\n",
+ map { my $b=$_; $b =~ s/\$(\w+)/$invoice_data{$1}/eg; $b }
+ $conf->config_orbase('invoice_latexnotes', $suffix)
+ );
+
+ $invoice_data{'footer'} =~ s/\n+$//;
+ $invoice_data{'smallfooter'} =~ s/\n+$//;
+ $invoice_data{'notes'} =~ s/\n+$//;
+
$invoice_data{'po_line'} =
( $cust_main->payby eq 'BILL' && $cust_main->payinfo )
? _latex_escape("Purchase Order #". $cust_main->payinfo)
$var;
}
- my $dir = '/tmp'; #! /usr/local/etc/freeside/invoices.datasrc/
- my $unique = int(rand(2**31)); #UGH... use File::Temp or something
+ my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ my $fh = new File::Temp( TEMPLATE => 'invoice.'. $self->invnum. '.XXXXXXXX',
+ DIR => $dir,
+ SUFFIX => '.tex',
+ UNLINK => 0,
+ ) or die "can't open temp file: $!\n";
+ print $fh join("\n", @filled_in ), "\n";
+ close $fh;
+
+ $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
+ return $1;
+
+}
+
+=item print_ps [ TIME [ , TEMPLATE ] ]
+Returns an postscript invoice, as a scalar.
+
+TIME an optional value used to control the printing of overdue messages. The
+default is now. It isn't the date of the invoice; that's the `_date' field.
+It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=cut
+
+sub print_ps {
+ my $self = shift;
+
+ my $file = $self->print_latex(@_);
+
+ my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
chdir($dir);
- my $file = $self->invnum. ".$unique";
- open(TEX,">$file.tex") or die "can't open $file.tex: $!\n";
- print TEX join("\n", @filled_in ), "\n";
- close TEX;
+ my $sfile = shell_quote $file;
+
+ system("pslatex $sfile.tex >/dev/null 2>&1") == 0
+ or die "pslatex $file.tex failed; see $file.log for details?\n";
+ system("pslatex $sfile.tex >/dev/null 2>&1") == 0
+ or die "pslatex $file.tex failed; see $file.log for details?\n";
- #error checking!!
- system('pslatex', "$file.tex");
- system('pslatex', "$file.tex");
- #system('dvips', '-t', 'letter', "$file.dvi", "$file.ps");
- system('dvips', '-t', 'letter', "$file.dvi", '-o', "$file.ps" );
+ system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
+ or die "dvips failed";
- open(POSTSCRIPT, "<$file.ps") or die "can't open $file.ps (probable error in LaTeX template): $!\n";
+ open(POSTSCRIPT, "<$file.ps")
+ or die "can't open $file.ps: $! (error in LaTeX template?)\n";
- #rm $file.dvi $file.log $file.aux
- #unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps");
- unlink("$file.dvi", "$file.log", "$file.aux");
+ unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
my $ps = '';
while (<POSTSCRIPT>) {
}
-# quick subroutine for print_ps
+=item print_pdf [ TIME [ , TEMPLATE ] ]
+
+Returns an PDF invoice, as a scalar.
+
+TIME an optional value used to control the printing of overdue messages. The
+default is now. It isn't the date of the invoice; that's the `_date' field.
+It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=cut
+
+sub print_pdf {
+ my $self = shift;
+
+ my $file = $self->print_latex(@_);
+
+ my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ chdir($dir);
+
+ #system('pdflatex', "$file.tex");
+ #system('pdflatex', "$file.tex");
+ #! LaTeX Error: Unknown graphics extension: .eps.
+
+ my $sfile = shell_quote $file;
+
+ system("pslatex $sfile.tex >/dev/null 2>&1") == 0
+ or die "pslatex $file.tex failed: $!";
+ system("pslatex $sfile.tex >/dev/null 2>&1") == 0
+ or die "pslatex $file.tex failed: $!";
+
+ #system('dvipdf', "$file.dvi", "$file.pdf" );
+ system(
+ "dvips -q -t letter -f $sfile.dvi ".
+ "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
+ " -c save pop -"
+ ) == 0
+ or die "dvips | gs failed: $!";
+
+ open(PDF, "<$file.pdf")
+ or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
+
+ unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
+
+ my $pdf = '';
+ while (<PDF>) {
+ $pdf .= $_;
+ }
+
+ close PDF;
+
+ return $pdf;
+
+}
+
+# quick subroutine for print_latex
#
# There are ten characters that LaTeX treats as special characters, which
# means that they do not simply typeset themselves:
my $part_pkg = qsearchs('part_pkg', { pkgpart=>$cust_pkg->pkgpart } );
my $pkg = $part_pkg->pkg;
+ my %labels;
+ #tie %labels, 'Tie::IxHash';
+ push @{ $labels{$_->[0]} }, $_->[1] foreach $cust_pkg->labels;
+ my @ext_description;
+ foreach my $label ( keys %labels ) {
+ my @values = @{ $labels{$label} };
+ my $num = scalar(@values);
+ if ( $num > 5 ) {
+ push @ext_description, "$label ($num)";
+ } else {
+ push @ext_description, map { "$label: $_" } @values;
+ }
+ }
+
if ( $cust_bill_pkg->setup != 0 ) {
my $description = $pkg;
$description .= ' Setup' if $cust_bill_pkg->recur != 0;
- my @d = ();
- @d = $cust_bill_pkg->details if $cust_bill_pkg->recur == 0;
+ my @d = @ext_description;
+ push @d, $cust_bill_pkg->details if $cust_bill_pkg->recur == 0;
push @b, {
'description' => $description,
#'pkgpart' => $part_pkg->pkgpart,
'pkgnum' => $cust_pkg->pkgnum,
'amount' => sprintf("%10.2f", $cust_bill_pkg->setup),
- 'ext_description' => [ ( map { $_->[0]. ": ". $_->[1] }
- $cust_pkg->labels ),
- @d,
- ],
+ 'ext_description' => \@d,
};
}
#'pkgpart' => $part_pkg->pkgpart,
'pkgnum' => $cust_pkg->pkgnum,
'amount' => sprintf("%10.2f", $cust_bill_pkg->recur),
- 'ext_description' => [ ( map { $_->[0]. ": ". $_->[1] }
- $cust_pkg->labels ),
+ 'ext_description' => [ @ext_description,
$cust_bill_pkg->details,
],
};
#'description' => 'Credit ref\#'. $_->crednum.
# " (". time2str("%x",$_->cust_credit->_date) .")".
# $reason,
- 'description' => 'Credit applied'.
+ 'description' => 'Credit applied '.
time2str("%x",$_->cust_credit->_date). $reason,
'amount' => sprintf("%10.2f",$_->amount),
};
print_text formatting (and some logic :/) is in source, but needs to be
slurped in from a file. Also number of lines ($=).
-missing print_ps for a nice postscript copy (maybe HylaFAX-cover-page-style
-or something similar so the look can be completely customized?)
-
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill_pay>, L<FS::cust_pay>,
=back
-=head1 VERSION
-
-$Id: cust_bill_pkg.pm,v 1.3 2002-04-06 22:32:43 ivan Exp $
-
=head1 BUGS
=head1 SEE ALSO
=back
-=head1 VERSION
-
-$Id: cust_credit_refund.pm,v 1.9 2002-01-26 01:52:31 ivan Exp $
-
=head1 BUGS
Delete and replace methods.
package FS::cust_main;
use strict;
-use vars qw( @ISA $conf $Debug $import );
+use vars qw( @ISA $conf $DEBUG $import );
use Safe;
use Carp;
BEGIN {
@ISA = qw( FS::Record );
-$Debug = 0;
-#$Debug = 1;
+$DEBUG = 0;
+#$DEBUG = 1;
$import = 0;
$cust_main->insert( {}, [ $email, 'POST' ] );
-Currently available options are: I<noexport>
+Currently available options are: I<depend_jobnum> and I<noexport>.
-If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
-(You can schedule them later with the B<reexport> method.)
+If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
+on the supplied jobnum (they will not run until the specific job completes).
+This can be used to defer provisioning until some action completes (such
+as running the customer's credit card sucessfully).
+
+The I<noexport> option is deprecated. If I<noexport> is set true, no
+provisioning jobs (exports) are scheduled. (You can schedule them later with
+the B<reexport> method.)
=cut
my $cust_pkgs = @_ ? shift : {};
my $invoicing_list = @_ ? shift : '';
my %options = @_;
+ warn "FS::cust_main::insert called with options ".
+ join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
+ if $DEBUG;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
}
# packages
- #local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
$error = $self->order_pkgs($cust_pkgs, \$seconds, %options);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
}
-=item order_pkgs HASHREF, [ , OPTION => VALUE ... ] ]
+=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ]
Like the insert method on an existing record, this method orders a package
and included services atomicaly. Pass a Tie::RefHash data structure to this
$cust_pkg => [ $svc_acct ],
...
);
- $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
+ $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 );
+
+Currently available options are: I<depend_jobnum> and I<noexport>.
-Currently available options are: I<noexport>
+If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
+on the supplied jobnum (they will not run until the specific job completes).
+This can be used to defer provisioning until some action completes (such
+as running the customer's credit card sucessfully).
-If I<noexport> is set true, no provisioning jobs (exports) are scheduled.
-(You can schedule them later with the B<reexport> method for each
-cust_pkg object. Using the B<reexport> method on the cust_main object is not
-recommended, as existing services will also be reexported.)
+The I<noexport> option is deprecated. If I<noexport> is set true, no
+provisioning jobs (exports) are scheduled. (You can schedule them later with
+the B<reexport> method for each cust_pkg object. Using the B<reexport> method
+on the cust_main object is not recommended, as existing services will also be
+reexported.)
=cut
my $cust_pkgs = shift;
my $seconds = shift;
my %options = @_;
+ my %svc_options = ();
+ $svc_options{'depend_jobnum'} = $options{'depend_jobnum'}
+ if exists $options{'depend_jobnum'};
+ warn "FS::cust_main::order_pkgs called with options ".
+ join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
+ if $DEBUG;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
$svc_something->seconds( $svc_something->seconds + $$seconds );
$$seconds = 0;
}
- $error = $svc_something->insert;
+ $error = $svc_something->insert(%svc_options);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
#return "inserting svc_ (transaction rolled back): $error";
=item reexport
+This method is deprecated. See the I<depend_jobnum> option to the insert and
+order_pkgs methods for a better way to defer provisioning.
+
Re-schedules all exports by calling the B<reexport> method of all associated
packages (see L<FS::cust_pkg>). If there is an error, returns the error;
otherwise returns false.
sub reexport {
my $self = shift;
+ carp "warning: FS::cust_main::reexport is deprectated; ".
+ "use the depend_jobnum option to insert or order_pkgs to delay export";
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
grep { $_->suspend } $self->unsuspended_pkgs;
}
+=item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
+PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on
+success or a list of errors.
+
+=cut
+
+sub suspend_if_pkgpart {
+ my $self = shift;
+ my @pkgparts = @_;
+ grep { $_->suspend }
+ grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
+ $self->unsuspended_pkgs;
+}
+
+=item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
+listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list
+on success or a list of errors.
+
+=cut
+
+sub suspend_unless_pkgpart {
+ my $self = shift;
+ my @pkgparts = @_;
+ grep { $_->suspend }
+ grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
+ $self->unsuspended_pkgs;
+}
+
=item cancel [ OPTION => VALUE ... ]
Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
sub cancel {
my $self = shift;
- grep { $_->cancel(@_) } $self->ncancelled_pkgs;
+ grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs;
}
=item agent
sub bill {
my( $self, %options ) = @_;
+ return '' if $self->payby eq 'COMP';
my $time = $options{'time'} || time;
my $error;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
+ $self->select_for_update; #mutex
+
# find the packages which are due for billing, find out how much they are
# & generate invoice database.
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
+ $self->select_for_update; #mutex
+
my $balance = $self->balance;
- warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
+ warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG;
unless ( $balance > 0 ) { #redundant?????
$dbh->rollback if $oldAutoCommit; #hmm
return '';
last if $self->balance <= 0;
warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")"
- if $Debug;
+ if $DEBUG;
foreach my $part_bill_event (
sort { $a->seconds <=> $b->seconds
|| $a->weight <=> $b->weight
|| $a->eventpart <=> $b->eventpart }
grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
- && ! qsearchs( 'cust_bill_event', {
+ && ! qsearch( 'cust_bill_event', {
'invnum' => $cust_bill->invnum,
'eventpart' => $_->eventpart,
'status' => 'done',
|| $self->balance <= 0; # or if balance<=0
warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
- if $Debug;
+ if $DEBUG;
my $cust_main = $self; #for callback
my $error;
qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
}
+=item select_for_update
+
+Selects this record with the SQL "FOR UPDATE" command. This can be useful as
+a mutex.
+
+=cut
+
+sub select_for_update {
+ my $self = shift;
+ qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
+}
+
=back
=head1 SUBROUTINES
my %cust_main = (
agentnum => $agentnum,
refnum => $refnum,
- country => 'US', #default
+ country => $conf->config('countrydefault') || 'US',
payby => 'BILL', #default
paydate => '12/2037', #default
);
$self->exempt_amount(0) unless $self->exempt_amount;
$self->ut_numbern('taxnum')
- || $self->ut_textn('state')
+ || $self->ut_anything('state')
|| $self->ut_textn('county')
|| $self->ut_text('country')
|| $self->ut_float('tax')
foreach my $country ( sort keys %cust_main_county ) {
$script_html .= "\nif ( country == \"$country\" ) {\n";
foreach my $state ( sort keys %{$cust_main_county{$country}} ) {
- my $text = $state || '(n/a)';
- $script_html .= qq!opt(what.form.${prefix}state, "$state", "$text");\n!;
+ my( $dstate = $state ) =~ s/\n//g;
+ my $text = $dstate || '(n/a)';
+ $script_html .= qq!opt(what.form.${prefix}state, "$dstate", "$text");\n!;
}
$script_html .= "}\n";
}
=back
-=head1 VERSION
-
-$Id: cust_main_invoice.pm,v 1.12 2002-04-12 13:22:02 ivan Exp $
-
=head1 BUGS
=head1 SEE ALSO
=back
-=head1 VERSION
-
-$Id: cust_pay.pm,v 1.21.4.3 2003-09-10 10:54:47 ivan Exp $
-
=head1 BUGS
Delete and replace methods.
package FS::cust_pkg;
use strict;
-use vars qw(@ISA $disable_agentcheck);
+use vars qw(@ISA $disable_agentcheck $DEBUG);
use FS::UID qw( getotaker dbh );
use FS::Record qw( qsearch qsearchs );
use FS::cust_svc;
@ISA = qw( FS::Record );
+$DEBUG = 0;
+
$disable_agentcheck = 0;
sub _cache {
unless ( ! $self->getfield('susp') ) {
my %hash = $self->hash;
+ my $inactive = time - $hash{'susp'};
$hash{'susp'} = '';
+ $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
+ if $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
my $new = new FS::cust_pkg ( \%hash );
$error = $new->replace($self);
if ( $error ) {
sub last_bill {
my $self = shift;
- if ( $self->dbdef_table->column('manual_flag') ) {
+ if ( $self->dbdef_table->column('last_bill') ) {
return $self->setfield('last_bill', $_[1]) if @_;
return $self->getfield('last_bill') if $self->getfield('last_bill');
}
=item reexport
+This method is deprecated. See the I<depend_jobnum> option to the insert and
+order_pkgs methods in FS::cust_main for a better way to defer provisioning.
+
=cut
sub reexport {
push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
}
}
+ if ( $DEBUG ) {
+ foreach my $svcpart ( keys %svcnum ) {
+ warn "initial svcpart $svcpart: existing svcnums ".
+ join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n";
+ }
+ }
my @cust_svc;
#generate @cust_svc
}
push @cust_svc, [
map {
- ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
- } map { $_->svcpart }
+ my $svcnum = $svcnum{$_->{svcpart}};
+ if ( $svcnum && @$svcnum ) {
+ my $num = ( $_->{quantity} < scalar(@$svcnum) )
+ ? $_->{quantity}
+ : scalar(@$svcnum);
+ splice @$svcnum, 0, $num;
+ } else {
+ ();
+ }
+ } map { { 'svcpart' => $_->svcpart,
+ 'quantity' => $_->quantity } }
qsearch('pkg_svc', { pkgpart => $pkgpart,
quantity => { op=>'>', value=>'0', } } )
];
}
+ if ( $DEBUG ) {
+ foreach my $svcpart ( keys %svcnum ) {
+ warn "after regular move svcpart $svcpart: existing svcnums ".
+ join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n";
+ }
+ }
+
#special-case until this can be handled better
# move services to new svcparts - even if the svcparts don't match (svcdb
# needs to...)
}
}
-
+
+ if ( $DEBUG ) {
+ foreach my $svcpart ( keys %svcnum ) {
+ warn "after special-case move svcpart $svcpart: existing svcnums ".
+ join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n";
+ }
+ }
+
+
#check for leftover services
foreach (keys %svcnum) {
next unless @{ $svcnum{$_} };
=item refund - Amount of the refund
+=item reason - Reason for the refund
+
=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
L<Time::Local> and L<Date::Parse> for conversion functions.
$self->ut_numbern('refundnum')
|| $self->ut_numbern('custnum')
|| $self->ut_money('refund')
+ || $self->ut_text('reason')
|| $self->ut_numbern('_date')
|| $self->ut_textn('paybatch')
|| $self->ut_enum('closed', [ '', 'Y' ])
=back
-=head1 VERSION
-
-$Id: cust_refund.pm,v 1.18.4.2 2002-11-19 09:52:02 ivan Exp $
-
=head1 BUGS
Delete and replace methods.
my $domain = $svc_domain->domain;
$tag = "$domuser\@$domain";
} elsif ( $svcdb eq 'svc_forward' ) {
- my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } );
- $tag = $svc_acct->email. '->';
+ if ( $svc_x->srcsvc ) {
+ my $svc_acct = $svc_x->srcsvc_acct;
+ $tag = $svc_acct->email;
+ } else {
+ $tag = $svc_x->src;
+ }
+ $tag .= '->';
if ( $svc_x->dstsvc ) {
- $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } );
+ my $svc_acct = $svc_x->dstsvc_acct;
$tag .= $svc_acct->email;
} else {
$tag .= $svc_x->dst;
my $seconds = 0;
foreach my $part_export ( @part_export ) {
+ next if $part_export->option('ignore_accounting');
+
my $dbh = DBI->connect( map { $part_export->option($_) }
qw(datasrc username password) )
or die "can't connect to sqlradius database: ". $DBI::errstr;
#select a unix time conversion function based on database type
my $str2time;
- if ( $dbh->{Driver}->{Name} eq 'mysql' ) {
+ if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
$str2time = 'UNIX_TIMESTAMP(';
} elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
$str2time = 'EXTRACT( EPOCH FROM ';
foreach my $part_export ( @part_export ) {
+ next if $part_export->option('ignore_accounting');
+
my $dbh = DBI->connect( map { $part_export->option($_) }
qw(datasrc username password) )
or die "can't connect to sqlradius database: ". $DBI::errstr;
#select a unix time conversion function based on database type
my $str2time;
- if ( $dbh->{Driver}->{Name} eq 'mysql' ) {
+ if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
$str2time = 'UNIX_TIMESTAMP(';
} elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
$str2time = 'EXTRACT( EPOCH FROM ';
#select a unix time conversion function based on database type
my $str2time;
- if ( $dbh->{Driver}->{Name} eq 'mysql' ) {
+ if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
$str2time = 'UNIX_TIMESTAMP(';
} elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
$str2time = 'EXTRACT( EPOCH FROM ';
package FS::domain_record;
use strict;
-use vars qw( @ISA $noserial_hack );
+use vars qw( @ISA $noserial_hack $DEBUG );
+use FS::Conf;
#use FS::Record qw( qsearch qsearchs );
use FS::Record qw( qsearchs dbh );
use FS::svc_domain;
@ISA = qw(FS::Record);
+$DEBUG = 1;
+
=head1 NAME
FS::domain_record - Object methods for domain_record records
}
}
+ my $conf = new FS::Conf;
+ if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) {
+ my $reverse = $self->reverse_record;
+ if ( $reverse && ! $reverse->recnum ) {
+ my $error = $reverse->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error adding corresponding reverse-ARPA record: $error";
+ }
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
}
}
+ my $conf = new FS::Conf;
+ if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) {
+ my $reverse = $self->reverse_record;
+ if ( $reverse && $reverse->recnum && $reverse->recdata eq $self->zone.'.' ){
+ my $error = $reverse->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error removing corresponding reverse-ARPA record: $error";
+ }
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
if ( $self->rectype eq 'SOA' ) {
my $recdata = $self->recdata;
$recdata =~ s/\s+/ /g;
- $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( (\d+ ){5}\))$/i
+ $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( ((\d+|((\d+[WDHMS])+)) ){5}\))$/i
or return "Illegal data for SOA record: $recdata";
$self->recdata($1);
} elsif ( $self->rectype eq 'NS' ) {
my $soa = qsearchs('domain_record', {
svcnum => $self->svcnum,
- reczone => '@', #or full domain ?
+ reczone => '@',
+ recaf => 'IN',
+ rectype => 'SOA', } )
+ || qsearchs('domain_record', {
+ svcnum => $self->svcnum,
+ reczone => $self->svc_domain->domain.'.',
recaf => 'IN',
rectype => 'SOA',
- } ) or return "soa record not found; can't increment serial";
+ } )
+ or return "soa record not found; can't increment serial";
my $data = $soa->recdata;
$data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works.
$zone;
}
-=back
+=item reverse_record
+
+Returns the corresponding reverse-ARPA record as another FS::domain_record
+object. If the specific record does not exist in the database but the
+reverse-ARPA zone itself does, an appropriate new record is created. If no
+reverse-ARPA zone is available at all, returns false.
+
+(You can test whether or not record itself exists in the database or is a new
+object that might need to be inserted by checking the recnum field)
-=head1 VERSION
+Mostly used by the insert and delete methods - probably should see them for
+examples.
-$Id: domain_record.pm,v 1.11.4.2 2003-03-29 04:52:35 ivan Exp $
+=cut
+
+sub reverse_record {
+ my $self = shift;
+ warn "reverse_record called\n" if $DEBUG;
+ #should support classless reverse-ARPA ala rfc2317 too
+ $self->recdata =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/
+ or return '';
+ my $domain = "$3.$2.$1.in-addr.arpa";
+ my $ptr_reczone = $4;
+ warn "reverse_record: searching for domain: $domain\n" if $DEBUG;
+ my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
+ or return '';
+ warn "reverse_record: found domain: $domain\n" if $DEBUG;
+ my %hash = (
+ 'svcnum' => $svc_domain->svcnum,
+ 'reczone' => $ptr_reczone,
+ 'recaf' => 'IN',
+ 'rectype' => 'PTR',
+ );
+ qsearchs('domain_record', \%hash )
+ or new FS::domain_record { %hash, 'recdata' => $self->zone.'.' };
+}
+
+=back
=head1 BUGS
use strict;
use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
+use FS::Record qw( qsearch qsearchs dbh );
use FS::part_export;
use FS::part_svc;
=cut
-# the insert method can be inherited from FS::Record
+sub insert {
+ my $self = shift;
+ my $error;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ $error = $self->check;
+ return $error if $error;
+
+ #check for duplicates!
+ my @checks = ();
+ my $svcdb = $self->part_svc->svcdb;
+ if ( $svcdb eq 'svc_acct' ) {
+
+ if ( $self->part_export->nodomain =~ /^Y/i ) {
+ push @checks, {
+ label => 'usernames',
+ method => 'username',
+ sortby => sub { $a cmp $b },
+ };
+ } else {
+ push @checks, {
+ label => 'username@domain',
+ method => 'email',
+ sortby => sub {
+ my($auser, $adomain) = split('@', $a);
+ my($buser, $bdomain) = split('@', $b);
+ $adomain cmp $bdomain || $auser cmp $buser;
+ },
+ };
+ }
+
+ unless ( $self->part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
+ push @checks, {
+ label => 'uids',
+ method => 'uid',
+ sortby => sub { $a <=> $b },
+ };
+ }
+
+ } elsif ( $svcdb eq 'svc_domain' ) {
+ push @checks, {
+ label => 'domains',
+ method => 'domain',
+ sortby => sub { $a cmp $b },
+ };
+ } else {
+ warn "WARNING: No duplicate checking done on merge of $svcdb exports";
+ }
+
+ foreach my $check ( @checks ) {
+ my @current_svc = $self->part_export->svc_x;
+ #warn "current: ". scalar(@current_svc). " $current_svc[0]\n";
+ my @new_svc = $self->part_svc->svc_x;
+ #warn "new: ". scalar(@new_svc). " $new_svc[0]\n";
+ my $method = $check->{'method'};
+ my %cur_svc = map { $_->$method() => $_ } @current_svc;
+ my @dup_svc = grep { $cur_svc{$_->$method()} } @new_svc;
+ #my @diff_customer = grep {
+ # $_->cust_pkg->custnum != $cur_svc{$_->$method()}->cust_pkg->custnum
+ # } @dup_svc;
+
+
+
+ if ( @dup_svc ) { #aye, that's the rub
+ #error out for now, eventually accept different options of adjustments
+ # to make to allow us to continue forward
+ $dbh->rollback if $oldAutoCommit;
+
+ my @diff_customer_svc = grep {
+ my $cust_pkg = $_->cust_svc->cust_pkg;
+ my $custnum = $cust_pkg ? $cust_pkg->custnum : 0;
+ my $other_cust_pkg = $cur_svc{$_->$method()}->cust_svc->cust_pkg;
+ my $other_custnum = $other_cust_pkg ? $other_cust_pkg->custnum : 0;
+ $custnum != $other_custnum;
+ } @dup_svc;
+
+ my $label = $check->{'label'};
+ my $sortby = $check->{'sortby'};
+ return "Can't export ".
+ $self->part_svc->svcpart.':'.$self->part_svc->svc. " service to ".
+ $self->part_export->exportnum.':'.$self->part_export->exporttype.
+ ' on '. $self->part_export->machine.
+ ' : '. scalar(@dup_svc). " duplicate $label".
+ ' ('. scalar(@diff_customer_svc). " from different customers)".
+ #": ". join(', ', sort $sortby map { $_->$method() } @dup_svc )
+ ": ". join(', ', sort $sortby map { $_->$method() } @diff_customer_svc )
+ ;
+ }
+ }
+
+ #end of duplicate check, whew
+
+ $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+# if ( $self->part_svc->svcdb eq 'svc_acct' ) {
+#
+# if ( $self->part_export->nodomain =~ /^Y/i ) {
+#
+# select username from svc_acct where svcpart = $svcpart
+# group by username having count(*) > 1;
+#
+# } else {
+#
+# select username, domain
+# from svc_acct
+# join svc_domain on ( svc_acct.domsvc = svc_domain.svcnum )
+# group by username, domain having count(*) > 1;
+#
+# }
+#
+# } elsif ( $self->part_svc->svcdb eq 'svc_domain' ) {
+#
+# #similar but easier domain checking one
+#
+# } #etc.?
+#
+# my @services =
+# map { $_->part_svc }
+# grep { $_->svcpart != $self->svcpart }
+# $self->part_export->export_svc;
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ ''; #no error
+}
=item delete
;
}
+=item part_export
+
+Returns the FS::part_export object (see L<FS::part_export>).
+
+=cut
+
+sub part_export {
+ my $self = shift;
+ qsearchs( 'part_export', { 'exportnum' => $self->exportnum } );
+}
+
+=item part_svc
+
+Returns the FS::part_svc object (see L<FS::part_svc>).
+
+=cut
+
+sub part_svc {
+ my $self = shift;
+ qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
+}
+
=back
=head1 BUGS
=back
-=head1 VERSION
-
-$Id: nas.pm,v 1.6 2002-03-04 12:48:49 ivan Exp $
-
=head1 BUGS
heartbeat method uses SQL directly and doesn't update history tables.
package FS::part_export;
use strict;
-use vars qw( @ISA @EXPORT_OK %exports );
+use vars qw( @ISA @EXPORT_OK $DEBUG %exports );
use Exporter;
use Tie::IxHash;
use FS::Record qw( qsearch qsearchs dbh );
@ISA = qw(FS::Record);
@EXPORT_OK = qw(export_info);
+$DEBUG = 0;
+
=head1 NAME
FS::part_export - Object methods for part_export records
=item svc_x
-Returns a list of associate FS::svc_* records.
+Returns a list of associated FS::svc_* records.
=cut
return "_export_delete: unknown export type ". $self->exporttype;
}
-#fallbacks providing null operations
+#call svcdb-specific fallbacks
sub _export_suspend {
my $self = shift;
#warn "warning: _export_suspened unimplemented for". ref($self);
- '';
+ my $svc_x = shift;
+ my $new = $svc_x->clone_suspended;
+ $self->_export_replace( $new, $svc_x );
}
sub _export_unsuspend {
my $self = shift;
#warn "warning: _export_unsuspend unimplemented for ". ref($self);
- '';
+ my $svc_x = shift;
+ my $old = $svc_x->clone_kludge_unsuspend;
+ $self->_export_replace( $svc_x, $old );
}
=back
sub export_info {
#warn $_[0];
- return $exports{$_[0]} if @_;
+ return $exports{$_[0]} || {} if @_;
#{ map { %{$exports{$_}} } keys %exports };
my $r = { map { %{$exports{$_}} } keys %exports };
}
# '';
#}
-tie my %sysvshell_options, 'Tie::IxHash',
- 'crypt' => { label=>'Password encryption',
- type=>'select', options=>[qw(crypt md5)],
- default=>'crypt',
- },
-;
-
-tie my %bsdshell_options, 'Tie::IxHash',
- 'crypt' => { label=>'Password encryption',
- type=>'select', options=>[qw(crypt md5)],
- default=>'crypt',
- },
-;
-
-tie my %shellcommands_options, 'Tie::IxHash',
- #'machine' => { label=>'Remote machine' },
- 'user' => { label=>'Remote username', default=>'root' },
- 'useradd' => { label=>'Insert command',
- default=>'useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username'
- #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir'
- },
- 'useradd_stdin' => { label=>'Insert command STDIN',
- type =>'textarea',
- default=>'',
- },
- 'userdel' => { label=>'Delete command',
- default=>'userdel -r $username',
- #default=>'rm -rf $dir',
- },
- 'userdel_stdin' => { label=>'Delete command STDIN',
- type =>'textarea',
- default=>'',
- },
- 'usermod' => { label=>'Modify command',
- default=>'usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username',
- #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '.
- # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '.
- # 'find . -depth -print | cpio -pdm $new_dir; '.
- # 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '.
- # 'rm -rf $old_dir'.
- #')'
- },
- 'usermod_stdin' => { label=>'Modify command STDIN',
- type =>'textarea',
- default=>'',
- },
- 'usermod_pwonly' => { label=>'Disallow username changes',
- type =>'checkbox',
- },
- 'suspend' => { label=>'Suspension command',
- default=>'',
- },
- 'suspend_stdin' => { label=>'Suspension command STDIN',
- default=>'',
- },
- 'unsuspend' => { label=>'Unsuspension command',
- default=>'',
- },
- 'unsuspend_stdin' => { label=>'Unsuspension command STDIN',
- default=>'',
- },
-;
-
-tie my %shellcommands_withdomain_options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'useradd' => { label=>'Insert command',
- #default=>''
- },
- 'useradd_stdin' => { label=>'Insert command STDIN',
- type =>'textarea',
- #default=>"$_password\n$_password\n",
- },
- 'userdel' => { label=>'Delete command',
- #default=>'',
- },
- 'userdel_stdin' => { label=>'Delete command STDIN',
- type =>'textarea',
- #default=>'',
- },
- 'usermod' => { label=>'Modify command',
- default=>'',
- },
- 'usermod_stdin' => { label=>'Modify command STDIN',
- type =>'textarea',
- #default=>"$_password\n$_password\n",
- },
- 'usermod_pwonly' => { label=>'Disallow username changes',
- type =>'checkbox',
- },
- 'suspend' => { label=>'Suspension command',
- default=>'',
- },
- 'suspend_stdin' => { label=>'Suspension command STDIN',
- default=>'',
- },
- 'unsuspend' => { label=>'Unsuspension command',
- default=>'',
- },
- 'unsuspend_stdin' => { label=>'Unsuspension command STDIN',
- default=>'',
- },
-;
-
-tie my %www_shellcommands_options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'useradd' => { label=>'Insert command',
- default=>'mkdir /var/www/$zone; chown $username /var/www/$zone; ln -s /var/www/$zone $homedir/$zone',
- },
- 'userdel' => { label=>'Delete command',
- default=>'[ -n "$zone" ] && rm -rf /var/www/$zone; rm $homedir/$zone',
- },
- 'usermod' => { label=>'Modify command',
- default=>'[ -n "$old_zone" ] && rm $old_homedir/$old_zone; [ "$old_zone" != "$new_zone" -a -n "$new_zone" ] && mv /var/www/$old_zone /var/www/$new_zone; [ "$old_username" != "$new_username" ] && chown -R $new_username /var/www/$new_zone; ln -s /var/www/$new_zone $new_homedir/$new_zone',
- },
-;
-
-tie my %apache_options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'httpd_conf' => { label=>'httpd.conf snippet location',
- default=>'/etc/apache/httpd-freeside.conf', },
- 'template' => {
- label => 'Template',
- type => 'textarea',
- default => <<'END',
-<VirtualHost $domain> #generic
-#<VirtualHost ip.addr> #preferred, http://httpd.apache.org/docs/dns-caveats.html
-DocumentRoot /var/www/$zone
-ServerName $zone
-ServerAlias *.$zone
-#BandWidthModule On
-#LargeFileLimit 4096 12288
-</VirtualHost>
-
-END
- },
-;
-
-tie my %domain_shellcommands_options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'useradd' => { label=>'Insert command',
- default=>'',
- },
- 'userdel' => { label=>'Delete command',
- default=>'',
- },
- 'usermod' => { label=>'Modify command',
- default=>'',
- },
-;
-
-tie my %textradius_options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'users' => { label=>'users file location', default=>'/etc/raddb/users' },
-;
-
-tie my %sqlradius_options, 'Tie::IxHash',
- 'datasrc' => { label=>'DBI data source ' },
- 'username' => { label=>'Database username' },
- 'password' => { label=>'Database password' },
-;
-
-tie my %sqlradius_withdomain_options, 'Tie::IxHash',
- 'datasrc' => { label=>'DBI data source ' },
- 'username' => { label=>'Database username' },
- 'password' => { label=>'Database password' },
-;
-
-tie my %cyrus_options, 'Tie::IxHash',
- 'server' => { label=>'IMAP server' },
- 'username' => { label=>'Admin username' },
- 'password' => { label=>'Admin password' },
-;
-
-tie my %cp_options, 'Tie::IxHash',
- 'port' => { label=>'Port number' },
- 'username' => { label=>'Username' },
- 'password' => { label=>'Password' },
- 'domain' => { label=>'Domain' },
- 'workgroup' => { label=>'Default Workgroup' },
-;
-
-tie my %infostreet_options, 'Tie::IxHash',
- 'url' => { label=>'XML-RPC Access URL', },
- 'login' => { label=>'InfoStreet login', },
- 'password' => { label=>'InfoStreet password', },
- 'groupID' => { label=>'InfoStreet groupID', },
-;
-
-tie my %vpopmail_options, 'Tie::IxHash',
- #'machine' => { label=>'vpopmail machine', },
- 'dir' => { label=>'directory', }, # ?more info? default?
- 'uid' => { label=>'vpopmail uid' },
- 'gid' => { label=>'vpopmail gid' },
- 'restart' => { label=> 'vpopmail restart command',
- default=> 'cd /home/vpopmail/domains; for domain in *; do /home/vpopmail/bin/vmkpasswd $domain; done; /var/qmail/bin/qmail-newu; killall -HUP qmail-send',
- },
-;
-
-tie my %communigate_pro_options, 'Tie::IxHash',
- 'port' => { label=>'Port number', default=>'106', },
- 'login' => { label=>'The administrator account name. The name can contain a domain part.', },
- 'password' => { label=>'The administrator account password.', },
- 'accountType' => { label=>'Type for newly-created accounts',
- type=>'select',
- options=>[qw( MultiMailbox TextMailbox MailDirMailbox )],
- default=>'MultiMailbox',
- },
- 'externalFlag' => { label=> 'Create accounts with an external (visible for legacy mailers) INBOX.',
- type=>'checkbox',
- },
- 'AccessModes' => { label=>'Access modes',
- default=>'Mail POP IMAP PWD WebMail WebSite',
- },
-;
-
-tie my %communigate_pro_singledomain_options, 'Tie::IxHash',
- 'port' => { label=>'Port number', default=>'106', },
- 'login' => { label=>'The administrator account name. The name can contain a domain part.', },
- 'password' => { label=>'The administrator account password.', },
- 'domain' => { label=>'Domain', },
- 'accountType' => { label=>'Type for newly-created accounts',
- type=>'select',
- options=>[qw( MultiMailbox TextMailbox MailDirMailbox )],
- default=>'MultiMailbox',
- },
- 'externalFlag' => { label=> 'Create accounts with an external (visible for legacy mailers) INBOX.',
- type=>'checkbox',
- },
- 'AccessModes' => { label=>'Access modes',
- default=>'Mail POP IMAP PWD WebMail WebSite',
- },
-;
-
-tie my %bind_options, 'Tie::IxHash',
- #'machine' => { label=>'named machine' },
- 'named_conf' => { label => 'named.conf location',
- default=> '/etc/bind/named.conf' },
- 'zonepath' => { label => 'path to zone files',
- default=> '/etc/bind/', },
-;
-
-tie my %bind_slave_options, 'Tie::IxHash',
- #'machine' => { label=> 'Slave machine' },
- 'master' => { label=> 'Master IP address(s) (semicolon-separated)' },
- 'named_conf' => { label => 'named.conf location',
- default => '/etc/bind/named.conf' },
-;
-
-tie my %http_options, 'Tie::IxHash',
- 'method' => { label =>'Method',
- type =>'select',
- #options =>[qw(POST GET)],
- options =>[qw(POST)],
- default =>'POST' },
- 'url' => { label => 'URL', default => 'http://', },
- 'insert_data' => {
- label => 'Insert data',
- type => 'textarea',
- default => join("\n",
- 'DomainName $svc_x->domain',
- 'Email ( grep { $_ ne "POST" } $svc_x->cust_svc->cust_pkg->cust_main->invoicing_list)[0]',
- 'test 1',
- 'reseller $svc_x->cust_svc->cust_pkg->part_pkg->pkg =~ /reseller/i',
- ),
- },
- 'delete_data' => {
- label => 'Delete data',
- type => 'textarea',
- default => join("\n",
- ),
- },
- 'replace_data' => {
- label => 'Replace data',
- type => 'textarea',
- default => join("\n",
- ),
- },
-;
-
-tie my %sqlmail_options, 'Tie::IxHash',
- 'datasrc' => { label=>'DBI data source' },
- 'username' => { label=>'Database username' },
- 'password' => { label=>'Database password' },
-;
-
-tie my %ldap_options, 'Tie::IxHash',
- 'dn' => { label=>'Root DN' },
- 'password' => { label=>'Root DN password' },
- 'userdn' => { label=>'User DN' },
- 'attributes' => { label=>'Attributes',
- type=>'textarea',
- default=>join("\n",
- 'uid $username',
- 'mail $username\@$domain',
- 'uidno $uid',
- 'gidno $gid',
- 'cn $first',
- 'sn $last',
- 'mailquota $quota',
- 'vmail',
- 'location',
- 'mailtag',
- 'mailhost',
- 'mailmessagestore $dir',
- 'userpassword $crypt_password',
- 'hint',
- 'answer $sec_phrase',
- 'objectclass top,person,inetOrgPerson',
- ),
- },
- 'radius' => { label=>'Export RADIUS attributes', type=>'checkbox', },
-;
-
-tie my %forward_shellcommands_options, 'Tie::IxHash',
- 'user' => { label=>'Remote username', default=>'root' },
- 'useradd' => { label=>'Insert command',
- default=>'',
- },
- 'userdel' => { label=>'Delete command',
- default=>'',
- },
- 'usermod' => { label=>'Modify command',
- default=>'',
- },
-;
-
-#export names cannot have dashes...
-%exports = (
- 'svc_acct' => {
- 'sysvshell' => {
- 'desc' =>
- 'Batch export of /etc/passwd and /etc/shadow files (Linux/SysV).',
- 'options' => \%sysvshell_options,
- 'nodomain' => 'Y',
- 'notes' => 'MD5 crypt requires installation of <a href="http://search.cpan.org/search?dist=Crypt-PasswdMD5">Crypt::PasswdMD5</a> from CPAN. Run bin/sysvshell.export to export the files.',
- },
- 'bsdshell' => {
- 'desc' =>
- 'Batch export of /etc/passwd and /etc/master.passwd files (BSD).',
- 'options' => \%bsdshell_options,
- 'nodomain' => 'Y',
- 'notes' => 'MD5 crypt requires installation of <a href="http://search.cpan.org/search?dist=Crypt-PasswdMD5">Crypt::PasswdMD5</a> from CPAN. Run bin/bsdshell.export to export the files.',
- },
-# 'nis' => {
-# 'desc' =>
-# 'Batch export of /etc/global/passwd and /etc/global/shadow for NIS ',
-# 'options' => {},
-# },
- 'textradius' => {
- 'desc' => 'Real-time export to a text /etc/raddb/users file (Livingston, Cistron)',
- 'options' => \%textradius_options,
- 'notes' => 'This will edit a text RADIUS users file in place on a remote server. Requires installation of <a href="http://search.cpan.org/search?dist=RADIUS-UserFile">RADIUS::UserFile</a> from CPAN. If using RADIUS::UserFile 1.01, make sure to apply <a href="http://rt.cpan.org/NoAuth/Bug.html?id=1210">this patch</a>. Also make sure <a href="http://rsync.samba.org/">rsync</a> is installed on the remote machine, and <a href="../docs/ssh.html">SSH is setup for unattended operation</a>.',
- },
-
- 'shellcommands' => {
- 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)',
- 'options' => \%shellcommands_options,
- 'nodomain' => 'Y',
- 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a>.<BR><BR>Use these buttons for some useful presets:<UL><LI><INPUT TYPE="button" VALUE="Linux/NetBSD/OpenBSD" onClick=\'this.form.useradd.value = "useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username"; this.form.useradd_stdin.value = ""; this.form.userdel.value = "userdel -r $username"; this.form.userdel_stdin.value=""; this.form.usermod.value = "usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username"; this.form.usermod_stdin.value = "";\'><LI><INPUT TYPE="button" VALUE="FreeBSD" onClick=\'this.form.useradd.value = "pw useradd $username -d $dir -m -s $shell -u $uid -g $gid -c $finger -h 0"; this.form.useradd_stdin.value = "$_password\n"; this.form.userdel.value = "pw userdel $username -r"; this.form.userdel_stdin.value=""; this.form.usermod.value = "pw usermod $old_username -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -c $new_finger -h 0"; this.form.usermod_stdin.value = "$new__password\n";\'><LI><INPUT TYPE="button" VALUE="Just maintain directories (use with sysvshell or bsdshell)" onClick=\'this.form.useradd.value = "cp -pr /etc/skel $dir; chown -R $uid.$gid $dir"; this.form.useradd_stdin.value = ""; this.form.usermod.value = "[ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; chmod u-t $new_dir; chown -R $new_uid.$new_gid $new_dir; rm -rf $old_dir )"; this.form.usermod_stdin.value = ""; this.form.userdel.value = "rm -rf $dir"; this.form.userdel_stdin.value="";\'></UL>The following variables are available for interpolation (prefixed with new_ or old_ for replace operations): <UL><LI><code>$username</code><LI><code>$_password</code><LI><code>$quoted_password</code> - unencrypted password quoted for the shell<LI><code>$crypt_password</code> - encrypted password<LI><code>$uid</code><LI><code>$gid</code><LI><code>$finger</code> - GECOS, already quoted for the shell (do not add additional quotes)<LI><code>$dir</code> - home directory<LI><code>$shell</code><LI><code>$quota</code><LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available.</UL>',
- },
-
- 'shellcommands_withdomain' => {
- 'desc' => 'Real-time export via remote SSH (vpopmail, etc.).',
- 'options' => \%shellcommands_withdomain_options,
- 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a>.<BR><BR>Use these buttons for some useful presets:<UL><LI><INPUT TYPE="button" VALUE="vpopmail" onClick=\'this.form.useradd.value = "/home/vpopmail/bin/vadduser $username\\\@$domain $quoted_password"; this.form.useradd_stdin.value = ""; this.form.userdel.value = "/home/vpopmail/bin/vdeluser $username\\\@$domain"; this.form.userdel_stdin.value=""; this.form.usermod.value = "/home/vpopmail/bin/vpasswd $new_username\\\@$new_domain $new_quoted_password"; this.form.usermod_stdin.value = ""; this.form.usermod_pwonly.checked = true;\'></UL>The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations): <UL><LI><code>$username</code><LI><code>$domain</code><LI><code>$_password</code><LI><code>$quoted_password</code> - unencrypted password quoted for the shell<LI><code>$crypt_password</code> - encrypted password<LI><code>$uid</code><LI><code>$gid</code><LI><code>$finger</code> - GECOS, already quoted for the shell (do not add additional quotes)<LI><code>$dir</code> - home directory<LI><code>$shell</code><LI><code>$quota</code><LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available.</UL>',
- },
-
- 'ldap' => {
- 'desc' => 'Real-time export to LDAP',
- 'options' => \%ldap_options,
- 'notes' => 'Real-time export to arbitrary LDAP attributes. Requires installation of <a href="http://search.cpan.org/search?dist=Net-LDAP">Net::LDAP</a> from CPAN.',
- },
-
- 'sqlradius' => {
- 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS, Radiator)',
- 'options' => \%sqlradius_options,
- 'nodomain' => 'Y',
- 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for <a href="http://www.freeradius.org/">FreeRADIUS</a>, <a href="http://radius.innercite.com/">ICRADIUS</a> or <a href="http://www.open.com.au/radiator/">Radiator</a>. This export does not export RADIUS realms (see also sqlradius_withdomain). An existing RADIUS database will be updated in realtime, but you can use <a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a> to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the <a href="http://search.cpan.org/doc/TIMB/DBI/DBI.pm#connect">DBI documentation</a> and the <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a> for the exact syntax of a DBI data source.<ul><li>Using FreeRADIUS 0.9.0 with the PostgreSQL backend, the db_postgresql.sql schema and postgresql.conf queries contain incompatible changes. This is fixed in 0.9.1. Only new installs with 0.9.0 and PostgreSQL are affected - upgrades and other database backends and versions are unaffected.<li>Using ICRADIUS, add a dummy "op" column to your database: <blockquote><code>ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'<br>ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'<br>ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'<br>ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'</code></blockquote><li>Using Radiator, see the <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a> for configuration information.</ul>',
- },
-
- 'sqlradius_withdomain' => {
- 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS, Radiator) with realms',
- 'options' => \%sqlradius_withdomain_options,
- 'nodomain' => '',
- 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for <a href="http://www.freeradius.org/">FreeRADIUS</a>, <a href="http://radius.innercite.com/">ICRADIUS</a> or <a href="http://www.open.com.au/radiator/">Radiator</a>. This export exports domains to RADIUS realms (see also sqlradius). An existing RADIUS database will be updated in realtime, but you can use <a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a> to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the <a href="http://search.cpan.org/doc/TIMB/DBI/DBI.pm#connect">DBI documentation</a> and the <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a> for the exact syntax of a DBI data source.<ul><li>Using FreeRADIUS 0.9.0 with the PostgreSQL backend, the db_postgresql.sql schema and postgresql.conf queries contain incompatible changes. This is fixed in 0.9.1. Only new installs with 0.9.0 and PostgreSQL are affected - upgrades and other database backends and versions are unaffected.<li>Using ICRADIUS, add a dummy "op" column to your database: <blockquote><code>ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'<br>ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'<br>ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'<br>ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'</code></blockquote><li>Using Radiator, see the <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a> for configuration information.</ul>',
- },
-
- 'sqlmail' => {
- 'desc' => 'Real-time export to SQL-backed mail server',
- 'options' => \%sqlmail_options,
- 'nodomain' => 'Y',
- 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)',
- },
-
- 'cyrus' => {
- 'desc' => 'Real-time export to Cyrus IMAP server',
- 'options' => \%cyrus_options,
- 'nodomain' => 'Y',
- 'notes' => 'Integration with <a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a>. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured. <B>svc_acct.quota</B>, if available, is used to set the Cyrus quota. '
- },
-
- 'cp' => {
- 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol',
- 'options' => \%cp_options,
- 'notes' => 'Real-time export to <a href="http://www.cp.net/">Critial Path Account Provisioning Protocol</a>. Requires installation of <a href="http://search.cpan.org/search?dist=Net-APP">Net::APP</a> from CPAN.',
- },
-
- 'infostreet' => {
- 'desc' => 'Real-time export to InfoStreet streetSmartAPI',
- 'options' => \%infostreet_options,
- 'nodomain' => 'Y',
- 'notes' => 'Real-time export to <a href="http://www.infostreet.com/">InfoStreet</a> streetSmartAPI. Requires installation of <a href="http://search.cpan.org/search?dist=Frontier-Client">Frontier::Client</a> from CPAN.',
- },
-
- 'vpopmail' => {
- 'desc' => 'Real-time export to vpopmail text files',
- 'options' => \%vpopmail_options,
- 'notes' => 'Real time export to <a href="http://inter7.com/vpopmail/">vpopmail</a> text files. <a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a> must be installed, and you will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a> to <b>vpopmail</b>@<i>export.host</i>.',
- },
-
- 'communigate_pro' => {
- 'desc' => 'Real-time export to a CommuniGate Pro mail server',
- 'options' => \%communigate_pro_options,
- 'notes' => 'Real time export to a <a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a> mail server. The <a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a> must be installed as CGP::CLI.',
- },
-
- 'communigate_pro_singledomain' => {
- 'desc' => 'Real-time export to a CommuniGate Pro mail server, one domain only',
- 'options' => \%communigate_pro_singledomain_options,
- 'nodomain' => 'Y',
- 'notes' => 'Real time export to a <a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a> mail server. This is an unusual export to CommuniGate Pro that forces all accounts into a single domain. As CommuniGate Pro supports multiple domains, unless you have a specific reason for using this export, you probably want to use the communigate_pro export instead. The <a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a> must be installed as CGP::CLI.',
- },
-
- },
-
- 'svc_domain' => {
-
- 'bind' => {
- 'desc' =>'Batch export to BIND named',
- 'options' => \%bind_options,
- 'notes' => 'Batch export of BIND zone and configuration files to primary nameserver. <a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a> must be installed. Run bin/bind.export to export the files.',
- },
-
- 'bind_slave' => {
- 'desc' =>'Batch export to slave BIND named',
- 'options' => \%bind_slave_options,
- 'notes' => 'Batch export of BIND configuration file to a secondary nameserver. Zones are slaved from the listed masters. <a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a> must be installed. Run bin/bind.export to export the files.',
- },
-
- 'http' => {
- 'desc' => 'Send an HTTP or HTTPS GET or POST request',
- 'options' => \%http_options,
- 'notes' => 'Send an HTTP or HTTPS GET or POST to the specified URL. <a href="http://search.cpan.org/search?dist=libwww-perl">libwww-perl</a> must be installed. For HTTPS support, <a href="http://search.cpan.org/search?dist=Crypt-SSLeay">Crypt::SSLeay</a> or <a href="http://search.cpan.org/search?dist=IO-Socket-SSL">IO::Socket::SSL</a> is required.',
- },
-
- 'sqlmail' => {
- 'desc' => 'Real-time export to SQL-backed mail server',
- 'options' => \%sqlmail_options,
- #'nodomain' => 'Y',
- 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)',
- },
-
- 'domain_shellcommands' => {
- 'desc' => 'Run remote commands via SSH, for domains.',
- 'options' => \%domain_shellcommands_options,
- 'notes' => 'Run remote commands via SSH, for domains. You will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a>.<BR><BR>Use these buttons for some useful presets:<UL><LI><INPUT TYPE="button" VALUE="qmail catchall .qmail-domain-default maintenance" onClick=\'this.form.useradd.value = "[ \"$uid\" -a \"$gid\" -a \"$dir\" -a \"$qdomain\" ] && [ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }"; this.form.userdel.value = ""; this.form.usermod.value = "";\'></UL>The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations): <UL><LI><code>$domain</code><LI><code>$qdomain</code> - domain with periods replaced by colons<LI><code>$uid</code> - of catchall account<LI><code>$gid</code> - of catchall account<LI><code>$dir</code> - home directory of catchall account<LI>All other fields in <a href="../docs/schema.html#svc_domain">svc_domain</a> are also available.</UL>',
- },
-
-
- },
-
- 'svc_acct_sm' => {},
-
- 'svc_forward' => {
- 'sqlmail' => {
- 'desc' => 'Real-time export to SQL-backed mail server',
- 'options' => \%sqlmail_options,
- #'nodomain' => 'Y',
- 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)',
- },
-
- 'forward_shellcommands' => {
- 'desc' => 'Run remote commands via SSH, for forwards',
- 'options' => \%forward_shellcommands_options,
- 'notes' => 'Run remote commands via SSH, for forwards. You will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a>.<BR><BR>Use these buttons for some useful presets:<UL><LI><INPUT TYPE="button" VALUE="text vpopmail maintenance" onClick=\'this.form.useradd.value = "[ -d /home/vpopmail/domains/$domain/$username ] && { echo \"$destination\" > /home/vpopmail/domains/$domain/$username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$domain/$username/.qmail; }"; this.form.userdel.value = "rm /home/vpopmail/domains/$domain/$username/.qmail"; this.form.usermod.value = "mv /home/vpopmail/domains/$old_domain/$old_username/.qmail /home/vpopmail/domains/$new_domain/$new_username; [ \"$old_destination\" != \"$new_destination\" ] && { echo \"$new_destination\" > /home/vpopmail/domains/$new_domain/$new_username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$new_domain/$new_username/.qmail; }";\'></UL>The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations): <UL><LI><code>$username</code><LI><code>$domain</code><LI><code>$destination</code> - forward destination<LI>All other fields in <a href="../docs/schema.html#svc_forward">svc_forward</a> are also available.</UL>',
- },
- },
-
- 'svc_www' => {
- 'www_shellcommands' => {
- 'desc' => 'Run remote commands via SSH, for virtual web sites.',
- 'options' => \%www_shellcommands_options,
- 'notes' => 'Run remote commands via SSH, for virtual web sites. You will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a>.<BR><BR>The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations): <UL><LI><code>$zone</code><LI><code>$username</code><LI><code>$homedir</code><LI>All other fields in <a href="../docs/schema.html#svc_www">svc_www</a> are also available.</UL>',
- },
-
- 'apache' => {
- 'desc' => 'Export an Apache httpd.conf file snippet.',
- 'options' => \%apache_options,
- 'notes' => 'Batch export of an httpd.conf snippet from a template. Typically used with something like <code>Include /etc/apache/httpd-freeside.conf</code> in httpd.conf. <a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a> must be installed. Run bin/apache.export to export the files.',
- },
- },
-
-);
+foreach my $INC ( @INC ) {
+ foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
+ warn "attempting to load export info from $file\n" if $DEBUG;
+ $file =~ /\/(\w+)\.pm$/ or do {
+ warn "unrecognized file in $INC/FS/part_export/: $file\n";
+ next;
+ };
+ my $mod = $1;
+ my $info = eval "use FS::part_export::$mod; ".
+ "\\%FS::part_export::$mod\::info;";
+ if ( $@ ) {
+ die "error using FS::part_export::$mod (skipping): $@\n" if $@;
+ next;
+ }
+ unless ( keys %$info ) {
+ warn "no %info hash found in FS::part_export::$mod, skipping\n"
+ unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck
+ next;
+ }
+ warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
+ no strict 'refs';
+ foreach my $svc (
+ ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
+ ) {
+ unless ( $svc ) {
+ warn "blank svc for FS::part_export::$mod (skipping)\n";
+ next;
+ }
+ $exports{$svc}->{$mod} = $info;
+ }
+ }
+}
=back
=head1 NEW EXPORT CLASSES
-Should be added to the %export hash here, and a module should be added in
-FS/FS/part_export/ (an example may be found in eg/export_template.pm)
+A module should be added in FS/FS/part_export/ (an example may be found in
+eg/export_template.pm)
=head1 BUGS
-All the stuff in the %exports hash should be generated from the specific
-export modules.
-
Hmm... cust_export class (not necessarily a database table...) ... ?
deprecated column...
package FS::part_export::apache;
-use vars qw(@ISA);
+use vars qw(@ISA %info);
+use Tie::IxHash;
use FS::part_export::null;
@ISA = qw(FS::part_export::null);
+tie my %options, 'Tie::IxHash',
+ 'user' => { label=>'Remote username', default=>'root' },
+ 'httpd_conf' => { label=>'httpd.conf snippet location',
+ default=>'/etc/apache/httpd-freeside.conf', },
+ 'restart' => { label=>'Apache restart command',
+ default=>'apachectl graceful',
+ },
+ 'template' => {
+ label => 'Template',
+ type => 'textarea',
+ default => <<'END',
+<VirtualHost $domain> #generic
+#<VirtualHost ip.addr> #preferred, http://httpd.apache.org/docs/dns-caveats.html
+DocumentRoot /var/www/$zone
+ServerName $zone
+ServerAlias *.$zone
+#BandWidthModule On
+#LargeFileLimit 4096 12288
+</VirtualHost>
+
+END
+ },
+;
+
+%info = (
+ 'svc' => 'svc_www',
+ 'desc' => 'Export an Apache httpd.conf file snippet.',
+ 'options' => \%options,
+ 'notes' => <<'END'
+Batch export of an httpd.conf snippet from a template. Typically used with
+something like <code>Include /etc/apache/httpd-freeside.conf</code> in
+httpd.conf. <a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a>
+must be installed. Run bin/apache.export to export the files.
+END
+);
+
+1;
+
package FS::part_export::bind;
-use vars qw(@ISA);
+use vars qw(@ISA %info %options);
+use Tie::IxHash;
use FS::part_export::null;
@ISA = qw(FS::part_export::null);
+tie %options, 'Tie::IxHash',
+ 'named_conf' => { label => 'named.conf location',
+ default=> '/etc/bind/named.conf' },
+ 'zonepath' => { label => 'path to zone files',
+ default=> '/etc/bind/', },
+ 'bind_release' => { label => 'ISC BIND Release',
+ type => 'select',
+ options => [qw(BIND8 BIND9)],
+ default => 'BIND8' },
+ 'bind9_minttl' => { label => 'The minttl required by bind9 and RFC1035.',
+ default => '1D' },
+ 'reload' => { label => 'Optional reload command. If not specified, defaults to "ndc" under BIND8 and "rndc" under BIND9.', },
+;
+
+%info = (
+ 'svc' => 'svc_domain',
+ 'desc' => 'Batch export to BIND named',
+ 'options' => \%options,
+ 'notes' => <<'END'
+Batch export of BIND zone and configuration files to a primary nameserver.
+<a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a>
+must be installed. Run bin/bind.export to export the files.
+END
+);
+
+1;
+
package FS::part_export::bind_slave;
-use vars qw(@ISA);
+use vars qw(@ISA %info);
+use Tie::IxHash;
use FS::part_export::null;
@ISA = qw(FS::part_export::null);
+tie my %options, 'Tie::IxHash',
+ 'master' => { label=> 'Master IP address(s) (semicolon-separated)' },
+ %FS::part_export::bind::options,
+;
+delete $options{'zonepath'};
+
+%info = (
+ 'svc' => 'svc_domain',
+ 'desc' =>'Batch export to slave BIND named',
+ 'options' => \%options,
+ 'notes' => <<'END'
+Batch export of BIND configuration file to a secondary nameserver. Zones are
+slaved from the listed masters.
+<a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a>
+must be installed. Run bin/bind.export to export the files.
+END
+);
+
+1;
+
package FS::part_export::bsdshell;
-use vars qw(@ISA);
-use FS::part_export::null;
+use vars qw(@ISA %info);
+use Tie::IxHash;
+use FS::part_export::passwdfile;
-@ISA = qw(FS::part_export::null);
+@ISA = qw(FS::part_export::passwdfile);
+
+tie my %options, 'Tie::IxHash', %FS::part_export::passwdfile::options;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' =>
+ 'Batch export of /etc/passwd and /etc/master.passwd files (BSD)',
+ 'options' => \%options,
+ 'nodomain' => 'Y',
+ 'notes' => <<'END'
+MD5 crypt requires installation of
+<a href="http://search.cpan.org/dist/Crypt-PasswdMD5">Crypt::PasswdMD5</a>
+from CPAN. Run bin/bsdshell.export to export the files.
+END
+);
+
+1;
package FS::part_export::communigate_pro;
-use vars qw(@ISA);
+use vars qw(@ISA %info %options);
+use Tie::IxHash;
use FS::part_export;
use FS::queue;
@ISA = qw(FS::part_export);
+tie %options, 'Tie::IxHash',
+ 'port' => { label=>'Port number', default=>'106', },
+ 'login' => { label=>'The administrator account name. The name can contain a domain part.', },
+ 'password' => { label=>'The administrator account password.', },
+ 'accountType' => { label=>'Type for newly-created accounts',
+ type=>'select',
+ options=>[qw( MultiMailbox TextMailbox MailDirMailbox )],
+ default=>'MultiMailbox',
+ },
+ 'externalFlag' => { label=> 'Create accounts with an external (visible for legacy mailers) INBOX.',
+ type=>'checkbox',
+ },
+ 'AccessModes' => { label=>'Access modes',
+ default=>'Mail POP IMAP PWD WebMail WebSite',
+ },
+;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' => 'Real-time export to a CommuniGate Pro mail server',
+ 'options' => \%options,
+ 'notes' => <<'END'
+Real time export to a
+<a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a>
+mail server. The
+<a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a>
+must be installed as CGP::CLI.
+END
+);
+
sub rebless { shift; }
sub export_username {
$cli->Logout or die "Can't logout of CGPro: $CGP::ERR_STRING\n";
}
+
+1;
+
package FS::part_export::communigate_pro_singledomain;
-use vars qw(@ISA);
+use vars qw(@ISA %info);
+use Tie::IxHash;
use FS::part_export::communigate_pro;
@ISA = qw(FS::part_export::communigate_pro);
+tie my %options, 'Tie::IxHash', %FS::part_export::communigate_pro::options,
+ 'domain' => { label=>'Domain', },
+;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' =>
+ 'Real-time export to a CommuniGate Pro mail server, one domain only',
+ 'options' => \%options,
+ 'nodomain' => 'Y',
+ 'notes' => <<'END'
+Real time export to a
+<a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a>
+mail server. This is an unusual export to CommuniGate Pro that forces all
+accounts into a single domain. As CommuniGate Pro supports multipledomains,
+unless you have a specific reason for using this export, you probably want to
+use the communigate_pro export instead. The
+<a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a>
+must be installed as CGP::CLI.
+END
+);
+
sub export_username {
my($self, $svc_acct) = (shift, shift);
$svc_acct->username. '@'. $self->option('domain');
}
+
+1;
+
package FS::part_export::cp;
-use vars qw(@ISA);
+use vars qw(@ISA %info);
+use Tie::IxHash;
use FS::part_export;
@ISA = qw(FS::part_export);
+tie my %options, 'Tie::IxHash',
+ 'port' => { label=>'Port number' },
+ 'username' => { label=>'Username' },
+ 'password' => { label=>'Password' },
+ 'domain' => { label=>'Domain' },
+ 'workgroup' => { label=>'Default Workgroup' },
+;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol',
+ 'options'=> \%options,
+ 'notes' => <<'END'
+Real-time export to
+<a href="http://www.cp.net/">Critial Path Account Provisioning Protocol</a>.
+Requires installation of
+<a href="http://search.cpan.org/dist/Net-APP">Net::APP</a>
+from CPAN.
+END
+);
+
sub rebless { shift; }
sub _export_insert {
}
+1;
+
package FS::part_export::cyrus;
-use vars qw(@ISA);
+use vars qw(@ISA %info);
+use Tie::IxHash;
use FS::part_export;
@ISA = qw(FS::part_export);
+tie my %options, 'Tie::IxHash',
+ 'server' => { label=>'IMAP server' },
+ 'username' => { label=>'Admin username' },
+ 'password' => { label=>'Admin password' },
+;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' => 'Real-time export to Cyrus IMAP server',
+ 'options' => \%options,
+ 'nodomain' => 'Y',
+ 'notes' => <<'END'
+Integration with
+<a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a>.
+Cyrus::IMAP::Admin should be installed locally and the connection to the
+server secured. <B>svc_acct.quota</B>, if available, is used to set the
+Cyrus quota.
+END
+);
+
sub rebless { shift; }
sub _export_insert {
#sub cyrus_replace { #subroutine, not method
#}
+1;
package FS::part_export::domain_shellcommands;
use strict;
-use vars qw(@ISA);
+use vars qw(@ISA %info);
+use Tie::IxHash;
use FS::part_export;
@ISA = qw(FS::part_export);
+tie my %options, 'Tie::IxHash',
+ 'user' => { label=>'Remote username', default=>'root' },
+ 'useradd' => { label=>'Insert command',
+ default=>'',
+ },
+ 'userdel' => { label=>'Delete command',
+ default=>'',
+ },
+ 'usermod' => { label=>'Modify command',
+ default=>'',
+ },
+;
+
+%info = (
+ 'svc' => 'svc_domain',
+ 'desc' => 'Run remote commands via SSH, for domains (qmail, ISPMan).',
+ 'options' => \%options,
+ 'notes' => <<'END'
+Run remote commands via SSH, for domains. You will need to
+<a href="../docs/ssh.html">setup SSH for unattended operation</a>.
+<BR><BR>Use these buttons for some useful presets:
+<UL>
+ <LI>
+ <INPUT TYPE="button" VALUE="qmail catchall .qmail-domain-default maintenance" onClick='
+ this.form.useradd.value = "[ \"$uid\" -a \"$gid\" -a \"$dir\" -a \"$qdomain\" ] && [ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }";
+ this.form.userdel.value = "";
+ this.form.usermod.value = "";
+ '>
+ <LI>
+ <INPUT TYPE="button" VALUE="ISPMan CLI" onClick='
+ this.form.useradd.value = "/usr/local/ispman/bin/ispman.addDomain -d $domain changeme";
+ this.form.userdel.value = "/usr/local/ispman/bin/ispman.deleteDomain -d $domain";
+ this.form.usermod.value = "";
+ '>
+</UL>
+The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations):
+<UL>
+ <LI><code>$domain</code>
+ <LI><code>$qdomain</code> - domain with periods replaced by colons
+ <LI><code>$uid</code> - of catchall account
+ <LI><code>$gid</code> - of catchall account
+ <LI><code>$dir</code> - home directory of catchall account
+ <LI>All other fields in
+ <a href="../docs/schema.html#svc_domain">svc_domain</a> are also available.
+</UL>
+END
+);
+
sub rebless { shift; }
sub _export_insert {
}
sub ssh_cmd { #subroutine, not method
- use Net::SSH '0.07';
+ use Net::SSH '0.08';
&Net::SSH::ssh_cmd( { @_ } );
}
#sub shellcommands_delete { #subroutine, not method
#}
+1;
+
package FS::part_export::forward_shellcommands;
use strict;
-use vars qw(@ISA);
+use vars qw(@ISA %info);
+use Tie::IxHash;
use FS::part_export;
@ISA = qw(FS::part_export);
+tie my %options, 'Tie::IxHash',
+ 'user' => { label=>'Remote username', default=>'root' },
+ 'useradd' => { label=>'Insert command',
+ default=>'',
+ },
+ 'userdel' => { label=>'Delete command',
+ default=>'',
+ },
+ 'usermod' => { label=>'Modify command',
+ default=>'',
+ },
+;
+
+%info = (
+ 'svc' => 'svc_forward',
+ 'desc' => 'Run remote commands via SSH, for forwards',
+ 'options' => \%options,
+ 'notes' => <<'END'
+Run remote commands via SSH, for forwards. You will need to
+<a href="../docs/ssh.html">setup SSH for unattended operation</a>.
+<BR><BR>Use these buttons for some useful presets:
+<UL>
+ <LI>
+ <INPUT TYPE="button" VALUE="text vpopmail maintenance" onClick='
+ this.form.useradd.value = "[ -d /home/vpopmail/domains/$domain/$username ] && { echo \"$destination\" > /home/vpopmail/domains/$domain/$username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$domain/$username/.qmail; }";
+ this.form.userdel.value = "rm /home/vpopmail/domains/$domain/$username/.qmail";
+ this.form.usermod.value = "mv /home/vpopmail/domains/$old_domain/$old_username/.qmail /home/vpopmail/domains/$new_domain/$new_username; [ \"$old_destination\" != \"$new_destination\" ] && { echo \"$new_destination\" > /home/vpopmail/domains/$new_domain/$new_username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$new_domain/$new_username/.qmail; }";
+ '>
+ <LI>
+ <INPUT TYPE="button" VALUE="ISPMan CLI" onClick='
+ this.form.useradd.value = "";
+ this.form.userdel.value = "";
+ this.form.usermod.value = "";
+ '>
+</UL>
+The following variables are available for interpolation (prefixed with
+<code>new_</code> or <code>old_</code> for replace operations):
+<UL>
+ <LI><code>$username</code>
+ <LI><code>$domain</code>
+ <LI><code>$destination</code> - forward destination
+ <LI>All other fields in <a href="../docs/schema.html#svc_forward">svc_forward</a> are also available.
+</UL>
+END
+);
+
sub rebless { shift; }
sub _export_insert {
}
sub ssh_cmd { #subroutine, not method
- use Net::SSH '0.07';
+ use Net::SSH '0.08';
&Net::SSH::ssh_cmd( { @_ } );
}
#sub shellcommands_delete { #subroutine, not method
#}
+1;
+
package FS::part_export::http;
-use vars qw(@ISA);
+use vars qw(@ISA %info);
+use Tie::IxHash;
use FS::part_export;
@ISA = qw(FS::part_export);
+tie my %options, 'Tie::IxHash',
+ 'method' => { label =>'Method',
+ type =>'select',
+ #options =>[qw(POST GET)],
+ options =>[qw(POST)],
+ default =>'POST' },
+ 'url' => { label => 'URL', default => 'http://', },
+ 'insert_data' => {
+ label => 'Insert data',
+ type => 'textarea',
+ default => join("\n",
+ 'DomainName $svc_x->domain',
+ 'Email ( grep { $_ ne "POST" } $svc_x->cust_svc->cust_pkg->cust_main->invoicing_list)[0]',
+ 'test 1',
+ 'reseller $svc_x->cust_svc->cust_pkg->part_pkg->pkg =~ /reseller/i',
+ ),
+ },
+ 'delete_data' => {
+ label => 'Delete data',
+ type => 'textarea',
+ default => join("\n",
+ ),
+ },
+ 'replace_data' => {
+ label => 'Replace data',
+ type => 'textarea',
+ default => join("\n",
+ ),
+ },
+;
+
+%info = (
+ 'svc' => 'svc_domain',
+ 'desc' => 'Send an HTTP or HTTPS GET or POST request',
+ 'options' => \%options,
+ 'notes' => <<'END'
+Send an HTTP or HTTPS GET or POST to the specified URL. For HTTPS support,
+<a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a>
+or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a>
+is required.
+END
+);
+
sub rebless { shift; }
sub _export_insert {
}
+1;
+
package FS::part_export::infostreet;
-use vars qw(@ISA %infostreet2cust_main $DEBUG);
+use vars qw(@ISA %info %infostreet2cust_main $DEBUG);
+use Tie::IxHash;
use FS::UID qw(dbh);
use FS::part_export;
@ISA = qw(FS::part_export);
+tie my %options, 'Tie::IxHash',
+ 'url' => { label=>'XML-RPC Access URL', },
+ 'login' => { label=>'InfoStreet login', },
+ 'password' => { label=>'InfoStreet password', },
+ 'groupID' => { label=>'InfoStreet groupID', },
+;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' => 'Real-time export to InfoStreet streetSmartAPI',
+ 'options' => \%options,
+ 'nodomain' => 'Y',
+ 'notes' => <<'END'
+Real-time export to
+<a href="http://www.infostreet.com/">InfoStreet</a> streetSmartAPI.
+Requires installation of
+<a href="http://search.cpan.org/dist/Frontier-Client">Frontier::Client</a> from CPAN.
+END
+);
+
$DEBUG = 0;
%infostreet2cust_main = (
} keys %$arg;
}
+1;
package FS::part_export::ldap;
-use vars qw(@ISA @saltset);
+use vars qw(@ISA %info @saltset);
+use Tie::IxHash;
use FS::Record qw( dbh );
use FS::part_export;
@ISA = qw(FS::part_export);
+tie my %options, 'Tie::IxHash',
+ 'dn' => { label=>'Root DN' },
+ 'password' => { label=>'Root DN password' },
+ 'userdn' => { label=>'User DN' },
+ 'attributes' => { label=>'Attributes',
+ type=>'textarea',
+ default=>join("\n",
+ 'uid $username',
+ 'mail $username\@$domain',
+ 'uidno $uid',
+ 'gidno $gid',
+ 'cn $first',
+ 'sn $last',
+ 'mailquota $quota',
+ 'vmail',
+ 'location',
+ 'mailtag',
+ 'mailhost',
+ 'mailmessagestore $dir',
+ 'userpassword $crypt_password',
+ 'hint',
+ 'answer $sec_phrase',
+ 'objectclass top,person,inetOrgPerson',
+ ),
+ },
+ 'radius' => { label=>'Export RADIUS attributes', type=>'checkbox', },
+;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' => 'Real-time export to LDAP',
+ 'options' => \%options,
+ 'notes' => <<'END'
+Real-time export to arbitrary LDAP attributes. Requires installation of
+<a href="http://search.cpan.org/dist/Net-LDAP">Net::LDAP</a> from CPAN.
+END
+);
+
@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
sub rebless { shift; }
$ldap;
}
+1;
+
--- /dev/null
+package FS::part_export::passwdfile;
+
+use strict;
+use vars qw(@ISA %options);
+use Tie::IxHash;
+use FS::part_export::null;
+
+@ISA = qw(FS::part_export::null);
+
+tie %options, 'Tie::IxHash',
+ 'crypt' => { label=>'Password encryption',
+ type=>'select', options=>[qw(crypt md5)],
+ default=>'crypt',
+ },
+;
+
+1;
+
--- /dev/null
+package FS::part_export::postfix;
+
+use vars qw(@ISA %info);
+use Tie::IxHash;
+use FS::part_export::null;
+
+@ISA = qw(FS::part_export::null);
+
+tie my %options, 'Tie::IxHash',
+ 'user' => { label=>'Remote username', default=>'root' },
+ 'aliases' => { label=>'aliases file location', default=>'/etc/aliases' },
+ 'virtual' => { label=>'virtual file location', default=>'/etc/postfix/virtual' },
+ 'mydomain' => { label=>'local domain', default=>'' },
+ 'newaliases' => { label=>'newaliases command', default=>'newaliases' },
+ 'postmap' => { label=>'postmap command',
+ default=>'postmap hash:/etc/postfix/virtual', },
+ 'reload' => { label=>'reload command',
+ default=>'postfix reload' },
+;
+
+%info = (
+ 'svc' => 'svc_forward',
+ 'desc' => 'Postfix text files',
+ 'options' => \%options,
+ 'notes' => <<'END'
+Batch export of Postfix aliases and virtual files.
+<a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a>
+must be installed. Run bin/postfix.export to export the files.
+END
+);
+
+1;
package FS::part_export::shellcommands;
-use vars qw(@ISA @saltset);
+use vars qw(@ISA %info @saltset);
+use Tie::IxHash;
use String::ShellQuote;
use FS::part_export;
@ISA = qw(FS::part_export);
+tie my %options, 'Tie::IxHash',
+ 'user' => { label=>'Remote username', default=>'root' },
+ 'useradd' => { label=>'Insert command',
+ default=>'useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username'
+ #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir'
+ },
+ 'useradd_stdin' => { label=>'Insert command STDIN',
+ type =>'textarea',
+ default=>'',
+ },
+ 'userdel' => { label=>'Delete command',
+ default=>'userdel -r $username',
+ #default=>'rm -rf $dir',
+ },
+ 'userdel_stdin' => { label=>'Delete command STDIN',
+ type =>'textarea',
+ default=>'',
+ },
+ 'usermod' => { label=>'Modify command',
+ default=>'usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username',
+ #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '.
+ # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '.
+ # 'find . -depth -print | cpio -pdm $new_dir; '.
+ # 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '.
+ # 'rm -rf $old_dir'.
+ #')'
+ },
+ 'usermod_stdin' => { label=>'Modify command STDIN',
+ type =>'textarea',
+ default=>'',
+ },
+ 'usermod_pwonly' => { label=>'Disallow username changes',
+ type =>'checkbox',
+ },
+ 'suspend' => { label=>'Suspension command',
+ default=>'usermod -L $username',
+ },
+ 'suspend_stdin' => { label=>'Suspension command STDIN',
+ default=>'',
+ },
+ 'unsuspend' => { label=>'Unsuspension command',
+ default=>'usermod -U $username',
+ },
+ 'unsuspend_stdin' => { label=>'Unsuspension command STDIN',
+ default=>'',
+ },
+;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' =>
+ 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)',
+ 'options' => \%options,
+ 'nodomain' => 'Y',
+ 'notes' => <<'END'
+Run remote commands via SSH. Usernames are considered unique (also see
+shellcommands_withdomain). You probably want this if the commands you are
+running will not accept a domain as a parameter. You will need to
+<a href="../docs/ssh.html">setup SSH for unattended operation</a>.
+
+<BR><BR>Use these buttons for some useful presets:
+<UL>
+ <LI>
+ <INPUT TYPE="button" VALUE="Linux" onClick='
+ this.form.useradd.value = "useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username";
+ this.form.useradd_stdin.value = "";
+ this.form.userdel.value = "userdel -r $username";
+ this.form.userdel_stdin.value="";
+ this.form.usermod.value = "usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username";
+ this.form.usermod_stdin.value = "";
+ this.form.suspend.value = "usermod -L $username";
+ this.form.suspend_stdin.value="";
+ this.form.unsuspend.value = "usermod -U $username";
+ this.form.unsuspend_stdin.value="";
+ '>
+ <LI>
+ <INPUT TYPE="button" VALUE="FreeBSD before 4.10 / 5.3" onClick='
+ this.form.useradd.value = "lockf /etc/passwd.lock pw useradd $username -d $dir -m -s $shell -u $uid -g $gid -c $finger -h 0";
+ this.form.useradd_stdin.value = "$_password\n";
+ this.form.userdel.value = "lockf /etc/passwd.lock pw userdel $username -r"; this.form.userdel_stdin.value="";
+ this.form.usermod.value = "lockf /etc/passwd.lock pw usermod $old_username -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -c $new_finger -h 0";
+ this.form.usermod_stdin.value = "$new__password\n"; this.form.suspend.value = "lockf /etc/passwd.lock pw lock $username";
+ this.form.suspend_stdin.value="";
+ this.form.unsuspend.value = "lockf /etc/passwd.lock pw unlock $username"; this.form.unsuspend_stdin.value="";
+ '>
+ Note: On FreeBSD versions before 5.3 and 4.10 (4.10 is after 4.9, not
+ 4.1!), due to deficient locking in pw(1), you must disable the chpass(1),
+ chsh(1), chfn(1), passwd(1), and vipw(1) commands, or replace them with
+ wrappers that prepend "lockf /etc/passwd.lock". Alternatively, apply the
+ patch in
+ <A HREF="http://www.freebsd.org/cgi/query-pr.cgi?pr=23501">FreeBSD PR#23501</A>
+ and use the "FreeBSD 4.10 / 5.3 or later" button below.
+ <LI>
+ <INPUT TYPE="button" VALUE="FreeBSD 4.10 / 5.3 or later" onClick='
+ this.form.useradd.value = "pw useradd $username -d $dir -m -s $shell -u $uid -g $gid -c $finger -h 0";
+ this.form.useradd_stdin.value = "$_password\n";
+ this.form.userdel.value = "pw userdel $username -r";
+ this.form.userdel_stdin.value="";
+ this.form.usermod.value = "pw usermod $old_username -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -c $new_finger -h 0";
+ this.form.usermod_stdin.value = "$new__password\n";
+ this.form.suspend.value = "pw lock $username";
+ this.form.suspend_stdin.value="";
+ this.form.unsuspend.value = "pw unlock $username";
+ this.form.unsuspend_stdin.value="";
+ '>
+ <LI>
+ <INPUT TYPE="button" VALUE="NetBSD/OpenBSD" onClick='
+ this.form.useradd.value = "useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username";
+ this.form.useradd_stdin.value = "";
+ this.form.userdel.value = "userdel -r $username";
+ this.form.userdel_stdin.value="";
+ this.form.usermod.value = "usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username";
+ this.form.usermod_stdin.value = "";
+ this.form.suspend.value = "";
+ this.form.suspend_stdin.value="";
+ this.form.unsuspend.value = "";
+ this.form.unsuspend_stdin.value="";
+ '>
+ <LI>
+ <INPUT TYPE="button" VALUE="Just maintain directories (use with sysvshell or bsdshell)" onClick='
+ this.form.useradd.value = "cp -pr /etc/skel $dir; chown -R $uid.$gid $dir"; this.form.useradd_stdin.value = "";
+ this.form.usermod.value = "[ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; chmod u-t $new_dir; chown -R $new_uid.$new_gid $new_dir; rm -rf $old_dir )";
+ this.form.usermod_stdin.value = "";
+ this.form.userdel.value = "rm -rf $dir";
+ this.form.userdel_stdin.value="";
+ this.form.suspend.value = "";
+ this.form.suspend_stdin.value="";
+ this.form.unsuspend.value = "";
+ this.form.unsuspend_stdin.value="";
+ '>
+</UL>
+
+The following variables are available for interpolation (prefixed with new_ or
+old_ for replace operations):
+<UL>
+ <LI><code>$username</code>
+ <LI><code>$_password</code>
+ <LI><code>$quoted_password</code> - unencrypted password quoted for the shell
+ <LI><code>$crypt_password</code> - encrypted password
+ <LI><code>$uid</code>
+ <LI><code>$gid</code>
+ <LI><code>$finger</code> - GECOS, already quoted for the shell (do not add additional quotes)
+ <LI><code>$first</code> - First name of GECOS, already quoted for the shell (do not add additional quotes)
+ <LI><code>$last</code> - Last name of GECOS, already quoted for the shell (do not add additional quotes)
+ <LI><code>$dir</code> - home directory
+ <LI><code>$shell</code>
+ <LI><code>$quota</code>
+ <LI><code>@radius_groups</code>
+ <LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available.
+</UL>
+END
+);
+
@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
sub rebless { shift; }
sub _export_suspend {
my($self) = shift;
- $self->_export_command('suspend', @_);
+ $self->_export_command_or_super('suspend', @_);
}
sub _export_unsuspend {
my($self) = shift;
- $self->_export_command('unsuspend', @_);
+ $self->_export_command_or_super('unsuspend', @_);
}
+sub _export_command_or_super {
+ my($self, $action) = (shift, shift);
+ if ( $self->option($action) =~ /^\s*$/ ) {
+ my $method = "SUPER::_export_$action";
+ $self->$method(@_);
+ } else {
+ $self->_export_command($action, @_);
+ }
+};
+
+
sub _export_command {
my ( $self, $action, $svc_acct) = (shift, shift, shift);
my $command = $self->option($action);
$email = '';
}
+ $finger =~ /^(.*)\s+(\S+)$/ or $finger =~ /^((.*))$/;
+ ($first, $last ) = ( $1, $2 );
+ $first = shell_quote $first;
+ $last = shell_quote $last;
$finger = shell_quote $finger;
$quoted_password = shell_quote $_password;
$domain = $svc_acct->domain;
- $crypt_password = ''; #surpress "used only once" warnings
- $crypt_password = crypt( $svc_acct->_password,
- $saltset[int(rand(64))].$saltset[int(rand(64))] );
+
+ #eventually should check a "password-encoding" field
+ if ( length($svc_acct->_password) == 13
+ || $svc_acct->_password =~ /^\$(1|2a?)\$/ ) {
+ $crypt_password = shell_quote $svc_acct->_password;
+ } else {
+ $crypt_password = crypt(
+ $svc_acct->_password,
+ $saltset[int(rand(64))].$saltset[int(rand(64))]
+ );
+ }
+
+ @radius_groups = $svc_acct->radius_groups;
$self->shellcommands_queue( $svc_acct->svcnum,
user => $self->option('user')||'root',
${"old_$_"} = $old->getfield($_) foreach $old->fields;
${"new_$_"} = $new->getfield($_) foreach $new->fields;
}
+ $new_finger =~ /^(.*)\s+(\S+)$/ or $finger =~ /^((.*))$/;
+ ($new_first, $new_last ) = ( $1, $2 );
+ $new_first = shell_quote $new_first;
+ $new_last = shell_quote $new_last;
$new_finger = shell_quote $new_finger;
$quoted_new__password = shell_quote $new__password; #old, wrong?
$new_quoted_password = shell_quote $new__password; #new, better?
$old_domain = $old->domain;
$new_domain = $new->domain;
- $new_crypt_password = ''; #surpress "used only once" warnings
- $new_crypt_password = crypt( $new->_password,
- $saltset[int(rand(64))].$saltset[int(rand(64))]);
+
+ #eventuall should check a "password-encoding" field
+ if ( length($new->_password) == 13
+ || $new->_password =~ /^\$(1|2a?)\$/ ) {
+ $new_crypt_password = shell_quote $new->_password;
+ } else {
+ $new_crypt_password =
+ crypt( $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))]
+ );
+ }
+
+ @old_radius_groups = $old->radius_groups;
+ @new_radius_groups = $new->radius_groups;
+
if ( $self->option('usermod_pwonly') ) {
my $error = '';
if ( $old_username ne $new_username ) {
if ( $old_dir ne $new_dir ) {
$error ||= "can't change dir";
}
+ if ( join("\n", sort @old_radius_groups) ne
+ join("\n", sort @new_radius_groups) ) {
+ $error ||= "can't change RADIUS groups";
+ }
return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')'
if $error;
}
}
sub ssh_cmd { #subroutine, not method
- use Net::SSH '0.07';
+ use Net::SSH '0.08';
&Net::SSH::ssh_cmd( { @_ } );
}
#sub shellcommands_delete { #subroutine, not method
#}
+1;
+
package FS::part_export::shellcommands_withdomain;
-use vars qw(@ISA);
+use vars qw(@ISA %info);
+use Tie::IxHash;
use FS::part_export::shellcommands;
@ISA = qw(FS::part_export::shellcommands);
+tie my %options, 'Tie::IxHash',
+ 'user' => { label=>'Remote username', default=>'root' },
+ 'useradd' => { label=>'Insert command',
+ #default=>''
+ },
+ 'useradd_stdin' => { label=>'Insert command STDIN',
+ type =>'textarea',
+ #default=>"$_password\n$_password\n",
+ },
+ 'userdel' => { label=>'Delete command',
+ #default=>'',
+ },
+ 'userdel_stdin' => { label=>'Delete command STDIN',
+ type =>'textarea',
+ #default=>'',
+ },
+ 'usermod' => { label=>'Modify command',
+ default=>'',
+ },
+ 'usermod_stdin' => { label=>'Modify command STDIN',
+ type =>'textarea',
+ #default=>"$_password\n$_password\n",
+ },
+ 'usermod_pwonly' => { label=>'Disallow username changes',
+ type =>'checkbox',
+ },
+ 'suspend' => { label=>'Suspension command',
+ default=>'',
+ },
+ 'suspend_stdin' => { label=>'Suspension command STDIN',
+ default=>'',
+ },
+ 'unsuspend' => { label=>'Unsuspension command',
+ default=>'',
+ },
+ 'unsuspend_stdin' => { label=>'Unsuspension command STDIN',
+ default=>'',
+ },
+;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' => 'Real-time export via remote SSH (vpopmail, ISPMan)',
+ 'options' => \%options,
+ 'notes' => <<'END'
+Run remote commands via SSH. username@domain (rather than just usernames) are
+considered unique (also see shellcommands). You probably want this if the
+commands you are running will accept a domain as a parameter, and will allow
+the same username with different domains. You will need to
+<a href="../docs/ssh.html">setup SSH for unattended operation</a>.
+
+<BR><BR>Use these buttons for some useful presets:
+<UL>
+ <LI><INPUT TYPE="button" VALUE="vpopmail" onClick='
+ this.form.useradd.value = "/home/vpopmail/bin/vadduser $username\\\@$domain $quoted_password";
+ this.form.useradd_stdin.value = "";
+ this.form.userdel.value = "/home/vpopmail/bin/vdeluser $username\\\@$domain";
+ this.form.userdel_stdin.value="";
+ this.form.usermod.value = "/home/vpopmail/bin/vpasswd $new_username\\\@$new_domain $new_quoted_password";
+ this.form.usermod_stdin.value = "";
+ this.form.usermod_pwonly.checked = true;
+ '>
+ <LI><INPUT TYPE="button" VALUE="ISPMan CLI" onClick='
+ this.form.useradd.value = "/usr/local/ispman/bin/ispman.addUser -d $domain -f $first -l $last -q $quota -p $quoted_password $username";
+ this.form.useradd_stdin.value = "";
+ this.form.userdel.value = "/usr/local/ispman/bin/ispman.delUser -d $domain $username";
+ this.form.userdel_stdin.value="";
+ this.form.usermod.value = "/usr/local/ispman/bin/ispman.passwd.user $new_username\\\@$new_domain $new_quoted_password";
+ this.form.usermod_stdin.value = "";
+ this.form.usermod_pwonly.checked = true;
+ '>
+</UL>
+
+The following variables are available for interpolation (prefixed with
+<code>new_</code> or <code>old_</code> for replace operations):
+<UL>
+ <LI><code>$username</code>
+ <LI><code>$domain</code>
+ <LI><code>$_password</code>
+ <LI><code>$quoted_password</code> - unencrypted password quoted for the shell
+ <LI><code>$crypt_password</code> - encrypted password
+ <LI><code>$uid</code>
+ <LI><code>$gid</code>
+ <LI><code>$finger</code> - GECOS, already quoted for the shell (do not add additional quotes)
+ <LI><code>$first</code> - First name of GECOS, already quoted for the shell (do not add additional quotes)
+ <LI><code>$last</code> - Last name of GECOS, already quoted for the shell (do not add additional quotes)
+ <LI><code>$dir</code> - home directory
+ <LI><code>$shell</code>
+ <LI><code>$quota</code>
+ <LI><code>@radius_groups</code>
+ <LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available.
+</UL>
+END
+);
+
+1;
+
package FS::part_export::sqlmail;
-use vars qw(@ISA);
+use vars qw(@ISA %info);
+use Tie::IxHash;
use Digest::MD5 qw(md5_hex);
use FS::Record qw(qsearchs);
use FS::part_export;
@ISA = qw(FS::part_export);
+tie my %options, 'Tie::IxHash',
+ 'datasrc' => { label => 'DBI data source' },
+ 'username' => { label => 'Database username' },
+ 'password' => { label => 'Database password' },
+ 'server_type' => {
+ label => 'Server type',
+ type => 'select',
+ options => [qw(dovecot_plain dovecot_crypt dovecot_digest_md5 courier_plain
+ courier_crypt)],
+ default => ['dovecot_plain'], },
+ 'svc_acct_table' => { label => 'User Table', default => 'user_acct' },
+ 'svc_forward_table' => { label => 'Forward Table', default => 'forward' },
+ 'svc_domain_table' => { label => 'Domain Table', default => 'domain' },
+ 'svc_acct_fields' => { label => 'svc_acct Export Fields',
+ default => 'username _password domsvc svcnum' },
+ 'svc_forward_fields' => { label => 'svc_forward Export Fields',
+ default => 'domain svcnum catchall' },
+ 'svc_domain_fields' => { label => 'svc_domain Export Fields',
+ default => 'srcsvc dstsvc dst' },
+ 'resolve_dstsvc' => { label => q{Resolve svc_forward.dstsvc to an email address and store it in dst. (Doesn't require that you also export dstsvc.)},
+ type => 'checkbox' },
+;
+
+%info = (
+ 'svc' => [qw( svc_acct svc_domain svc_forward )],
+ 'desc' => 'Real-time export to SQL-backed mail server',
+ 'options' => \%options,
+ 'nodomain' => '',
+ 'notes' => <<'END'
+Database schema can be made to work with Courier IMAP, Exim and Dovecot.
+Others could work but are untested. (more detailed description from
+Kristian / fire2wire? )
+END
+);
+
sub rebless { shift; }
sub _export_insert {
}
+1;
+
package FS::part_export::sqlradius;
-use vars qw(@ISA);
+use vars qw(@ISA %info %options $notes1 $notes2);
+use Tie::IxHash;
use FS::Record qw( dbh );
use FS::part_export;
@ISA = qw(FS::part_export);
+tie %options, 'Tie::IxHash',
+ 'datasrc' => { label=>'DBI data source ' },
+ 'username' => { label=>'Database username' },
+ 'password' => { label=>'Database password' },
+ 'ignore_accounting' => {
+ type => 'checkbox',
+ label=>'Ignore accounting records from this database'
+ },
+;
+
+$notes1 = <<'END';
+Real-time export of radcheck, radreply and usergroup tables to any SQL database
+for <a href="http://www.freeradius.org/">FreeRADIUS</a>,
+<a href="http://radius.innercite.com/">ICRADIUS</a>
+or <a href="http://www.open.com.au/radiator/">Radiator</a>.
+END
+
+$notes2 = <<'END';
+An existing RADIUS database will be updated in realtime, but you can use
+<a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
+to delete the entire RADIUS database and repopulate the tables from the
+Freeside database. See the
+<a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
+and the
+<a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
+for the exact syntax of a DBI data source.
+<ul>
+ <li>Using FreeRADIUS 0.9.0 with the PostgreSQL backend, the db_postgresql.sql schema and postgresql.conf queries contain incompatible changes. This is fixed in 0.9.1. Only new installs with 0.9.0 and PostgreSQL are affected - upgrades and other database backends and versions are unaffected.
+ <li>Using ICRADIUS, add a dummy "op" column to your database:
+ <blockquote><code>
+ ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
+ ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
+ ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br>
+ ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='
+ </code></blockquote>
+ <li>Using Radiator, see the
+ <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a>
+ for configuration information.
+</ul>
+END
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS, Radiator)',
+ 'options' => \%options,
+ 'nodomain' => 'Y',
+ 'notes' => $notes1.
+ 'This export does not export RADIUS realms (see also '.
+ 'sqlradius_withdomain). '.
+ $notes2
+);
+
sub rebless { shift; }
sub export_username {
DBI->connect(@_) or die $DBI::errstr;
}
+1;
+
package FS::part_export::sqlradius_withdomain;
-use vars qw(@ISA);
+use vars qw(@ISA %info);
+use Tie::IxHash;
use FS::part_export::sqlradius;
+tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS, Radiator) with realms',
+ 'options' => \%options,
+ 'nodomain' => '',
+ 'notes' => $FS::part_export::sqlradius::notes1.
+ 'This export exports domains to RADIUS realms (see also '.
+ 'sqlradius). '.
+ $FS::part_export::sqlradius::notes2
+);
+
@ISA = qw(FS::part_export::sqlradius);
sub export_username {
$svc_acct->email;
}
+1;
+
package FS::part_export::sysvshell;
-use vars qw(@ISA);
-use FS::part_export::null;
+use vars qw(@ISA %info);
+use Tie::IxHash;
+use FS::part_export::passwdfile;
-@ISA = qw(FS::part_export::null);
+@ISA = qw(FS::part_export::passwdfile);
+
+tie my %options, 'Tie::IxHash', %FS::part_export::passwdfile::options;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' =>
+ 'Batch export of /etc/passwd and /etc/shadow files (Linux, Solaris)',
+ 'options' => \%options,
+ 'nodomain' => 'Y',
+ 'notes' => <<'END'
+MD5 crypt requires installation of
+<a href="http://search.cpan.org/dist/Crypt-PasswdMD5">Crypt::PasswdMD5</a>
+from CPAN. Run bin/sysvshell.export to export the files.
+END
+);
+
+1;
package FS::part_export::textradius;
-use vars qw(@ISA $prefix);
+use vars qw(@ISA %info $prefix);
use Fcntl qw(:flock);
+use Tie::IxHash;
use FS::UID qw(datasrc);
use FS::part_export;
@ISA = qw(FS::part_export);
+tie my %options, 'Tie::IxHash',
+ 'user' => { label=>'Remote username', default=>'root' },
+ 'users' => { label=>'users file location', default=>'/etc/raddb/users' },
+;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' =>
+ 'Real-time export to a text /etc/raddb/users file (Livingston, Cistron)',
+ 'options' => \%options,
+ 'notes' => <<'END'
+This will edit a text RADIUS users file in place on a remote server.
+Requires installation of
+<a href="http://search.cpan.org/dist/RADIUS-UserFile">RADIUS::UserFile</a>
+from CPAN. If using RADIUS::UserFile 1.01, make sure to apply
+<a href="http://rt.cpan.org/NoAuth/Bug.html?id=1210">this patch</a>. Also
+make sure <a href="http://rsync.samba.org/">rsync</a> is installed on the
+remote machine, and <a href="../docs/ssh.html">SSH is setup for unattended
+operation</a>.
+END
+);
+
$prefix = "/usr/local/etc/freeside/export.";
sub rebless { shift; }
}
+1;
+
package FS::part_export::vpopmail;
-use vars qw(@ISA @saltset $exportdir);
+use vars qw(@ISA %info @saltset $exportdir);
use Fcntl qw(:flock);
+use Tie::IxHash;
use File::Path;
use FS::UID qw( datasrc );
use FS::part_export;
@ISA = qw(FS::part_export);
+tie my %options, 'Tie::IxHash',
+ #'machine' => { label=>'vpopmail machine', },
+ 'dir' => { label=>'directory', }, # ?more info? default?
+ 'uid' => { label=>'vpopmail uid' },
+ 'gid' => { label=>'vpopmail gid' },
+ 'restart' => { label=> 'vpopmail restart command',
+ default=> 'cd /home/vpopmail/domains; for domain in *; do /home/vpopmail/bin/vmkpasswd $domain; done; /var/qmail/bin/qmail-newu; killall -HUP qmail-send',
+ },
+;
+
+%info = (
+ 'svc' => 'svc_acct',
+ 'desc' => 'Real-time export to vpopmail text files',
+ 'options' => \%options,
+ 'notes' => <<'END'
+This export is currently unmaintained. See shellcommands_withdomain for an
+export that uses vpopmail CLI commands instead.<BR>
+<BR>
+Real time export to <a href="http://inter7.com/vpopmail/">vpopmail</a> text
+files. <a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a>
+must be installed, and you will need to
+<a href="../docs/ssh.html">setup SSH for unattended operation</a>
+to <b>vpopmail</b>@<i>export.host</i>.
+END
+);
+
@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
sub rebless { shift; }
ssh("vpopmail\@$machine", $restart) if $restart;
}
+1;
package FS::part_export::www_shellcommands;
use strict;
-use vars qw(@ISA);
+use vars qw(@ISA %info);
+use Tie::IxHash;
use FS::part_export;
@ISA = qw(FS::part_export);
+tie my %options, 'Tie::IxHash',
+ 'user' => { label=>'Remote username', default=>'root' },
+ 'useradd' => { label=>'Insert command',
+ default=>'mkdir $homedir/$zone; chown $username $homedir/$zone; ln -s $homedir/$zone /var/www/$zone',
+ },
+ 'userdel' => { label=>'Delete command',
+ default=>'[ -n "$zone" ] && rm -rf /var/www/$zone; rm -rf $homedir/$zone',
+ },
+ 'usermod' => { label=>'Modify command',
+ default=>'[ -n "$old_zone" ] && rm /var/www/$old_zone; [ "$old_zone" != "$new_zone" -a -n "$new_zone" ] && ( mv $old_homedir/$old_zone $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone ); [ "$old_username" != "$new_username" ] && chown -R $new_username $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone',
+ },
+;
+
+%info = (
+ 'svc' => 'svc_www',
+ 'desc' => 'Run remote commands via SSH, for virtual web sites.',
+ 'options' => \%options,
+ 'notes' => <<'END'
+Run remote commands via SSH, for virtual web sites. You will need to
+<a href="../docs/ssh.html">setup SSH for unattended operation</a>.
+<BR><BR>Use these buttons for some useful presets:
+<UL>
+ <LI>
+ <INPUT TYPE="button" VALUE="Maintain directories" onClick='
+ this.form.user.value = "root";
+ this.form.useradd.value = "mkdir $homedir/$zone; chown $username $homedir/$zone; ln -s $homedir/$zone /var/www/$zone";
+ this.form.userdel.value = "[ -n \"$zone\" ] && rm -rf /var/www/$zone; rm -rf $homedir/$zone";
+ this.form.usermod.value = "[ -n \"$old_zone\" ] && rm /var/www/$old_zone; [ \"$old_zone\" != \"$new_zone\" -a -n \"$new_zone\" ] && ( mv $old_homedir/$old_zone $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone ); [ \"$old_username\" != \"$new_username\" ] && chown -R $new_username $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone";
+ '>
+ <LI>
+ <INPUT TYPE="button" VALUE="ISPMan CLI" onClick='
+ this.form.user.value = "root";
+ this.form.useradd.value = "/usr/local/ispman/bin/ispman.addvhost -d $domain $bare_zone";
+ this.form.userdel.value = "/usr/local/ispman/bin/ispman.deletevhost -d $domain $bare_zone";
+ this.form.usermod.value = "";
+ '>
+</UL>
+The following variables are available for interpolation (prefixed with
+<code>new_</code> or <code>old_</code> for replace operations):
+<UL>
+ <LI><code>$zone</code> - fully-qualified zone of this virtual host
+ <LI><code>$bare_zone</code> - just the zone of this virtual host, without the domain portion
+ <LI><code>$domain</code> - base domain
+ <LI><code>$username</code>
+ <LI><code>$homedir</code>
+ <LI>All other fields in <a href="../docs/schema.html#svc_www">svc_www</a>
+ are also available.
+</UL>
+END
+);
+
+
sub rebless { shift; }
sub _export_insert {
}
my $domain_record = $svc_www->domain_record; # or die ?
my $zone = $domain_record->zone; # or die ?
+ my $domain = $domain_record->svc_domain->domain;
+ ( my $bare_zone = $zone ) =~ s/\.$domain$//;
my $svc_acct = $svc_www->svc_acct; # or die ?
my $username = $svc_acct->username;
my $homedir = $svc_acct->dir; # or die ?
${"new_$_"} = $new->getfield($_) foreach $new->fields;
}
my $old_domain_record = $old->domain_record; # or die ?
- my $old_zone = $old_domain_record->reczone; # or die ?
- unless ( $old_zone =~ /\.$/ ) {
- my $old_svc_domain = $old_domain_record->svc_domain; # or die ?
- $old_zone .= '.'. $old_svc_domain->domain;
- }
-
+ my $old_zone = $old_domain_record->zone; # or die ?
+ my $old_domain = $old_domain_record->svc_domain->domain;
+ ( my $old_bare_zone = $old_zone ) =~ s/\.$old_domain$//;
my $old_svc_acct = $old->svc_acct; # or die ?
my $old_username = $old_svc_acct->username;
my $old_homedir = $old_svc_acct->dir; # or die ?
my $new_domain_record = $new->domain_record; # or die ?
- my $new_zone = $new_domain_record->reczone; # or die ?
- unless ( $new_zone =~ /\.$/ ) {
- my $new_svc_domain = $new_domain_record->svc_domain; # or die ?
- $new_zone .= '.'. $new_svc_domain->domain;
- }
-
+ my $new_zone = $new_domain_record->zone; # or die ?
+ my $new_domain = $new_domain_record->svc_domain->domain;
+ ( my $new_bare_zone = $new_zone ) =~ s/\.$new_domain$//;
my $new_svc_acct = $new->svc_acct; # or die ?
my $new_username = $new_svc_acct->username;
my $new_homedir = $new_svc_acct->dir; # or die ?
}
sub ssh_cmd { #subroutine, not method
- use Net::SSH '0.07';
+ use Net::SSH '0.08';
&Net::SSH::ssh_cmd( { @_ } );
}
package FS::part_pkg;
use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch dbh );
+use vars qw( @ISA $DEBUG );
+use FS::Conf;
+use FS::Record qw( qsearch qsearchs dbh dbdef );
use FS::pkg_svc;
+use FS::part_svc;
+use FS::cust_pkg;
use FS::agent_type;
use FS::type_pkgs;
-use FS::Conf;
@ISA = qw( FS::Record );
+$DEBUG = 0;
+
=head1 NAME
FS::part_pkg - Object methods for part_pkg objects
new $class ( \%hash ); # ?
}
-=item insert
+=item insert [ , OPTION => VALUE ... ]
Adds this billing item definition to the database. If there is an error,
returns the error, otherwise returns false.
+Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg> and
+I<custnum_ref>.
+
+If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
+values, appropriate FS::pkg_svc records will be inserted.
+
+If I<primary_svc> is set to the svcpart of the primary service, the appropriate
+FS::pkg_svc record will be updated.
+
+If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg
+record itself), the object will be updated to point to this package definition.
+
+In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
+the scalar will be updated with the custnum value from the cust_pkg record.
+
=cut
sub insert {
my $self = shift;
-
+ my %options = @_;
+ warn "FS::part_pkg::insert called on $self with options %options" if $DEBUG;
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
}
}
+ warn " inserting pkg_svc records" if $DEBUG;
+ my $pkg_svc = $options{'pkg_svc'} || {};
+ foreach my $part_svc ( qsearch('part_svc', {} ) ) {
+ my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
+ my $primary_svc = $options{'primary_svc'} == $part_svc->svcpart ? 'Y' : '';
+
+ my $pkg_svc = new FS::pkg_svc( {
+ 'pkgpart' => $self->pkgpart,
+ 'svcpart' => $part_svc->svcpart,
+ 'quantity' => $quantity,
+ 'primary_svc' => $primary_svc,
+ } );
+ my $error = $pkg_svc->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ if ( $options{'cust_pkg'} ) {
+ warn " updating cust_pkg record " if $DEBUG;
+ my $old_cust_pkg =
+ ref($options{'cust_pkg'})
+ ? $options{'cust_pkg'}
+ : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } );
+ ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum
+ if $options{'custnum_ref'};
+ my %hash = $old_cust_pkg->hash;
+ $hash{'pkgpart'} = $self->pkgpart,
+ my $new_cust_pkg = new FS::cust_pkg \%hash;
+ local($FS::cust_pkg::disable_agentcheck) = 1;
+ my $error = $new_cust_pkg->replace($old_cust_pkg);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error modifying cust_pkg record: $error";
+ }
+ }
+
+ warn " commiting transaction" if $DEBUG;
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
# check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
}
-=item replace OLD_RECORD
+=item replace OLD_RECORD [ , OPTION => VALUE ... ]
Replaces OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
+Currently available options are: I<pkg_svc> and I<primary_svc>
+
+If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
+values, the appropriate FS::pkg_svc records will be replace.
+
+If I<primary_svc> is set to the svcpart of the primary service, the appropriate
+FS::pkg_svc record will be updated.
+
+=cut
+
+sub replace {
+ my( $new, $old ) = ( shift, shift );
+ my %options = @_;
+ warn "FS::part_pkg::replace called on $new to replace $old ".
+ "with options %options"
+ if $DEBUG;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ warn " replacing part_pkg record" if $DEBUG;
+ my $error = $new->SUPER::replace($old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ warn " replacing pkg_svc records" if $DEBUG;
+ my $pkg_svc = $options{'pkg_svc'} || {};
+ foreach my $part_svc ( qsearch('part_svc', {} ) ) {
+ my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
+ my $primary_svc = $options{'primary_svc'} == $part_svc->svcpart ? 'Y' : '';
+
+ my $old_pkg_svc = qsearchs('pkg_svc', {
+ 'pkgpart' => $old->pkgpart,
+ 'svcpart' => $part_svc->svcpart,
+ } );
+ my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0;
+ my $old_primary_svc =
+ ( $old_pkg_svc && $old_pkg_svc->dbdef_table->column('primary_svc') )
+ ? $old_pkg_svc->primary_svc
+ : '';
+ next unless $old_quantity != $quantity || $old_primary_svc ne $primary_svc;
+
+ my $new_pkg_svc = new FS::pkg_svc( {
+ 'pkgpart' => $new->pkgpart,
+ 'svcpart' => $part_svc->svcpart,
+ 'quantity' => $quantity,
+ 'primary_svc' => $primary_svc,
+ } );
+ my $error = $old_pkg_svc
+ ? $new_pkg_svc->replace($old_pkg_svc)
+ : $new_pkg_svc->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ warn " commiting transaction" if $DEBUG;
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+}
+
=item check
Checks all fields to make sure this is a valid billing item definition. If
=item svcpart [ SVCDB ]
-Returns the svcpart of a single service definition (see L<FS::part_svc>)
+Returns the svcpart of the primary service definition (see L<FS::part_svc>)
associated with this billing item definition (see L<FS::pkg_svc>). Returns
-false if there not exactly one service definition with quantity 1, or if
-SVCDB is specified and does not match the svcdb of the service definition,
+false if there not a primary service definition or exactly one service
+definition with quantity 1, or if SVCDB is specified and does not match the
+svcdb of the service definition,
=cut
sub svcpart {
my $self = shift;
my $svcdb = scalar(@_) ? shift : '';
- my @pkg_svc = grep {
- $_->quantity == 1
- && ( $svcdb eq $_->part_svc->svcdb || !$svcdb )
- } $self->pkg_svc;
+ my @svcdb_pkg_svc =
+ grep { ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) } $self->pkg_svc;
+ my @pkg_svc = ();
+ @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc
+ if dbdef->table('pkg_svc')->column('primary_svc');
+ @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
+ unless @pkg_svc;
return '' if scalar(@pkg_svc) != 1;
$pkg_svc[0]->svcpart;
}
=back
-=head1 VERSION
-
-$Id: part_pop_local.pm,v 1.1 2001-09-26 09:17:06 ivan Exp $
-
=head1 BUGS
US/CA-centric.
use FS::part_svc_column;
use FS::part_export;
use FS::export_svc;
+use FS::cust_svc;
@ISA = qw(FS::Record);
$record = new FS::part_svc { 'column' => 'value' };
$error = $record->insert;
+ $error = $record->insert( [ 'pseudofield' ] );
+ $error = $record->insert( [ 'pseudofield' ], \%exportnums );
$error = $new_record->replace($old_record);
+ $error = $new_record->replace($old_record, '1.3-COMPAT', [ 'pseudofield' ] );
+ $error = $new_record->replace($old_record, '1.3-COMPAT', [ 'pseudofield' ], \%exportnums );
$error = $record->delete;
sub table { 'part_svc'; }
-=item insert EXTRA_FIELDS_ARRAYREF
+=item insert [ EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF ] ]
Adds this service definition to the database. If there is an error, returns
the error, otherwise returns false.
-TODOC:
+The following pseudo-fields may be defined, and will be maintained in
+the part_svc_column table appropriately (see L<FS::part_svc_column>).
+
+=over 4
=item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed
-TODOC: EXTRA_FIELDS_ARRAYREF
+=back
+
+If you want to add part_svc_column records for fields that do not exist as
+(real or virtual) fields in the I<svcdb> table, make sure to list then in
+EXTRA_FIELDS_ARRAYREF also.
+
+If EXPORTNUMS_HASHREF is specified (keys are exportnums and values are
+boolean), the appopriate export_svc records will be inserted.
=cut
sub insert {
my $self = shift;
my @fields = ();
+ my @exportnums = ();
@fields = @{shift(@_)} if @_;
+ if ( @_ ) {
+ my $exportnums = shift;
+ @exportnums = grep $exportnums->{$_}, keys %$exportnums;
+ }
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
return $error;
}
+ # add part_svc_column records
+
my $svcdb = $self->svcdb;
# my @rows = map { /^${svcdb}__(.*)$/; $1 }
# grep ! /_flag$/,
}
+ # add export_svc records
+
+ foreach my $exportnum ( @exportnums ) {
+ my $export_svc = new FS::export_svc ( {
+ 'exportnum' => $exportnum,
+ 'svcpart' => $self->svcpart,
+ } );
+ $error = $export_svc->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
=item delete
-Currently unimplemented.
+Currently unimplemented. Set the "disabled" field instead.
=cut
# check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)?
}
-=item replace OLD_RECORD [ '1.3-COMPAT' [ , EXTRA_FIELDS_ARRAYREF ] ]
+=item replace OLD_RECORD [ '1.3-COMPAT' [ , EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF ] ] ]
Replaces OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
TODOC: 1.3-COMPAT
-TODOC: EXTRA_FIELDS_ARRAYREF
+TODOC: EXTRA_FIELDS_ARRAYREF (same as insert method)
=cut
shift;
my @fields = ();
@fields = @{shift(@_)} if @_;
+ my $exportnums = @_ ? shift : '';
+
+ # maintain part_svc_column records
my $svcdb = $new->svcdb;
foreach my $field (
return $error;
}
}
+
+ # maintain export_svc records
+
+ if ( $exportnums ) {
+
+ #false laziness w/ edit/process/agent_type.cgi
+ foreach my $part_export ( qsearch('part_export', {}) ) {
+ my $exportnum = $part_export->exportnum;
+ my $hashref = {
+ 'exportnum' => $exportnum,
+ 'svcpart' => $new->svcpart,
+ };
+ my $export_svc = qsearchs('export_svc', $hashref);
+
+ if ( $export_svc && ! $exportnums->{$exportnum} ) {
+ $error = $export_svc->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ } elsif ( ! $export_svc && $exportnums->{$exportnum} ) {
+ $export_svc = new FS::export_svc ( $hashref );
+ $error = $export_svc->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ }
+
+ }
+
} else {
$dbh->rollback if $oldAutoCommit;
return 'non-1.3-COMPAT interface not yet written';
qsearch('export_svc', { 'svcpart' => $self->svcpart } );
}
+=item cust_svc
+
+Returns a list of associated FS::cust_svc records.
+
+=cut
+
+sub cust_svc {
+ my $self = shift;
+ qsearch('cust_svc', { 'svcpart' => $self->svcpart } );
+}
+
+=item svc_x
+
+Returns a list of associated FS::svc_* records.
+
+=cut
+
+sub svc_x {
+ my $self = shift;
+ map { $_->svc_x } $self->cust_svc;
+}
+
=back
=head1 BUGS
=back
-=head1 VERSION
-
-$Id: part_svc_column.pm,v 1.1 2001-09-07 20:49:15 ivan Exp $
-
=head1 BUGS
=head1 SEE ALSO
=item quantity - Quantity of this service definition that this billing item
definition includes
+=item primary_svc - primary flag, empty or 'Y'
+
=back
=head1 METHODS
return "Unknown pkgpart!" unless $self->part_pkg;
return "Unknown svcpart!" unless $self->part_svc;
+ if ( $self->dbdef_table->column('primary_svc') ) {
+ $error = $self->ut_enum('primary_svc', [ '', 'Y' ] );
+ return $error if $error;
+ }
+
''; #no error
}
=back
-=head1 VERSION
-
-$Id: pkg_svc.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
-
=head1 BUGS
=head1 SEE ALSO
=back
-=head1 VERSION
-
-$Id: port.pm,v 1.5 2001-02-14 04:33:06 ivan Exp $
-
=head1 BUGS
The author forgot to customize this manpage.
package FS::queue;
use strict;
-use vars qw( @ISA @EXPORT_OK $conf $jobnums);
+use vars qw( @ISA @EXPORT_OK $DEBUG $conf $jobnums);
use Exporter;
use FS::UID;
use FS::Conf;
@ISA = qw(FS::Record);
@EXPORT_OK = qw( joblisting );
+$DEBUG = 0;
+#$DEBUG = 1;
+
$FS::UID::callback{'FS::queue'} = sub {
$conf = new FS::Conf;
};
}
}
- push @$jobnums, $self->jobnum if $jobnums;
+ if ( $jobnums ) {
+ warn "jobnums global is active: $jobnums\n" if $DEBUG;
+ push @$jobnums, $self->jobnum;
+ }
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
=item queue_depend
Returns the FS::queue_depend objects associated with this job, if any.
+(Dependancies that must complete before this job can be run).
=cut
qsearch('queue_depend', { 'jobnum' => $self->jobnum } );
}
-
=item depend_insert OTHER_JOBNUM
Inserts a dependancy for this job - it will not be run until the other job
$queue_depend->insert;
}
+=item queue_depended
+
+Returns the FS::queue_depend objects that associate other jobs with this job,
+if any. (The jobs that are waiting for this job to complete before they can
+run).
+
+=cut
+
+sub queue_depended {
+ my $self = shift;
+ qsearch('queue_depend', { 'depend_jobnum' => $self->jobnum } );
+}
+
+=item depended_delete
+
+Deletes the other queued jobs (FS::queue objects) that are waiting for this
+job, if any. If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub depended_delete {
+ my $self = shift;
+ my $error;
+ foreach my $job (
+ map { qsearchs('queue', { 'jobnum' => $_->jobnum } ) } $self->queue_depended
+ ) {
+ $error = $job->depended_delete;
+ return $error if $error;
+ $error = $job->delete;
+ return $error if $error
+ }
+}
+
=back
=head1 SUBROUTINES
my $args;
if ( $dangerous || $queue->job !~ /^FS::part_export::/ || !$noactions ) {
- $args = encode_entities( join(' ',
- map { length($_)<54 ? $_ : substr($_,0,32)."..." } $queue->args #1&g
- ) );
+ $args = encode_entities( join(' ', $queue->args) );
} else {
$args = '';
}
=back
-=head1 VERSION
-
-$Id: queue.pm,v 1.15 2002-07-02 06:48:59 ivan Exp $
-
=head1 BUGS
$jobnums global
=back
-=head1 VERSION
-
-$Id: queue_arg.pm,v 1.1 2001-09-11 00:08:18 ivan Exp $
-
=head1 BUGS
=head1 SEE ALSO
=back
-=head1 VERSION
-
-$Id: session.pm,v 1.7 2001-04-15 13:35:12 ivan Exp $
-
=head1 BUGS
Maybe you shouldn't be able to insert a session if there's currently an open
package FS::svc_Common;
use strict;
-use vars qw( @ISA $noexport_hack );
+use vars qw( @ISA $noexport_hack $DEBUG );
use FS::Record qw( qsearchs fields dbh );
use FS::cust_svc;
use FS::part_svc;
@ISA = qw( FS::Record );
+$DEBUG = 0;
+#$DEBUG = 1;
+
=head1 NAME
FS::svc_Common - Object method for all svc_ records
=over 4
-=item insert [ JOBNUM_ARRAYREF [ OBJECTS_ARRAYREF ] ]
+=item insert [ , OPTION => VALUE ... ]
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
defined. An FS::cust_svc record will be created and inserted.
-If an arrayref is passed as parameter, the B<jobnum>s of any export jobs will
-be added to the array.
+Currently available options are: I<jobnums>, I<child_objects> and
+I<depend_jobnum>.
+
+If I<jobnum> is set to an array reference, the jobnums of any export jobs will
+be added to the referenced array.
+
+If I<child_objects> is set to an array reference of FS::tablename objects (for
+example, FS::acct_snarf objects), they will have their svcnum fieldsset and
+will be inserted after this record, but before any exports are run.
-If an arrayref of FS::tablename objects (for example, FS::acct_snarf objects)
-is passed as the optional second parameter, they will have their svcnum fields
-set and will be inserted after this record, but before any exports are run.
+If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
+jobnums), all provisioning jobs will have a dependancy on the supplied
+jobnum(s) (they will not run until the specific job(s) complete(s)).
=cut
sub insert {
my $self = shift;
- local $FS::queue::jobnums = shift if @_;
- my $objects = scalar(@_) ? shift : [];
+ my %options = @_;
+ warn "FS::svc_Common::insert called with options ".
+ join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
+ if $DEBUG;
+
+ my @jobnums = ();
+ local $FS::queue::jobnums = \@jobnums;
+ warn "FS::svc_Common::insert: set \$FS::queue::jobnums to $FS::queue::jobnums"
+ if $DEBUG;
+ my $objects = $options{'child_objects'} || [];
+ my $depend_jobnums = $options{'depend_jobnum'} || [];
+ $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
my $error;
local $SIG{HUP} = 'IGNORE';
#new-style exports!
unless ( $noexport_hack ) {
+
+ warn "FS::svc_Common::insert: \$FS::queue::jobnums is $FS::queue::jobnums"
+ if $DEBUG;
+
foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
my $error = $part_export->export_insert($self);
if ( $error ) {
" (transaction rolled back): $error";
}
}
+
+ foreach my $depend_jobnum ( @$depend_jobnums ) {
+ warn "inserting dependancies on supplied job $depend_jobnum\n"
+ if $DEBUG;
+ foreach my $jobnum ( @jobnums ) {
+ my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
+ warn "inserting dependancy for job $jobnum on $depend_jobnum\n"
+ if $DEBUG;
+ my $error = $queue->depend_insert($depend_jobnum);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error queuing job dependancy: $error";
+ }
+ }
+ }
+
+ }
+
+ if ( exists $options{'jobnums'} ) {
+ push @{ $options{'jobnums'} }, @jobnums;
}
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
sub cancel { ''; }
-=back
+=item clone_suspended
-=head1 VERSION
+Constructor used by FS::part_export::_export_suspend fallback. Stub returning
+same object for svc_ classes which don't implement a suspension fallback
+(everything except svc_acct at the moment). Document better.
-$Id: svc_Common.pm,v 1.12.4.4 2003-11-12 12:29:55 ivan Exp $
+=cut
+
+sub clone_suspended {
+ shift;
+}
+
+=item clone_kludge_unsuspend
+
+Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning
+same object for svc_ classes which don't implement a suspension fallback
+(everything except svc_acct at the moment). Document better.
+
+=cut
+
+sub clone_kludge_unsuspend {
+ shift;
+}
+
+=back
=head1 BUGS
$username_ampersand $username_letter $username_letterfirst
$username_noperiod $username_nounderscore $username_nodash
$username_uppercase
+ $password_noampersand $password_noexclamation
$mydomain
$welcome_template $welcome_from $welcome_subject $welcome_mimetype
$smtpmachine
@saltset @pw_set );
use Carp;
use Fcntl qw(:flock);
+use Crypt::PasswdMD5;
use FS::UID qw( datasrc );
use FS::Conf;
use FS::Record qw( qsearch qsearchs fields dbh dbdef );
use FS::export_svc;
use FS::part_export;
use FS::Msgcat qw(gettext);
+use FS::svc_forward;
+use FS::svc_www;
@ISA = qw( FS::svc_Common );
$DEBUG = 0;
+#$DEBUG = 1;
$me = '[FS::svc_acct]';
#ask FS::UID to run this stuff for us later
$username_nodash = $conf->exists('username-nodash');
$username_uppercase = $conf->exists('username-uppercase');
$username_ampersand = $conf->exists('username-ampersand');
+ $password_noampersand = $conf->exists('password-noexclamation');
+ $password_noexclamation = $conf->exists('password-noexclamation');
$mydomain = $conf->config('domain');
$dirhash = $conf->config('dirhash') || 0;
if ( $conf->exists('welcome_email') ) {
sub table { 'svc_acct'; }
-=item insert
+=item insert [ , OPTION => VALUE ... ]
Adds this account to the database. If there is an error, returns the error,
otherwise returns false.
defined. An FS::cust_svc record will be created and inserted.
The additional field I<usergroup> can optionally be defined; if so it should
-contain an arrayref of group names. See L<FS::radius_usergroup>. (used in
-sqlradius export only)
+contain an arrayref of group names. See L<FS::radius_usergroup>.
The additional field I<child_objects> can optionally be defined; if so it
should contain an arrayref of FS::tablename objects. They will have their
svcnum fields set and will be inserted after this record, but before any
exports are run.
+Currently available options are: I<depend_jobnum>
+
+If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
+jobnums), all provisioning jobs will have a dependancy on the supplied
+jobnum(s) (they will not run until the specific job(s) complete(s)).
+
(TODOC: L<FS::queue> and L<freeside-queued>)
(TODOC: new exports!)
-
=cut
sub insert {
my $self = shift;
+ my %options = @_;
my $error;
local $SIG{HUP} = 'IGNORE';
$error = $self->check;
return $error if $error;
- #no, duplicate checking just got a whole lot more complicated
- #(perhaps keep this check with a config option to turn on?)
-
- #return gettext('username_in_use'). ": ". $self->username
- # if qsearchs( 'svc_acct', { 'username' => $self->username,
- # 'domsvc' => $self->domsvc,
- # } );
-
if ( $self->svcnum && qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) ) {
my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
unless ( $cust_svc ) {
$self->svcpart($cust_svc->svcpart);
}
- #new duplicate username checking
-
- my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
- unless ( $part_svc ) {
+ $error = $self->_check_duplicate;
+ if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- return 'unknown svcpart '. $self->svcpart;
- }
-
- my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } );
- my @dup_userdomain = qsearch( 'svc_acct', { 'username' => $self->username,
- 'domsvc' => $self->domsvc } );
- my @dup_uid;
- if ( $part_svc->part_svc_column('uid')->columnflag ne 'F'
- && $self->username !~ /^(toor|(hyla)?fax)$/ ) {
- @dup_uid = qsearch( 'svc_acct', { 'uid' => $self->uid } );
- } else {
- @dup_uid = ();
- }
-
- if ( @dup_user || @dup_userdomain || @dup_uid ) {
- my $exports = FS::part_export::export_info('svc_acct');
- my %conflict_user_svcpart;
- my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', );
-
- foreach my $part_export ( $part_svc->part_export ) {
-
- #this will catch to the same exact export
- my @svcparts = map { $_->svcpart }
- qsearch('export_svc', { 'exportnum' => $part_export->exportnum });
-
- #this will catch to exports w/same exporthost+type ???
- #my @other_part_export = qsearch('part_export', {
- # 'machine' => $part_export->machine,
- # 'exporttype' => $part_export->exporttype,
- #} );
- #foreach my $other_part_export ( @other_part_export ) {
- # push @svcparts, map { $_->svcpart }
- # qsearch('export_svc', { 'exportnum' => $part_export->exportnum });
- #}
-
- #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'};
- #silly kludge to avoid uninitialized value errors
- my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} )
- ? $exports->{$part_export->exporttype}{'nodomain'}
- : '';
- if ( $nodomain =~ /^Y/i ) {
- $conflict_user_svcpart{$_} = $part_export->exportnum
- foreach @svcparts;
- } else {
- $conflict_userdomain_svcpart{$_} = $part_export->exportnum
- foreach @svcparts;
- }
- }
-
- foreach my $dup_user ( @dup_user ) {
- my $dup_svcpart = $dup_user->cust_svc->svcpart;
- if ( exists($conflict_user_svcpart{$dup_svcpart}) ) {
- $dbh->rollback if $oldAutoCommit;
- return "duplicate username: conflicts with svcnum ". $dup_user->svcnum.
- " via exportnum ". $conflict_user_svcpart{$dup_svcpart};
- }
- }
-
- foreach my $dup_userdomain ( @dup_userdomain ) {
- my $dup_svcpart = $dup_userdomain->cust_svc->svcpart;
- if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
- $dbh->rollback if $oldAutoCommit;
- return "duplicate username\@domain: conflicts with svcnum ".
- $dup_userdomain->svcnum. " via exportnum ".
- $conflict_userdomain_svcpart{$dup_svcpart};
- }
- }
-
- foreach my $dup_uid ( @dup_uid ) {
- my $dup_svcpart = $dup_uid->cust_svc->svcpart;
- if ( exists($conflict_user_svcpart{$dup_svcpart})
- || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
- $dbh->rollback if $oldAutoCommit;
- return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum.
- " via exportnum ". $conflict_user_svcpart{$dup_svcpart}
- || $conflict_userdomain_svcpart{$dup_svcpart};
- }
- }
-
+ return $error;
}
- #see? i told you it was more complicated
-
my @jobnums;
- $error = $self->SUPER::insert(\@jobnums, $self->child_objects || [] );
+ $error = $self->SUPER::insert(
+ 'jobnums' => \@jobnums,
+ 'child_objects' => $self->child_objects,
+ %options,
+ );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
return "error queuing welcome email: $error";
}
+ if ( $options{'depend_jobnum'} ) {
+ warn "$me depend_jobnum found; adding to welcome email dependancies"
+ if $DEBUG;
+ if ( ref($options{'depend_jobnum'}) ) {
+ warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ).
+ "to welcome email dependancies"
+ if $DEBUG;
+ push @jobnums, @{ $options{'depend_jobnum'} };
+ } else {
+ warn "$me adding job $options{'depend_jobnum'} ".
+ "to welcome email dependancies"
+ if $DEBUG;
+ push @jobnums, $options{'depend_jobnum'};
+ }
+ }
+
foreach my $jobnum ( @jobnums ) {
my $error = $wqueue->depend_insert($jobnum);
if ( $error ) {
if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
return "Can't delete an account with (svc_www) web service!"
- if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } );
+ if qsearch( 'svc_www', { 'usersvc' => $self->svcnum } );
# what about records in session ? (they should refer to history table)
returns the error, otherwise returns false.
The additional field I<usergroup> can optionally be defined; if so it should
-contain an arrayref of group names. See L<FS::radius_usergroup>. (used in
-sqlradius export only)
+contain an arrayref of group names. See L<FS::radius_usergroup>.
+
=cut
}
+ if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
+ $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
+ $error = $new->_check_duplicate;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
$error = $new->SUPER::replace($old);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
sub suspend {
my $self = shift;
return "can't suspend system account" if $self->_check_system;
- my %hash = $self->hash;
- unless ( $hash{_password} =~ /^\*SUSPENDED\* /
- || $hash{_password} eq '*'
- ) {
- $hash{_password} = '*SUSPENDED* '.$hash{_password};
- my $new = new FS::svc_acct ( \%hash );
- my $error = $new->replace($self);
- return $error if $error;
- }
-
$self->SUPER::suspend;
}
unless ( $username_ampersand ) {
$recref->{username} =~ /\&/ and return gettext('illegal_username');
}
+ if ( $password_noampersand ) {
+ $recref->{_password} =~ /\&/ and return gettext('illegal_password');
+ }
+ if ( $password_noexclamation ) {
+ $recref->{_password} =~ /\!/ and return gettext('illegal_password');
+ }
$recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
$recref->{popnum} = $1;
return "Only root can have uid 0"
if $recref->{uid} == 0
- && $recref->{username} ne 'root'
- && $recref->{username} ne 'toor';
-
+ && $recref->{username} !~ /^(root|toor|smtp)$/;
$recref->{dir} =~ /^([\/\w\-\.\&]*)$/
or return "Illegal directory: ". $recref->{dir};
# $error = $self->ut_textn('finger');
# return $error if $error;
+ if ( $self->getfield('finger') eq '' ) {
+ my $cust_pkg = $self->svcnum
+ ? $self->cust_svc->cust_pkg
+ : qsearchs('cust_pkg', { 'pkgnum' => $self->getfield('pkgnum') } );
+ if ( $cust_pkg ) {
+ my $cust_main = $cust_pkg->cust_main;
+ $self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') );
+ }
+ }
$self->getfield('finger') =~
/^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/
or return "Illegal finger: ". $self->getfield('finger');
);
}
+=item _check_duplicate
+
+Internal function to check for duplicates usernames, username@domain pairs and
+uids.
+
+If the I<global_unique-username> configuration value is set to B<username> or
+B<username@domain>, enforces global username or username@domain uniqueness.
+
+In all cases, check for duplicate uids and usernames or username@domain pairs
+per export and with identical I<svcpart> values.
+
+=cut
+
+sub _check_duplicate {
+ my $self = shift;
+
+ #this is Pg-specific. what to do for mysql etc?
+ # ( mysql LOCK TABLES certainly isn't equivalent or useful here :/ )
+ warn "$me locking svc_acct table for duplicate search" if $DEBUG;
+ dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE")
+ or die dbh->errstr;
+ warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG;
+
+ my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
+ unless ( $part_svc ) {
+ return 'unknown svcpart '. $self->svcpart;
+ }
+
+ my $global_unique = $conf->config('global_unique-username');
+
+ my @dup_user = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
+ qsearch( 'svc_acct', { 'username' => $self->username } );
+ return gettext('username_in_use')
+ if $global_unique eq 'username' && @dup_user;
+
+ my @dup_userdomain = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
+ qsearch( 'svc_acct', { 'username' => $self->username,
+ 'domsvc' => $self->domsvc } );
+ return gettext('username_in_use')
+ if $global_unique eq 'username@domain' && @dup_userdomain;
+
+ my @dup_uid;
+ if ( $part_svc->part_svc_column('uid')->columnflag ne 'F'
+ && $self->username !~ /^(toor|(hyla)?fax)$/ ) {
+ @dup_uid = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
+ qsearch( 'svc_acct', { 'uid' => $self->uid } );
+ } else {
+ @dup_uid = ();
+ }
+
+ if ( @dup_user || @dup_userdomain || @dup_uid ) {
+ my $exports = FS::part_export::export_info('svc_acct');
+ my %conflict_user_svcpart;
+ my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', );
+
+ foreach my $part_export ( $part_svc->part_export ) {
+
+ #this will catch to the same exact export
+ my @svcparts = map { $_->svcpart } $part_export->export_svc;
+
+ #this will catch to exports w/same exporthost+type ???
+ #my @other_part_export = qsearch('part_export', {
+ # 'machine' => $part_export->machine,
+ # 'exporttype' => $part_export->exporttype,
+ #} );
+ #foreach my $other_part_export ( @other_part_export ) {
+ # push @svcparts, map { $_->svcpart }
+ # qsearch('export_svc', { 'exportnum' => $part_export->exportnum });
+ #}
+
+ #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'};
+ #silly kludge to avoid uninitialized value errors
+ my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} )
+ ? $exports->{$part_export->exporttype}{'nodomain'}
+ : '';
+ if ( $nodomain =~ /^Y/i ) {
+ $conflict_user_svcpart{$_} = $part_export->exportnum
+ foreach @svcparts;
+ } else {
+ $conflict_userdomain_svcpart{$_} = $part_export->exportnum
+ foreach @svcparts;
+ }
+ }
+
+ foreach my $dup_user ( @dup_user ) {
+ my $dup_svcpart = $dup_user->cust_svc->svcpart;
+ if ( exists($conflict_user_svcpart{$dup_svcpart}) ) {
+ return "duplicate username: conflicts with svcnum ". $dup_user->svcnum.
+ " via exportnum ". $conflict_user_svcpart{$dup_svcpart};
+ }
+ }
+
+ foreach my $dup_userdomain ( @dup_userdomain ) {
+ my $dup_svcpart = $dup_userdomain->cust_svc->svcpart;
+ if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
+ return "duplicate username\@domain: conflicts with svcnum ".
+ $dup_userdomain->svcnum. " via exportnum ".
+ $conflict_userdomain_svcpart{$dup_svcpart};
+ }
+ }
+
+ foreach my $dup_uid ( @dup_uid ) {
+ my $dup_svcpart = $dup_uid->cust_svc->svcpart;
+ if ( exists($conflict_user_svcpart{$dup_svcpart})
+ || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
+ return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum.
+ " via exportnum ". $conflict_user_svcpart{$dup_svcpart}
+ || $conflict_userdomain_svcpart{$dup_svcpart};
+ }
+ }
+
+ }
+
+ return '';
+
+}
=item radius
accessing the columns directly is discouraged, as the column names are
expected to change in the future.
+Internal function to check the username against the list of system usernames
+from the I<system_usernames> configuration value. Returns true if the username
+is listed on the system username list.
+
=cut
sub radius_reply {
$self->cust_svc->attribute_since_sqlradacct(@_);
}
-
=item get_session_history_sqlradacct TIMESTAMP_START TIMESTAMP_END
Returns an array of hash references of this customers login history for the
}
}
+=item clone_suspended
+
+Constructor used by FS::part_export::_export_suspend fallback. Document
+better.
+
+=cut
+
+sub clone_suspended {
+ my $self = shift;
+ my %hash = $self->hash;
+ $hash{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
+ new FS::svc_acct \%hash;
+}
+
+=item clone_kludge_unsuspend
+
+Constructor used by FS::part_export::_export_unsuspend fallback. Document
+better.
+
+=cut
+
+sub clone_kludge_unsuspend {
+ my $self = shift;
+ my %hash = $self->hash;
+ $hash{_password} = '';
+ new FS::svc_acct \%hash;
+}
+
+=item check_password
+
+Checks the supplied password against the (possibly encrypted) password in the
+database. Returns true for a sucessful authentication, false for no match.
+
+Currently supported encryptions are: classic DES crypt() and MD5
+
+=cut
+
+sub check_password {
+ my($self, $check_password) = @_;
+
+ #remove old-style SUSPENDED kludge, they should be allowed to login to
+ #self-service and pay up
+ ( my $password = $self->_password ) =~ s/^\*SUSPENDED\* //;
+
+ #eventually should check a "password-encoding" field
+ if ( $password =~ /^(\*|!!?)$/ ) { #no self-service login
+ return 0;
+ } elsif ( length($password) < 13 ) { #plaintext
+ $check_password eq $password;
+ } elsif ( length($password) == 13 ) { #traditional DES crypt
+ crypt($check_password, $password) eq $password;
+ } elsif ( $password =~ /^\$1\$/ ) { #MD5 crypt
+ unix_md5_crypt($check_password, $password) eq $password;
+ } elsif ( $password =~ /^\$2a?\$/ ) { #Blowfish
+ warn "Can't check password: Blowfish encryption not yet supported, svcnum".
+ $self->svcnum. "\n";
+ 0;
+ } else {
+ warn "Can't check password: Unrecognized encryption for svcnum ".
+ $self->svcnum. "\n";
+ 0;
+ }
+
+}
+
=back
=head1 SUBROUTINES
radius_usergroup_selector? putting web ui components in here? they should
probably live somewhere else...
+insertion of RADIUS group stuff in insert could be done with child_objects now
+(would probably clean up export of them too)
+
=head1 SEE ALSO
L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
=back
-=head1 VERSION
-
-$Id: svc_acct_pop.pm,v 1.7.4.2 2003-07-04 01:37:44 ivan Exp $
-
=head1 BUGS
It should be renamed to part_pop.
=back
-=head1 VERSION
-
-$Id: svc_acct_sm.pm,v 1.5 2001-09-06 20:41:59 ivan Exp $
-
=head1 BUGS
The remote commands should be configurable.
use Mail::Internet 1.44;
use Mail::Header;
use Date::Format;
-use Net::Whois 1.0;
+#use Net::Whois::Raw;
use FS::Record qw(fields qsearch qsearchs dbh);
use FS::Conf;
use FS::svc_Common;
sub table { 'svc_domain'; }
-=item insert
+=item insert [ , OPTION => VALUE ... ]
Adds this domain to the database. If there is an error, returns the error,
otherwise returns false.
appropriate records are added to the domain_record table (see
L<FS::domain_record>).
+Currently available options are: I<depend_jobnum>
+
+If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
+jobnums), all provisioning jobs will have a dependancy on the supplied
+jobnum(s) (they will not run until the specific job(s) complete(s)).
+
=cut
sub insert {
return "Domain not found (see whois)";
}
- $error = $self->SUPER::insert;
+ $error = $self->SUPER::insert(@_);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
" (or unknown registry - try \$whois_hack)";
}
- $recref->{action} =~ /^(M|N)$/ or return "Illegal action";
+ $recref->{action} =~ /^(M|N)$/
+ or return "Illegal action: ". $recref->{action};
$recref->{action} = $1;
if ( $recref->{catchall} ne '' ) {
=item whois
-Returns the Net::Whois::Domain object (see L<Net::Whois>) for this domain, or
-undef if the domain is not found in whois.
+# Returns the Net::Whois::Domain object (see L<Net::Whois>) for this domain, or
+# undef if the domain is not found in whois.
(If $FS::svc_domain::whois_hack is true, returns that in all cases instead.)
=cut
sub whois {
- $whois_hack or new Net::Whois::Domain $_[0]->domain;
+ #$whois_hack or new Net::Whois::Domain $_[0]->domain;
+ $whois_hack or die "whois_hack not set...\n";
}
=item _whois
sub table { 'svc_forward'; }
-=item insert
+=item insert [ , OPTION => VALUE ... ]
Adds this mail forwarding alias to the database. If there is an error, returns
the error, otherwise returns false.
The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
defined. An FS::cust_svc record will be created and inserted.
+Currently available options are: I<depend_jobnum>
+
+If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
+jobnums), all provisioning jobs will have a dependancy on the supplied
+jobnum(s) (they will not run until the specific job(s) complete(s)).
+
=cut
sub insert {
$error = $self->check;
return $error if $error;
- $error = $self->SUPER::insert;
+ $error = $self->SUPER::insert(@_);
if ($error) {
$dbh->rollback if $oldAutoCommit;
return $error;
sub table { 'svc_www'; }
-=item insert
+=item insert [ , OPTION => VALUE ... ]
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
defined. An FS::cust_svc record will be created and inserted.
+Currently available options are: I<depend_jobnum>
+
+If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
+jobnums), all provisioning jobs will have a dependancy on the supplied
+jobnum(s) (they will not run until the specific job(s) complete(s)).
+
+
=cut
sub insert {
$self->recnum($domain_record->recnum);
}
- $error = $self->SUPER::insert;
+ $error = $self->SUPER::insert(@_);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
=back
-=head1 VERSION
-
-$Id: type_pkgs.pm,v 1.1.14.1 2002-10-04 12:56:35 ivan Exp $
-
=head1 BUGS
=head1 SEE ALSO
bin/freeside-sqlradius-radacctd
bin/freeside-sqlradius-reset
bin/freeside-sqlradius-seconds
-bin/freeside-tax-report
FS.pm
FS/CGI.pm
FS/InitHandler.pm
t/part_export-bind.t
t/part_export-bind_slave.t
t/part_export-bsdshell.t
+t/part_export-communigate_pro.t
+t/part_export-communigate_pro_singledomain.t
t/part_export-cp.t
t/part_export-cyrus.t
t/part_export-domain_shellcommands.t
t/part_export-infostreet.t
t/part_export-ldap.t
t/part_export-null.t
+t/part_export-passwdfile.t
+t/part_export-postfix.t
t/part_export-shellcommands.t
t/part_export-shellcommands_withdomain.t
t/part_export-sqlmail.t
adminsuidsetup $user;
-$FS::cust_main::Debug = 1 if $opt_v;
+$FS::cust_main::DEBUG = 1 if $opt_v;
my %search;
$search{'payby'} = $opt_p if $opt_p;
if ( driver_name eq 'Pg' ) {
dbh->{AutoCommit} = 1; #so we can vacuum
- foreach my $statement ( 'vacuum', 'vacuum analyze' ) {
- my $sth = dbh->prepare($statement) or die dbh->errstr;
- $sth->execute or die $sth->errstr;
- }
+ my $sth = dbh->prepare('vacuum analyze') or die dbh->errstr;
+ $sth->execute or die $sth->errstr;
}
#local hack
use POSIX qw(:sys_wait_h setsid);
use Date::Format;
use IO::File;
-use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh);
+use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh myconnect);
use FS::Record qw(qsearch qsearchs);
use FS::queue;
use FS::queue_depend;
$> = $FS::UID::freeside_uid;
$ENV{HOME} = (getpwuid($>))[7]; #for ssh
-adminsuidsetup $user;
+
+$@ = 'not connected';
+while ( $@ ) {
+ eval { adminsuidsetup $user; };
+ if ( $@ ) {
+ warn $@;
+ warn "sleeping for reconnect...\n";
+ sleep 5;
+ }
+}
$log_file = "/usr/local/etc/freeside/queuelog.". $FS::UID::datasrc;
}
$warnkids=0;
- my $nodepend = driver_name eq 'mysql'
- ? ''
- : 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'.
- ' WHERE queue_depend.jobnum = queue.jobnum ) ';
+ unless ( dbh && dbh->ping ) {
+ warn "WARNING: connection to database lost, reconnecting...\n";
+
+ eval { myconnect; };
+
+ unless ( !$@ && dbh && dbh->ping ) {
+ warn "WARNING: still no connection to database, sleeping for retry...\n";
+ sleep 10;
+ next;
+ } else {
+ warn "WARNING: reconnected to database\n";
+ }
+ }
#my($job, $ljob);
#{
# my $oldAutoCommit = $FS::UID::AutoCommit;
# local $FS::UID::AutoCommit = 0;
$FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
+
+ #assuming mysql 4.1 w/subqueries now
+ #my $nodepend = driver_name eq 'mysql'
+ # ? ''
+ # : 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'.
+ # ' WHERE queue_depend.jobnum = queue.jobnum ) ';
+ my $nodepend = 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'.
+ ' WHERE queue_depend.jobnum = queue.jobnum ) ';
+
my $job = qsearchs(
'queue',
{ 'status' => 'new' },
? "$nodepend ORDER BY jobnum LIMIT 1 FOR UPDATE"
: "$nodepend ORDER BY jobnum FOR UPDATE LIMIT 1"
) or do {
- $dbh->commit or die $dbh->errstr; #if $oldAutoCommit;
+ # if $oldAutoCommit {
+ dbh->commit or do {
+ warn "WARNING: database error, closing connection: ". dbh->errstr;
+ undef $FS::UID::dbh;
+ next;
+ };
+ # }
sleep 5; #connecting to db is expensive
next;
};
- if ( driver_name eq 'mysql'
- && qsearch('queue_depend', { 'jobnum' => $job->jobnum } ) ) {
- $dbh->commit or die $dbh->errstr; #if $oldAutoCommit;
- sleep 5; #would be better if mysql could do everything in query above
- next;
- }
+ #assuming mysql 4.1 w/subqueries now
+ #if ( driver_name eq 'mysql'
+ # && qsearch('queue_depend', { 'jobnum' => $job->jobnum } ) ) {
+ # dbh->commit or die dbh->errstr; #if $oldAutoCommit;
+ # sleep 5; #would be better if mysql could do everything in query above
+ # next;
+ #}
my %hash = $job->hash;
$hash{'status'} = 'locked';
my $ljob = new FS::queue ( \%hash );
my $error = $ljob->replace($job);
- die $error if $error;
+ if ( $error ) {
+ warn "WARNING: database error locking job, closing connection: ".
+ dbh->errstr;
+ undef $FS::UID::dbh;
+ next;
+ }
- $dbh->commit or die $dbh->errstr; #if $oldAutoCommit;
+ # if $oldAutoCommit {
+ dbh->commit or do {
+ warn "WARNING: database error, closing connection: ". dbh->errstr;
+ undef $FS::UID::dbh;
+ next;
+ };
+ # }
$FS::UID::AutoCommit = 1;
#}
-#!/usr/bin/perl -Tw
+#!/usr/bin/perl -w
use strict;
+use vars qw($opt_s $opt_u $opt_p);
+use Getopt::Std;
use FS::UID qw(adminsuidsetup);
use FS::Record qw(qsearch qsearchs);
use FS::part_export;
or die "no exports of type $export_x found\n";
}
-my $svc_something = shift or die &usage;
-my $svc_x;
-if ( $svc_something =~ /^(\d+)$/ ) {
- my $cust_svc = qsearchs('cust_svc', { svcnum=>$1 } )
- or die "svcnum $svc_something not found\n";
- $svc_x = $cust_svc->svc_x;
-} else {
- $svc_x = qsearchs('svc_acct', { username=>$svc_something } )
- or die "username $svc_something not found\n";
+getopts('s:u:p:');
+
+my @svc_x = ();
+if ( $opt_s ) {
+ my $cust_svc = qsearchs('cust_svc', { svcnum=>$opt_s } )
+ or die "svcnum $opt_s not found\n";
+ push @svc_x, $cust_svc->svc_x;
+} elsif ( $opt_u ) {
+ my $svc_x = qsearchs('svc_acct', { username=>$opt_u } )
+ or die "username $opt_u not found\n";
+ push @svc_x, $svc_x;
+} elsif ( $opt_p ) {
+ push @svc_x, map { $_->svc_x } qsearch('cust_svc', { svcpart=>$opt_p } );
+ die "no services with svcpart $opt_p found\n" unless @svc_x;
}
foreach my $part_export ( @part_export ) {
- my $error = $part_export->export_insert($svc_x);
- die $error if $error;
+ foreach my $svc_x ( @svc_x ) {
+ my $error = $part_export->export_insert($svc_x);
+ die $error if $error;
+ }
}
sub usage {
- die "Usage:\n\n freeside-reexport user exportnum|exporttype svcnum|username\n";
+ die "Usage:\n\n freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ]\n";
}
=head1 NAME
=head1 SYNOPSIS
- freeside-reexport user exportnum|exporttype svcnum|username
+ freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ]
=head1 DESCRIPTION
# Proc::Daemon or somesuch
use strict;
-use vars qw( $Debug %kids $kids $max_kids $shutdown $log_file $ssh_pid );
+use vars qw( $Debug %kids $kids $max_kids $shutdown $log_file $ssh_pid
+ $keepalives );
use subs qw( lock_write unlock_write );
use Fcntl qw(:flock);
use POSIX qw(:sys_wait_h setsid);
use IO::Handle;
use IO::Select;
use IO::File;
-use Storable qw(nstore_fd fd_retrieve);
+use Storable 2.09 qw(nstore_fd fd_retrieve);
use Net::SSH qw(sshopen2);
use FS::UID qw(adminsuidsetup forksuidsetup);
use FS::ClientAPI;
use FS::cust_bill;
use FS::cust_pkg;
-$Debug = 2; # >= 2 will log packet contents, including potentially compromising
- # information
+$Debug = 1; # 2 will turn on more logging
+ # 3 will log packet contents, including passwords
$shutdown = 0;
$max_kids = '10'; #?
+$keepalives = 0; #let clientd turn it on, so we don't barf on old ones
$kids = 0;
my $user = shift or die &usage;
my $machine = shift or die &usage;
my $tag = scalar(@ARGV) ? shift : '';
-my $pid_file = "/var/run/freeside-selfservice-server.$user.pid";
-#my $pid_file = "/var/run/freeside-selfservice-server.$user.pid"; $FS::UID::datasrc not posible, but should include machine name at least, hmm
+
+# $FS::UID::datasrc not posible
+my $pid_file = "/var/run/freeside-selfservice-server.$user.$machine.pid";
my $lock_file = "/usr/local/etc/freeside/selfservice.$machine.writelock";
-open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!";
&init($user);
warn "entering main loop\n" if $Debug;
my $undisp = 0;
+ my $keepalive_count = 0;
my $s = IO::Select->new( $reader );
while (1) {
my @handles = $s->can_read(5);
unless ( @handles ) {
&shutdown if $shutdown;
+ if ( $keepalives && $keepalive_count++ > 10 ) {
+ $keepalive_count = 0;
+ lock_write;
+ nstore_fd( { _token => '_keepalive' }, $writer );
+ unlock_write;
+ }
next;
}
}
warn "packet received\n".
join('', map { " $_=>$packet->{$_}\n" } keys %$packet )
- if $Debug > 1;
+ if $Debug > 2;
+
+ if ( $packet->{_packet} eq '_enable_keepalive' ) {
+ warn "enabling keep alives\n" if $Debug;
+ $keepalives=1;
+ next;
+ }
#prevent runaway forking
my $warnkids = 0;
warn "child $pid spawned\n" if $Debug;
} else { #kid time
- #get new db handle
- $FS::UID::dbh->{InactiveDestroy} = 1;
- forksuidsetup($user);
+ ##get new db handle
+ #$FS::UID::dbh->{InactiveDestroy} = 1;
+ #forksuidsetup($user);
+
+ #get db handle
+ adminsuidsetup($user);
my $type = $packet->{_packet};
warn "calling $type handler\n" if $Debug;
}
$rv->{_token} = $packet->{_token}; #identifier
- warn "sending response\n" if $Debug;
+ open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!";
lock_write;
+ warn "sending response\n" if $Debug;
nstore_fd($rv, $writer) or die "FATAL: can't send response: $!";
$writer->flush or die "FATAL: can't flush: $!";
unlock_write;
}
+ &shutdown if $shutdown;
warn "connection lost, reconnecting\n" if $Debug;
sleep 3;
#false laziness w/freeside-queued
my $freeside_gid = scalar(getgrnam('freeside'))
or die "can't setgid to freeside group\n";
+
+ open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!";
+ chown $FS::UID::freeside_uid, $freeside_gid, $lock_file;
+
$) = $freeside_gid;
$( = $freeside_gid;
#if freebsd can't setuid(), presumably it can't setgid() either. grr fleabsd
}
sub shutdown {
+ &reap_kids;
my $wait = 12; #wait up to 1 minute
while ( $kids > 0 && $wait-- ) {
warn "waiting for $kids children to terminate";
sleep 5;
+ &reap_kids;
}
warn "abandoning $kids children" if $kids;
kill 'TERM', $ssh_pid if $ssh_pid;
}
sub lock_write {
+ warn "locking $lock_file mutex for write to write stream\n" if $Debug > 1;
+
#broken on freebsd?
#flock($writer, LOCK_EX) or die "FATAL: can't lock write stream: $!";
}
sub unlock_write {
+ warn "unlocking $lock_file mutex\n" if $Debug > 1;
+
#broken on freebsd?
#flock($writer, LOCK_UN) or die "WARNING: can't release write lock: $!";
use strict;
use vars qw($opt_s);
use Getopt::Std;
+use Locale::Country;
+use Locale::SubCountry;
use DBI;
use DBIx::DBSchema 0.20;
use DBIx::DBSchema::Table;
or die "CREATE error: ". $dbh->errstr. "\ndoing statement: $statement";
}
-#not really sample data (and shouldn't default to US)
-
#cust_main_county
+foreach my $country ( sort map uc($_), all_country_codes ) {
-#USPS state codes
-foreach ( qw(
-AL AK AS AZ AR CA CO CT DC DE FM FL GA GU HI ID IL IN IA KS KY LA
-ME MH MD MA MI MN MS MO MT NC ND NE NH NJ NM NV NY MP OH OK OR PA PW PR RI
-SC SD TN TX UT VT VI VA WA WV WI WY AE AA AP
-) ) {
- my($cust_main_county)=new FS::cust_main_county({
- 'state' => $_,
- 'tax' => 0,
- 'country' => 'US',
- });
- my($error);
- $error=$cust_main_county->insert;
- die $error if $error;
-}
+ my $subcountry = eval { new Locale::SubCountry($country) };
+ my @states = $subcountry ? $subcountry->all_codes : undef;
-#AU "offical" state codes ala mark.williamson@ebbs.com.au (Mark Williamson)
-foreach ( qw(
-VIC NSW NT QLD TAS ACT WA SA
-) ) {
- my($cust_main_county)=new FS::cust_main_county({
- 'state' => $_,
- 'tax' => 0,
- 'country' => 'AU',
- });
- my($error);
- $error=$cust_main_county->insert;
- die $error if $error;
-}
+ if ( !scalar(@states) || ( scalar(@states) == 1 && !defined($states[0]) ) ) {
-#ISO 2-letter country codes (same as country TLDs) except US and AU
-foreach ( qw(
-AF AL DZ AS AD AO AI AQ AG AR AM AW AT AZ BS BH BD BB BY BE BZ BJ BM BT BO
-BA BW BV BR IO BN BG BF BI KH CM CA CV KY CF TD CL CN CX CC CO KM CG CK CR CI
-HR CU CY CZ DK DJ DM DO TP EC EG SV GQ ER EE ET FK FO FJ FI FR FX GF PF TF GA
-GM GE DE GH GI GR GL GD GP GU GT GN GW GY HT HM HN HK HU IS IN ID IR IQ IE IL
-IT JM JP JO KZ KE KI KP KR KW KG LA LV LB LS LR LY LI LT LU MO MK MG MW MY MV
-ML MT MH MQ MR MU YT MX FM MD MC MN MS MA MZ MM NA NR NP NL AN NC NZ NI NE NG
-NU NF MP NO OM PK PW PA PG PY PE PH PN PL PT PR QA RE RO RU RW KN LC VC WS SM
-ST SA SN SC SL SG SK SI SB SO ZA GS ES LK SH PM SD SR SJ SZ SE CH SY TW TJ TZ
-TH TG TK TO TT TN TR TM TC TV UG UA AE GB UM UY UZ VU VA VE VN VG VI WF EH
-YE YU ZR ZM ZW
-) ) {
- my($cust_main_county)=new FS::cust_main_county({
- 'tax' => 0,
- 'country' => $_,
- });
- my($error);
- $error=$cust_main_county->insert;
- die $error if $error;
+ my $cust_main_county = new FS::cust_main_county({
+ 'tax' => 0,
+ 'country' => $country,
+ });
+ my $error = $cust_main_county->insert;
+ die $error if $error;
+
+ } else {
+
+ if ( $states[0] =~ /^(\d+|\w)$/ ) {
+ @states = map $subcountry->full_name($_), @states
+ }
+
+ foreach my $state ( @states ) {
+
+ my $cust_main_county = new FS::cust_main_county({
+ 'state' => $state,
+ 'tax' => 0,
+ 'country' => $country,
+ });
+ my $error = $cust_main_county->insert;
+ die $error if $error;
+
+ }
+
+ }
}
#billing events
'custnum', 'int', '', '',
'_date', @date_type,
'amount', @money_type,
- 'otaker', 'varchar', '', 8,
+ 'otaker', 'varchar', '', 32,
'reason', 'text', 'NULL', '',
'closed', 'char', 'NULL', 1,
],
'last', 'varchar', '', $char_d,
# 'middle', 'varchar', 'NULL', $char_d,
'first', 'varchar', '', $char_d,
- 'ss', 'char', 'NULL', 11,
+ 'ss', 'varchar', 'NULL', 11,
'company', 'varchar', 'NULL', $char_d,
'address1', 'varchar', '', $char_d,
'address2', 'varchar', 'NULL', $char_d,
'paydate', 'varchar', 'NULL', 10,
'payname', 'varchar', 'NULL', $char_d,
'tax', 'char', 'NULL', 1,
- 'otaker', 'varchar', '', 8,
+ 'otaker', 'varchar', '', 32,
'refnum', 'int', '', '',
'referral_custnum', 'int', 'NULL', '',
'comments', 'text', 'NULL', '',
'pkgnum', 'int', '', '',
'custnum', 'int', '', '',
'pkgpart', 'int', '', '',
- 'otaker', 'varchar', '', 8,
+ 'otaker', 'varchar', '', 32,
'setup', @date_type,
'bill', @date_type,
'susp', @date_type,
'custnum', 'int', '', '',
'_date', @date_type,
'refund', @money_type,
- 'otaker', 'varchar', '', 8,
+ 'otaker', 'varchar', '', 32,
'reason', 'varchar', '', $char_d,
'payby', 'char', '', 4, # CARD/BILL/COMP, should be index
# into payment type table.
'columns' => [
'recnum', 'int', '', '',
'svcnum', 'int', '', '',
- 'reczone', 'varchar', '', $char_d,
+ 'reczone', 'varchar', '', 255,
'recaf', 'char', '', 2,
- 'rectype', 'char', '', 5,
- 'recdata', 'varchar', '', $char_d,
+ 'rectype', 'varchar', '', 5,
+ 'recdata', 'varchar', '', 255,
],
'primary_key' => 'recnum',
'unique' => [],
-#!/usr/bin/perl -Tw
+#!/usr/bin/perl -w
use strict;
use FS::UID qw(adminsuidsetup);
#my $machine = shift or die &usage;
-my @exports = qsearch('part_export', { exporttype=>'sqlradius' } );
-push @exports, qsearch('part_export', { exporttype=>'sqlradius_withdomain' } );
-
+my @exports = ();
+if ( @ARGV ) {
+ foreach my $exportnum ( @ARGV ) {
+ foreach my $exporttype (qw( sqlradius sqlradius_withdomain )) {
+ push @exports, qsearch('part_export', { exportnum => $exportnum,
+ exporttype => $exporttype, } );
+ }
+ }
+ } else {
+ @exports = qsearch('part_export', { exporttype=>'sqlradius' } );
+ push @exports, qsearch('part_export', { exporttype=>'sqlradius_withdomain' } );
+}
foreach my $export ( @exports ) {
my $icradius_dbh = DBI->connect(
}
sub usage {
- #die "Usage:\n\n sqlradius_reset user machine\n";
- die "Usage:\n\n freeside-sqlradius-reset user\n";
+ die "Usage:\n\n freeside-sqlradius-reset user [ exportnum, ... ]\n";
}
=head1 NAME
=head1 SYNOPSIS
- freeside-sqlradius-reset username
+ freeside-sqlradius-reset username [ EXPORTNUM, ... ]
=head1 DESCRIPTION
Deletes the radcheck, radreply and usergroup tables and repopulates them from
-the Freeside database, for all sqlradius exports.
+the Freeside database, for the specified exports, or, if no exports are
+specified, for all sqlradius and sqlradius_withdomain exports.
B<username> is a username added by freeside-adduser.
+++ /dev/null
-#!/usr/bin/perl -Tw
-
-
-use strict;
-use Date::Parse;
-use Time::Local;
-use Getopt::Std;
-use Text::Template;
-use Net::SMTP;
-use Mail::Header;
-use Mail::Internet;
-use FS::Conf;
-use FS::UID qw(adminsuidsetup);
-use FS::Record qw(qsearch);
-use FS::cust_bill;
-use FS::cust_bill_pay;
-use FS::cust_pay;
-
-
-&untaint_argv; #what it sounds like (eww)
-use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header);
-getopts("vpmef:s:"); #switches
-
-#we're at now now (and later).
-my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T;
-my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T;
-
-# Get the current month
-my ($ssec,$smin,$shour,$smday,$smon,$syear) =
- (localtime($_startdate) )[0,1,2,3,4,5];
-$smon++;
-$syear += 1900;
-
-# Get the current month
-my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) =
- (localtime($_finishdate) )[0,1,2,3,4,5];
-$fmon++;
-$fyear += 1900;
-
-# Login to the database
-my $user = shift or die &usage;
-adminsuidsetup $user;
-
-# Get the needed configuration files
-my $conf = new FS::Conf;
-my $lpr = $conf->config('lpr');
-my $email = $conf->config('email');
-my $smtpmachine = $conf->config('smtpmachine');
-my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') :
- 'postmaster';
-my @report_template = $conf->config('report_template')
- or die "cannot load config file report_template";
-$report_lines = 0;
-foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/
- /report_lines\((\d+)\)/;
- $report_lines += $1;
-}
-die "no report_lines() functions in template?" unless $report_lines;
-$report_template = new Text::Template (
- TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", @report_template ],
-) or die "can't create new Text::Template object: $Text::Template::ERROR";
-
-
-my(@cust_bills)=qsearch('cust_bill',{});
-if (scalar(@cust_bills) == 0)
-{
- exit 1;
-}
-
-# Open print and email pipes
-# $lpr and opt_p for printing
-# $email and opt_m for email
-
-if ($lpr && $main::opt_p)
-{
- open(LPR, "|$lpr");
-}
-
-if ($email && $main::opt_m)
-{
- $ENV{MAILADDRESS} = $mail_sender;
- $header = new Mail::Header ( [
- "From: Account Processor",
- "To: $email",
- "Sender: $mail_sender",
- "Reply-To: $mail_sender",
- "Subject: Sales Taxes Invoiced",
- ] );
-}
-
-my $comped = 0;
-my $comped_tax = 0;
-my $other = 0;
-my $other_tax = 0;
-my $total = 0;
-my $taxed = 0;
-my $untaxed = 0;
-my $total_tax = 0;
-
-# Now I can start looping
-foreach my $cust_bill (@cust_bills)
-{
- my $_date = $cust_bill->getfield('_date');
- my $invnum = $cust_bill->getfield('invnum');
- my $charged = $cust_bill->getfield('charged');
-
- if ($_date >= $_startdate && $_date <= $_finishdate) {
- $total += $charged;
-
- # The following lines were used to produce rather verbose reports
- #my ($sec,$min,$hour,$mday,$mon,$year) =
- # (localtime($_date) )[0,1,2,3,4,5];
- #$mon++;
- #$year -= 100 if $year >= 100;
- #$year = "0" . $year if $year < 10;
-
- my $invoice_amt =0;
- my $invoice_tax =0;
- my $invoice_comped =0;
- my(@cust_bill_pkgs)= $cust_bill->cust_bill_pkg;
- foreach my $cust_bill_pkg (@cust_bill_pkgs) {
-
- my $recur = $cust_bill_pkg->getfield('recur');
- my $setup = $cust_bill_pkg->getfield('setup');
- my $pkgnum = $cust_bill_pkg->getfield('pkgnum');
-
- if ($pkgnum == 0) {
- # The following line was used to produce rather verbose reports
- # push @buf, ('', sprintf(qq{%10s%15s%14.2f}, "$mon/$mday/$year", "Tax $invnum", $recur+$setup));
- $invoice_tax += $recur;
- $invoice_tax += $setup;
- } else {
- # The following line was used to produce rather verbose reports
- # push @buf, ('', sprintf(qq{%10s%15s%14.2f}, "$mon/$mday/$year", "Inv $invnum", $recur+$setup));
- $invoice_amt += $recur;
- $invoice_amt += $setup;
- }
-
- }
-
- my(@cust_bill_pays)= $cust_bill->cust_bill_pay;
- foreach my $cust_bill_pay (@cust_bill_pays) {
- my $payby = $cust_bill_pay->cust_pay->payby;
- my $paid = $cust_bill_pay->getfield('amount');
- if ($payby =~ 'COMP') {
- $invoice_comped += $paid;
- }
- }
-
- if (abs($invoice_comped - ($invoice_amt + $invoice_tax)) < 0.0001){
- $comped += $invoice_amt;
- $comped_tax += $invoice_tax;
- } elsif ($invoice_comped > 0) {
- push @buf, sprintf(qq{\nInvoice %10d has inexpliciable complimentary payments of %14.9f\n}, $invnum, $invoice_comped);
- $other += $invoice_amt;
- $other_tax += $invoice_tax;
- } elsif ($invoice_tax > 0) {
- $total_tax += $invoice_tax;
- $taxed += $invoice_amt;
- } else {
- $untaxed += $invoice_amt;
- }
-
- }
-
-}
-
-push @buf, ('', sprintf(qq{%25s%14.2f}, "Complimentary", $comped));
-push @buf, sprintf(qq{%25s%14.2f}, "Complimentary Tax", $comped_tax);
-push @buf, sprintf(qq{%25s%14.2f}, "Other", $other);
-push @buf, sprintf(qq{%25s%14.2f}, "Other Tax", $other_tax);
-push @buf, sprintf(qq{%25s%14.2f}, "Untaxed", $untaxed);
-push @buf, sprintf(qq{%25s%14.2f}, "Taxed", $taxed);
-push @buf, sprintf(qq{%25s%14.2f}, "Tax", $total_tax);
-push @buf, ('', sprintf(qq{%39s}, "========="), sprintf(qq{%39.2f}, $total));
-
-sub FS::tax_report::_template::report_lines {
- my $lines = shift;
- map {
- scalar(@buf) ? shift @buf : '' ;
- }
- ( 1 .. $lines );
-}
-
-$FS::tax_report::_template::title = qq~SALES TAXES INVOICED for $smon/$smday/$syear through $fmon/$fmday/$fyear~;
-$FS::tax_report::_template::title = $opt_t if $opt_t;
-$FS::tax_report::_template::page = 1;
-$FS::tax_report::_template::date = $^T;
-$FS::tax_report::_template::date = $^T;
-$FS::tax_report::_template::fdate = $_finishdate;
-$FS::tax_report::_template::fdate = $_finishdate;
-$FS::tax_report::_template::sdate = $_startdate;
-$FS::tax_report::_template::sdate = $_startdate;
-$FS::tax_report::_template::total_pages =
- int( scalar(@buf) / $report_lines);
-$FS::tax_report::_template::total_pages++ if scalar(@buf) % $report_lines;
-
-my @report;
-while (@buf) {
- push @report, split("\n",
- $report_template->fill_in( PACKAGE => 'FS::tax_report::_template' )
- );
- $FS::tax_report::_template::page++;
-}
-
-if ($opt_v) {
- print map "$_\n", @report;
-}
-if($lpr && $opt_p)
-{
- print LPR map "$_\n", @report;
- print LPR "\f" if $opt_e;
- close LPR || die "Could not close printer: $lpr\n";
-}
-if($email && $opt_m)
-{
- my $message = new Mail::Internet (
- 'Header' => $header,
- 'Body' => [ (@report) ],
- );
- $!=0;
- $message->smtpsend( Host => "$smtpmachine" )
- or die "can't send report to $email via $smtpmachine: $!";
-}
-
-
-# subroutines
-sub untaint_argv {
- foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
- $ARGV[$_] =~ /^([\w\-\/ :\.]*)$/ || die "Illegal argument \"$ARGV[$_]\"";
- $ARGV[$_]=$1;
- }
-}
-
-sub usage {
- die "Usage:\n\n freeside-tax-report [-v] [-p] [-e] user\n";
-}
-
-=head1 NAME
-
-freeside-tax-report - Prints or emails sales taxes invoiced in a given period.
-
-=head1 SYNOPSIS
-
- freeside-tax-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user
-
-=head1 DESCRIPTION
-
-Prints or emails sales taxes invoiced in a given period.
-
--v: Verbose - Prints records to STDOUT.
-
--p: Print to printer lpr as found in the conf directory.
-
--m: Email output to user found in the Conf email file.
-
--e: Print a final form feed to the printer.
-
--t: supply a title for the top of each page.
-
--s: starting date for inclusion
-
--f: final date for inclusion
-
-user: From the mapsecrets file - see config.html from the base documentation
-
-=head1 VERSION
-
-$Id: freeside-tax-report,v 1.4.4.1 2002-09-09 22:57:32 ivan Exp $
-
-=head1 BUGS
-
-Yes..... Use at your own risk. No guarantees or warrantees of any
-kind apply to this program. Parts of this program are hacked from
-other GNU licensed software created mainly by Ivan Kohler.
-
-This is released under the GNU Public License. See www.gnu.org
-for more information regarding this license.
-
-=head1 SEE ALSO
-
-L<FS::cust_main>, config.html from the base documentation
-
-=head1 AUTHOR
-
-Jeff Finucane <jeff@cmh.net>
-
-based on print-batch by Joel Griffiths <griff@aver-computer.com>
-
-=cut
-
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export::communigate_pro;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export::communigate_pro_singledomain;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export::passwdfile;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export::postfix;
+$loaded=1;
+print "ok 1\n";
#deb
FREESIDE_DOCUMENT_ROOT = /var/www/freeside
-#redhat, mandrake
+#redhat, fedora, mandrake
#FREESIDE_DOCUMENT_ROOT = /var/www/html/freeside
#freebsd
#FREESIDE_DOCUMENT_ROOT = /usr/local/www/data/freeside
#openbsd
#FREESIDE_DOCUMENT_ROOT = /var/www/htdocs/freeside
+#suse
+#FREESIDE_DOCUMENT_ROOT = /srv/www/htdocs/freeside
+#apache
+#FREESIDE_DOCUMENT_ROOT = /usr/local/apache/htdocs/freeside
-#deb, redhat, mandrake, others?
+#deb, redhat, fedora, mandrake, suse, others?
INIT_FILE = /etc/init.d/freeside
#freebsd
#INIT_FILE = /usr/local/etc/rc.d/011.freeside.sh
-#deb
+#deb, suse
HTTPD_RESTART = /etc/init.d/apache restart
-#redhat, mandrake
+#redhat, fedora, mandrake
#HTTPD_RESTART = /etc/init.d/httpd restart
#freebsd
#HTTPD_RESTART = /usr/local/etc/rc.d/apache.sh stop; sleep 1; /usr/local/etc/rc.d/apache.sh start
#openbsd
#HTTPD_RESTART = kill -TERM `cat /var/www/logs/httpd.pid`; sleep 1; /usr/sbin/httpd -u -DSSL
+#apache
+#HTTPD_RESTART = /usr/local/apache/bin/apachectl stop; sleep 10; /usr/local/apache/bin/apachectl startssl
FREESIDE_RESTART = ${INIT_FILE} restart
-#deb, redhat, mandrake, others?
+#deb, redhat, fedora, mandrake, suse, others?
INSTALLGROUP = root
#freebsd, openbsd
#INSTALLGROUP = wheel
FREESIDE_PATH = `pwd`
SELFSERVICE_USER = fs_selfservice
-SELFSERVICE_MACHINE = localhost
+#never run on the same machine in production!!!
+SELFSERVICE_MACHINES = localhost
+# SELFSERVICE_MACHINES = www.example.com
+# SELFSERVICE_MACHINES = web1.example.com web2.example.com
+
+#user with sudo access on SELFSERVICE_MACHINES for automated self-service
+#installation.
+SELFSERVICE_INSTALL_USER = ivan
+SELFSERVICE_INSTALL_USERADD = /usr/sbin/useradd
+#SELFSERVICE_INSTALL_USERADD = "/usr/sbin/pw useradd"
#---
#not changable yet
FREESIDE_CONF = /usr/local/etc/freeside
-VERSION=1.4.2beta1
-TAG=freeside_1_4_2beta1
+VERSION=1.4.2
+TAG=freeside_1_4_2
help:
@echo "supported targets: aspdocs masondocs alldocs docs install-docs"
[ "${TEMPLATE}" = "asp" ] && chown -R freeside ${ASP_GLOBAL} || true
[ "${TEMPLATE}" = "asp" ] && cp htetc/global.asa ${ASP_GLOBAL} || true
[ "${TEMPLATE}" = "mason" ] && cp htetc/handler.pl ${MASON_HANDLER} || true
+ [ "${TEMPLATE}" = "mason" ] && \
+ perl -p -i -e "\
+ s'%%%FREESIDE_DOCUMENT_ROOT%%%'${FREESIDE_DOCUMENT_ROOT}'g; \
+ " ${MASON_HANDLER} || true
[ "${TEMPLATE}" = "mason" -a ! -e ${MASONDATA} ] && mkdir ${MASONDATA} || true
[ "${TEMPLATE}" = "mason" ] && chown -R freeside ${MASONDATA} || true
s/%%%QUEUED_USER%%%/${QUEUED_USER}/g;\
s'%%%FREESIDE_PATH%%%'${FREESIDE_PATH}'g;\
s/%%%SELFSERVICE_USER%%%/${SELFSERVICE_USER}/g;\
- s/%%%SELFSERVICE_MACHINE%%%/${SELFSERVICE_MACHINE}/g;\
+ s/%%%SELFSERVICE_MACHINES%%%/${SELFSERVICE_MACHINES}/g;\
" ${INIT_FILE}
+install-selfservice:
+ [ -e ~freeside/.ssh/id_dsa.pub ] || su -c 'ssh-keygen -t dsa' - freeside
+ for MACHINE in ${SELFSERVICE_MACHINES}; do \
+ scp -r fs_selfservice/FS-SelfService ${SELFSERVICE_INSTALL_USER}@$$MACHINE:. ;\
+ ssh ${SELFSERVICE_INSTALL_USER}@$$MACHINE "cd FS-SelfService; perl Makefile.PL && make" ;\
+ ssh ${SELFSERVICE_INSTALL_USER}@$$MACHINE "cd FS-SelfService; sudo make install" ;\
+ scp ~freeside/.ssh/id_dsa.pub ${SELFSERVICE_INSTALL_USER}@$$MACHINE:. ;\
+ ssh ${SELFSERVICE_INSTALL_USER}@$$MACHINE "sudo ${SELFSERVICE_INSTALL_USERADD} freeside; sudo install -D -o freeside -m 600 ./id_dsa.pub ~freeside/.ssh/authorized_keys" ;\
+ ssh ${SELFSERVICE_INSTALL_USER}@$$MACHINE "sudo install -o freeside -d /usr/local/freeside" ;\
+ done
+
+update-selfservice:
+ for MACHINE in ${SELFSERVICE_MACHINES}; do \
+ rsync -rlptz fs_selfservice/FS-SelfService/ ${SELFSERVICE_INSTALL_USER}@$$MACHINE:FS-SelfService ;\
+ ssh ${SELFSERVICE_INSTALL_USER}@$$MACHINE "cd FS-SelfService; perl Makefile.PL && make" ;\
+ ssh ${SELFSERVICE_INSTALL_USER}@$$MACHINE "cd FS-SelfService; sudo make install" ;\
+ done
+
install: install-perl-modules install-docs install-init
deploy: install
create-config: install-perl-modules
[ -e ${FREESIDE_CONF} ] && mv ${FREESIDE_CONF} ${FREESIDE_CONF}.`date +%Y%m%d%H%M%S` || true
- mkdir ${FREESIDE_CONF}
- chown freeside ${FREESIDE_CONF}
+ install -d -o freeside ${FREESIDE_CONF}
touch ${FREESIDE_CONF}/secrets
chown freeside ${FREESIDE_CONF}/secrets
mkdir "${FREESIDE_CONF}/conf.${DATASOURCE}"
rm -rf conf/registries #old dirs just won't go away
- cp conf/[a-z]* "${FREESIDE_CONF}/conf.${DATASOURCE}"
+ #cp conf/[a-z]* "${FREESIDE_CONF}/conf.${DATASOURCE}"
+ cp `ls -d conf/[a-z]* | grep -v CVS` "${FREESIDE_CONF}/conf.${DATASOURCE}"
chown -R freeside "${FREESIDE_CONF}/conf.${DATASOURCE}"
mkdir "${FREESIDE_CONF}/counters.${DATASOURCE}"
#these are probably only useful if you're me...
-upload-docs: forcehtmlman
- ssh cleanwhisker.420.am rm -rf /var/www/www.sisd.com/freeside/docs
- scp -pr httemplate/docs cleanwhisker.420.am:/var/www/www.sisd.com/freeside/docs
+#no more doc uploads from maintenance branch
+#upload-docs: forcehtmlman
+# ssh pouncequick.420.am rm -rf /var/www/www.sisd.com/freeside/docs
+# scp -pr httemplate/docs pouncequick.420.am:/var/www/www.sisd.com/freeside/docs
#release: upload-docs update-webdemo
-release: upload-docs
+release:
cd /home/ivan/freeside1.4
#cvs tag ${TAG}
cvs tag -F ${TAG}
cvs export -r ${TAG} -d freeside-${VERSION} freeside
tar czvf freeside-${VERSION}.tar.gz freeside-${VERSION}
- scp freeside-${VERSION}.tar.gz ivan@cleanwhisker.420.am:/var/www/sisd.420.am/freeside/
+ scp freeside-${VERSION}.tar.gz ivan@420.am:/var/www/sisd.420.am/freeside/
mv freeside-${VERSION} freeside-${VERSION}.tar.gz ..
update-webdemo:
} ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
# warn $rsync->out;
- ssh("root\@$machine", 'apachectl graceful');
+ my $restart = $export->option('restart') || 'apachectl graceful';
+
+ ssh("root\@$machine", $restart);
}
my $machine = $export->machine;
my $prefix = "$spooldir/$machine";
+ my $bind_rel = $export->option('bind_release');
+ my $ndc_cmd = $export->option('reload')
+ || ( ($bind_rel eq 'BIND9') ? 'rndc' : 'ndc' );
+ my $minttl = $export->option('bind9_minttl');
+
#prevent old domain files from piling up
#rmtree "$prefix" or die "can't rmtree $prefix.db: $!";
open (DB_MASTER,">$prefix/db.$domain")
or die "can't open $prefix/db.$domain: $!";
+ if ($bind_rel eq 'BIND9') {
+ print DB_MASTER "\$TTL $minttl\n\$ORIGIN $domain.\n";
+ }
+
my @domain_records =
qsearch('domain_record', { 'svcnum' => $svc_domain->svcnum } );
foreach my $domain_record (
} ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
# warn $rsync->out;
- ssh("root\@$machine", 'ndc reload');
+ ssh("root\@$machine", "$ndc_cmd reload");
}
my $machine = $sexport->machine;
my $prefix = "$spooldir/$machine";
+ my $bind_rel = $sexport->option('bind_release');
+ my $ndc_cmd = ($bind_rel eq 'BIND9') ? 'rndc' : 'ndc';
+
#prevent old domain files from piling up
#rmtree "$prefix" or die "can't rmtree $prefix.db: $!";
} ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
# warn $rsync->out;
- ssh("root\@$machine", 'ndc reload');
+ ssh("root\@$machine", "$ndc_cmd reload");
}
close NAMED_CONF;
#!/usr/bin/perl -w
#
-# $Id: bind.import,v 1.3 2002-07-15 01:44:23 ivan Exp $
-
-#need to manually put header in /usr/local/etc/freeside/export.<datasrc./bind/<machine>/named.conf.HEADER
+# -s: import slave zones as master. useful if you need to recreate your
+# primary nameserver from a secondary
+# -c chroot_dir: import data from chrooted bind (corrects the path for
+# downloading zone files
+#
+# need to manually put header in
+# /usr/local/etc/freeside/export.<datasrc./bind/<machine>/named.conf.HEADER
use strict;
use vars qw( %d_part_svc );
+use Getopt::Std;
use Term::Query qw(query);
#use BIND::Conf_Parser;
#use DNS::ZoneParse 0.81;
#use FS::svc_acct;
#use FS::part_svc;
+use vars qw($opt_s $opt_c);
+getopts("sc:");
+
my $user = shift or die &usage;
adminsuidsetup $user;
##
sub usage {
- die "Usage:\n\n svc_domain.import user\n";
+ die "Usage:\n\n bind.import user\n";
}
########
sub handle_zone {
my($self, $name, $class, $type, $options) = @_;
return unless $class eq 'in';
- return if grep { $name eq $_ }
- ( qw( . localhost 127.in-addr.arpa 0.in-addr.arpa 255.in-addr.arpa ) );
-
- my $domain = new FS::svc_domain( {
- svcpart => $main::domain_svcpart,
- domain => $name,
- action => 'N',
- } );
- my $error = $domain->insert;
- die $error if $error;
+ return if grep { $name eq $_ } (qw(
+ . localhost 127.in-addr.arpa 0.in-addr.arpa 255.in-addr.arpa
+ 0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa
+ 0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.int
+ ));
+
+ use FS::Record qw(qsearchs);
+ use FS::svc_domain;
+
+ my $domain =
+ qsearchs('svc_domain', { 'domain' => $name } )
+ || new FS::svc_domain( {
+ svcpart => $main::domain_svcpart,
+ domain => $name,
+ action => 'N',
+ } );
+ unless ( $domain->svcnum ) {
+ my $error = $domain->insert;
+ die $error if $error;
+ }
- if ( $type eq 'slave' ) {
+ if ( $type eq 'slave' && !$main::opt_s ) {
#use Data::Dumper;
#print Dumper($options);
die $error if $error;
}
- } elsif ( $type eq 'master' ) {
+ } elsif ( $type eq 'master' || ( $type eq 'slave' && $main::opt_s ) ) {
my $file = $options->{file};
my $basefile = basename($file);
my $sourcefile = $file;
$sourcefile = "$named_dir/$sourcefile" unless $file =~ /^\//;
+ $sourcefile = "$main::opt_c/$sourcefile" if $main::opt_c;
+
use Net::SCP qw(iscp scp);
scp("root\@$main::named_machine:$sourcefile",
- "$main::prefix/$basefile.import");
+ "$main::prefix/$basefile.import");
- use DNS::ZoneParse 0.81;
+ use DNS::ZoneParse 0.84;
my $zone = DNS::ZoneParse->new("$main::prefix/$basefile.import");
- my $dump = $zone->Dump;
+ my $dump = $zone->dump;
#use Data::Dumper;
#print "$name: ". Dumper($dump);
}
}
+ #} else {
+ # die "unrecognized type $type\n";
}
}
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# $Id: fs-setup,v 1.96.4.7 2003-06-14 02:02:25 ivan Exp $
-
-#to delay loading dbdef until we're ready
-BEGIN { $FS::Record::setup_hack = 1; }
-
-use strict;
-use DBI;
-use DBIx::DBSchema 0.20;
-use DBIx::DBSchema::Table;
-use DBIx::DBSchema::Column;
-use DBIx::DBSchema::ColGroup::Unique;
-use DBIx::DBSchema::ColGroup::Index;
-use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets);
-use FS::Record;
-use FS::cust_main_county;
-use FS::raddb;
-use FS::part_bill_event;
-
-die "Not running uid freeside!" unless checkeuid();
-
-my %attrib2db =
- map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib;
-
-my $user = shift or die &usage;
-getsecrets($user);
-
-#needs to match FS::Record
-my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
-
-###
-
-#print "\nEnter the maximum username length: ";
-#my($username_len)=&getvalue;
-my $username_len = 32; #usernamemax config file
-
-print "\n\n", <<END, ":";
-Freeside tracks the RADIUS User-Name, check attribute Password and
-reply attribute Framed-IP-Address for each user. You can specify additional
-check and reply attributes (or you can add them later with the
-fs-radius-add-check and fs-radius-add-reply programs).
-
-First enter any additional RADIUS check attributes you need to track for each
-user, separated by whitespace.
-END
-my @check_attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; }
- split(" ",&getvalue);
-
-print "\n\n", <<END, ":";
-Now enter any additional reply attributes you need to track for each user,
-separated by whitespace.
-END
-my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; }
- split(" ",&getvalue);
-
-print "\n\n", <<END, ":";
-Do you wish to enable the tracking of a second, separate shipping/service
-address?
-END
-my $ship = &_yesno;
-
-sub getvalue {
- my($x)=scalar(<STDIN>);
- chop $x;
- $x;
-}
-
-sub _yesno {
- print " [y/N]:";
- my $x = scalar(<STDIN>);
- $x =~ /^y/i;
-}
-
-###
-
-my($char_d) = 80; #default maxlength for text fields
-
-#my(@date_type) = ( 'timestamp', '', '' );
-my(@date_type) = ( 'int', 'NULL', '' );
-my(@perl_type) = ( 'text', 'NULL', '' );
-my @money_type = ( 'decimal', '', '10,2' );
-
-###
-# create a dbdef object from the old data structure
-###
-
-my(%tables)=&tables_hash_hack;
-
-#turn it into objects
-my($dbdef) = new DBIx::DBSchema ( map {
- my(@columns);
- while (@{$tables{$_}{'columns'}}) {
- my($name,$type,$null,$length)=splice @{$tables{$_}{'columns'}}, 0, 4;
- push @columns, new DBIx::DBSchema::Column ( $name,$type,$null,$length );
- }
- DBIx::DBSchema::Table->new(
- $_,
- $tables{$_}{'primary_key'},
- DBIx::DBSchema::ColGroup::Unique->new($tables{$_}{'unique'}),
- DBIx::DBSchema::ColGroup::Index->new($tables{$_}{'index'}),
- @columns,
- );
-} (keys %tables) );
-
-my $cust_main = $dbdef->table('cust_main');
-unless ($ship) { #remove ship_ from cust_main
- $cust_main->delcolumn($_) foreach ( grep /^ship_/, $cust_main->columns );
-} else { #add indices
- push @{$cust_main->index->lol_ref},
- map { [ "ship_$_" ] } qw( last company daytime night fax );
-}
-
-#add radius attributes to svc_acct
-
-my($svc_acct)=$dbdef->table('svc_acct');
-
-my($attribute);
-foreach $attribute (@attributes) {
- $svc_acct->addcolumn ( new DBIx::DBSchema::Column (
- 'radius_'. $attribute,
- 'varchar',
- 'NULL',
- $char_d,
- ));
-}
-
-foreach $attribute (@check_attributes) {
- $svc_acct->addcolumn( new DBIx::DBSchema::Column (
- 'rc_'. $attribute,
- 'varchar',
- 'NULL',
- $char_d,
- ));
-}
-
-##make part_svc table (but now as object)
-#
-#my($part_svc)=$dbdef->table('part_svc');
-#
-##because of svc_acct_pop
-##foreach (grep /^svc_/, $dbdef->tables) {
-##foreach (qw(svc_acct svc_acct_sm svc_charge svc_domain svc_wo)) {
-#foreach (qw(svc_acct svc_domain svc_forward svc_www)) {
-# my($table)=$dbdef->table($_);
-# my($col);
-# foreach $col ( $table->columns ) {
-# next if $col =~ /^svcnum$/;
-# $part_svc->addcolumn( new DBIx::DBSchema::Column (
-# $table->name. '__' . $table->column($col)->name,
-# 'varchar', #$table->column($col)->type,
-# 'NULL',
-# $char_d, #$table->column($col)->length,
-# ));
-# $part_svc->addcolumn ( new DBIx::DBSchema::Column (
-# $table->name. '__'. $table->column($col)->name . "_flag",
-# 'char',
-# 'NULL',
-# 1,
-# ));
-# }
-#}
-
-#create history tables (false laziness w/create-history-tables)
-foreach my $table ( grep { ! /^h_/ } $dbdef->tables ) {
- my $tableobj = $dbdef->table($table)
- or die "unknown table $table";
-
- die "unique->lol_ref undefined for $table"
- unless defined $tableobj->unique->lol_ref;
- die "index->lol_ref undefined for $table"
- unless defined $tableobj->index->lol_ref;
-
- my $h_tableobj = DBIx::DBSchema::Table->new( {
- name => "h_$table",
- primary_key => 'historynum',
- unique => DBIx::DBSchema::ColGroup::Unique->new( [] ),
- 'index' => DBIx::DBSchema::ColGroup::Index->new( [
- @{$tableobj->unique->lol_ref},
- @{$tableobj->index->lol_ref}
- ] ),
- columns => [
- DBIx::DBSchema::Column->new( {
- 'name' => 'historynum',
- 'type' => 'serial',
- 'null' => 'NOT NULL',
- 'length' => '',
- 'default' => '',
- 'local' => '',
- } ),
- DBIx::DBSchema::Column->new( {
- 'name' => 'history_date',
- 'type' => 'int',
- 'null' => 'NULL',
- 'length' => '',
- 'default' => '',
- 'local' => '',
- } ),
- DBIx::DBSchema::Column->new( {
- 'name' => 'history_user',
- 'type' => 'varchar',
- 'null' => 'NOT NULL',
- 'length' => '80',
- 'default' => '',
- 'local' => '',
- } ),
- DBIx::DBSchema::Column->new( {
- 'name' => 'history_action',
- 'type' => 'varchar',
- 'null' => 'NOT NULL',
- 'length' => '80',
- 'default' => '',
- 'local' => '',
- } ),
- map { $tableobj->column($_) } $tableobj->columns
- ],
- } );
- $dbdef->addtable($h_tableobj);
-}
-
-#important
-$dbdef->save($dbdef_file);
-&FS::Record::reload_dbdef($dbdef_file);
-
-###
-# create 'em
-###
-
-my($dbh)=adminsuidsetup $user;
-
-#create tables
-$|=1;
-
-foreach my $statement ( $dbdef->sql($dbh) ) {
- $dbh->do( $statement )
- or die "CREATE error: ". $dbh->errstr. "\ndoing statement: $statement";
-}
-
-#not really sample data (and shouldn't default to US)
-
-#cust_main_county
-
-#USPS state codes
-foreach ( qw(
-AL AK AS AZ AR CA CO CT DC DE FM FL GA GU HI ID IL IN IA KS KY LA
-ME MH MD MA MI MN MS MO MT NC ND NE NH NJ NM NV NY MP OH OK OR PA PW PR RI
-SC SD TN TX UT VT VI VA WA WV WI WY AE AA AP
-) ) {
- my($cust_main_county)=new FS::cust_main_county({
- 'state' => $_,
- 'tax' => 0,
- 'country' => 'US',
- });
- my($error);
- $error=$cust_main_county->insert;
- die $error if $error;
-}
-
-#AU "offical" state codes ala mark.williamson@ebbs.com.au (Mark Williamson)
-foreach ( qw(
-VIC NSW NT QLD TAS ACT WA SA
-) ) {
- my($cust_main_county)=new FS::cust_main_county({
- 'state' => $_,
- 'tax' => 0,
- 'country' => 'AU',
- });
- my($error);
- $error=$cust_main_county->insert;
- die $error if $error;
-}
-
-#ISO 2-letter country codes (same as country TLDs) except US and AU
-foreach ( qw(
-AF AL DZ AS AD AO AI AQ AG AR AM AW AT AZ BS BH BD BB BY BE BZ BJ BM BT BO
-BA BW BV BR IO BN BG BF BI KH CM CA CV KY CF TD CL CN CX CC CO KM CG CK CR CI
-HR CU CY CZ DK DJ DM DO TP EC EG SV GQ ER EE ET FK FO FJ FI FR FX GF PF TF GA
-GM GE DE GH GI GR GL GD GP GU GT GN GW GY HT HM HN HK HU IS IN ID IR IQ IE IL
-IT JM JP JO KZ KE KI KP KR KW KG LA LV LB LS LR LY LI LT LU MO MK MG MW MY MV
-ML MT MH MQ MR MU YT MX FM MD MC MN MS MA MZ MM NA NR NP NL AN NC NZ NI NE NG
-NU NF MP NO OM PK PW PA PG PY PE PH PN PL PT PR QA RE RO RU RW KN LC VC WS SM
-ST SA SN SC SL SG SK SI SB SO ZA GS ES LK SH PM SD SR SJ SZ SE CH SY TW TJ TZ
-TH TG TK TO TT TN TR TM TC TV UG UA AE GB UM UY UZ VU VA VE VN VG VI WF EH
-YE YU ZR ZM ZW
-) ) {
- my($cust_main_county)=new FS::cust_main_county({
- 'tax' => 0,
- 'country' => $_,
- });
- my($error);
- $error=$cust_main_county->insert;
- die $error if $error;
-}
-
-#billing events
-foreach my $aref (
- [ 'COMP', 'Comp invoice', '$cust_bill->comp();', 30, 'comp' ],
- [ 'CARD', 'Batch card', '$cust_bill->batch_card();', 40, 'batch-card' ],
- [ 'BILL', 'Send invoice', '$cust_bill->send();', 50, 'send' ],
-) {
-
- my $part_bill_event = new FS::part_bill_event({
- 'payby' => $aref->[0],
- 'event' => $aref->[1],
- 'eventcode' => $aref->[2],
- 'seconds' => 0,
- 'weight' => $aref->[3],
- 'plan' => $aref->[4],
- });
- my($error);
- $error=$part_bill_event->insert;
- die $error if $error;
-
-}
-
-$dbh->commit or die $dbh->errstr;
-$dbh->disconnect or die $dbh->errstr;
-
-print "Freeside database initialized sucessfully\n";
-
-sub usage {
- die "Usage:\n fs-setup user\n";
-}
-
-###
-# Now it becomes an object. much better.
-###
-sub tables_hash_hack {
-
- #note that s/(date|change)/_$1/; to avoid keyword conflict.
- #put a kludge in FS::Record to catch this or? (pry need some date-handling
- #stuff anyway also)
-
- my(%tables)=( #yech.}
-
- 'agent' => {
- 'columns' => [
- 'agentnum', 'int', '', '',
- 'agent', 'varchar', '', $char_d,
- 'typenum', 'int', '', '',
- 'freq', 'int', 'NULL', '',
- 'prog', @perl_type,
- ],
- 'primary_key' => 'agentnum',
- 'unique' => [],
- 'index' => [ ['typenum'] ],
- },
-
- 'agent_type' => {
- 'columns' => [
- 'typenum', 'int', '', '',
- 'atype', 'varchar', '', $char_d,
- ],
- 'primary_key' => 'typenum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'type_pkgs' => {
- 'columns' => [
- 'typenum', 'int', '', '',
- 'pkgpart', 'int', '', '',
- ],
- 'primary_key' => '',
- 'unique' => [ ['typenum', 'pkgpart'] ],
- 'index' => [ ['typenum'] ],
- },
-
- 'cust_bill' => {
- 'columns' => [
- 'invnum', 'int', '', '',
- 'custnum', 'int', '', '',
- '_date', @date_type,
- 'charged', @money_type,
- 'printed', 'int', '', '',
- 'closed', 'char', 'NULL', 1,
- ],
- 'primary_key' => 'invnum',
- 'unique' => [],
- 'index' => [ ['custnum'], ['_date'] ],
- },
-
- 'cust_bill_event' => {
- 'columns' => [
- 'eventnum', 'int', '', '',
- 'invnum', 'int', '', '',
- 'eventpart', 'int', '', '',
- '_date', @date_type,
- 'status', 'varchar', '', $char_d,
- 'statustext', 'text', 'NULL', '',
- ],
- 'primary_key' => 'eventnum',
- #no... there are retries now #'unique' => [ [ 'eventpart', 'invnum' ] ],
- 'unique' => [],
- 'index' => [ ['invnum'], ['status'] ],
- },
-
- 'part_bill_event' => {
- 'columns' => [
- 'eventpart', 'int', '', '',
- 'payby', 'char', '', 4,
- 'event', 'varchar', '', $char_d,
- 'eventcode', @perl_type,
- 'seconds', 'int', 'NULL', '',
- 'weight', 'int', '', '',
- 'plan', 'varchar', 'NULL', $char_d,
- 'plandata', 'text', 'NULL', '',
- 'disabled', 'char', 'NULL', 1,
- ],
- 'primary_key' => 'eventpart',
- 'unique' => [],
- 'index' => [ ['payby'] ],
- },
-
- 'cust_bill_pkg' => {
- 'columns' => [
- 'pkgnum', 'int', '', '',
- 'invnum', 'int', '', '',
- 'setup', @money_type,
- 'recur', @money_type,
- 'sdate', @date_type,
- 'edate', @date_type,
- ],
- 'primary_key' => '',
- 'unique' => [ ['pkgnum', 'invnum'] ],
- 'index' => [ ['invnum'] ],
- },
-
- 'cust_credit' => {
- 'columns' => [
- 'crednum', 'int', '', '',
- 'custnum', 'int', '', '',
- '_date', @date_type,
- 'amount', @money_type,
- 'otaker', 'varchar', '', 8,
- 'reason', 'text', 'NULL', '',
- 'closed', 'char', 'NULL', 1,
- ],
- 'primary_key' => 'crednum',
- 'unique' => [],
- 'index' => [ ['custnum'] ],
- },
-
- 'cust_credit_bill' => {
- 'columns' => [
- 'creditbillnum', 'int', '', '',
- 'crednum', 'int', '', '',
- 'invnum', 'int', '', '',
- '_date', @date_type,
- 'amount', @money_type,
- ],
- 'primary_key' => 'creditbillnum',
- 'unique' => [],
- 'index' => [ ['crednum'], ['invnum'] ],
- },
-
- 'cust_main' => {
- 'columns' => [
- 'custnum', 'int', '', '',
- 'agentnum', 'int', '', '',
-# 'titlenum', 'int', 'NULL', '',
- 'last', 'varchar', '', $char_d,
-# 'middle', 'varchar', 'NULL', $char_d,
- 'first', 'varchar', '', $char_d,
- 'ss', 'char', 'NULL', 11,
- 'company', 'varchar', 'NULL', $char_d,
- 'address1', 'varchar', '', $char_d,
- 'address2', 'varchar', 'NULL', $char_d,
- 'city', 'varchar', '', $char_d,
- 'county', 'varchar', 'NULL', $char_d,
- 'state', 'varchar', 'NULL', $char_d,
- 'zip', 'varchar', '', 10,
- 'country', 'char', '', 2,
- 'daytime', 'varchar', 'NULL', 20,
- 'night', 'varchar', 'NULL', 20,
- 'fax', 'varchar', 'NULL', 12,
- 'ship_last', 'varchar', 'NULL', $char_d,
-# 'ship_middle', 'varchar', 'NULL', $char_d,
- 'ship_first', 'varchar', 'NULL', $char_d,
- 'ship_company', 'varchar', 'NULL', $char_d,
- 'ship_address1', 'varchar', 'NULL', $char_d,
- 'ship_address2', 'varchar', 'NULL', $char_d,
- 'ship_city', 'varchar', 'NULL', $char_d,
- 'ship_county', 'varchar', 'NULL', $char_d,
- 'ship_state', 'varchar', 'NULL', $char_d,
- 'ship_zip', 'varchar', 'NULL', 10,
- 'ship_country', 'char', 'NULL', 2,
- 'ship_daytime', 'varchar', 'NULL', 20,
- 'ship_night', 'varchar', 'NULL', 20,
- 'ship_fax', 'varchar', 'NULL', 12,
- 'payby', 'char', '', 4,
- 'payinfo', 'varchar', 'NULL', $char_d,
- #'paydate', @date_type,
- 'paydate', 'varchar', 'NULL', 10,
- 'payname', 'varchar', 'NULL', $char_d,
- 'tax', 'char', 'NULL', 1,
- 'otaker', 'varchar', '', 8,
- 'refnum', 'int', '', '',
- 'referral_custnum', 'int', 'NULL', '',
- 'comments', 'text', 'NULL', '',
- ],
- 'primary_key' => 'custnum',
- 'unique' => [],
- #'index' => [ ['last'], ['company'] ],
- 'index' => [ ['last'], [ 'company' ], [ 'referral_custnum' ],
- [ 'daytime' ], [ 'night' ], [ 'fax' ],
- ],
- },
-
- 'cust_main_invoice' => {
- 'columns' => [
- 'destnum', 'int', '', '',
- 'custnum', 'int', '', '',
- 'dest', 'varchar', '', $char_d,
- ],
- 'primary_key' => 'destnum',
- 'unique' => [],
- 'index' => [ ['custnum'], ],
- },
-
- 'cust_main_county' => { #county+state+country are checked off the
- #cust_main_county for validation and to provide
- # a tax rate.
- 'columns' => [
- 'taxnum', 'int', '', '',
- 'state', 'varchar', 'NULL', $char_d,
- 'county', 'varchar', 'NULL', $char_d,
- 'country', 'char', '', 2,
- 'taxclass', 'varchar', 'NULL', $char_d,
- 'exempt_amount', @money_type,
- 'tax', 'real', '', '', #tax %
- ],
- 'primary_key' => 'taxnum',
- 'unique' => [],
- # 'unique' => [ ['taxnum'], ['state', 'county'] ],
- 'index' => [],
- },
-
- 'cust_pay' => {
- 'columns' => [
- 'paynum', 'int', '', '',
- #now cust_bill_pay #'invnum', 'int', '', '',
- 'custnum', 'int', '', '',
- 'paid', @money_type,
- '_date', @date_type,
- 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index into
- # payment type table.
- 'payinfo', 'varchar', 'NULL', $char_d, #see cust_main above
- 'paybatch', 'varchar', 'NULL', $char_d, #for auditing purposes.
- 'closed', 'char', 'NULL', 1,
- ],
- 'primary_key' => 'paynum',
- 'unique' => [],
- 'index' => [ [ 'custnum' ], [ 'paybatch' ] ],
- },
-
- 'cust_bill_pay' => {
- 'columns' => [
- 'billpaynum', 'int', '', '',
- 'invnum', 'int', '', '',
- 'paynum', 'int', '', '',
- 'amount', @money_type,
- '_date', @date_type
- ],
- 'primary_key' => 'billpaynum',
- 'unique' => [],
- 'index' => [ [ 'paynum' ], [ 'invnum' ] ],
- },
-
- 'cust_pay_batch' => { #what's this used for again? list of customers
- #in current CARD batch? (necessarily CARD?)
- 'columns' => [
- 'paybatchnum', 'int', '', '',
- 'invnum', 'int', '', '',
- 'custnum', 'int', '', '',
- 'last', 'varchar', '', $char_d,
- 'first', 'varchar', '', $char_d,
- 'address1', 'varchar', '', $char_d,
- 'address2', 'varchar', 'NULL', $char_d,
- 'city', 'varchar', '', $char_d,
- 'state', 'varchar', 'NULL', $char_d,
- 'zip', 'varchar', '', 10,
- 'country', 'char', '', 2,
-# 'trancode', 'int', '', '',
- 'cardnum', 'varchar', '', 16,
- #'exp', @date_type,
- 'exp', 'varchar', '', 11,
- 'payname', 'varchar', 'NULL', $char_d,
- 'amount', @money_type,
- ],
- 'primary_key' => 'paybatchnum',
- 'unique' => [],
- 'index' => [ ['invnum'], ['custnum'] ],
- },
-
- 'cust_pkg' => {
- 'columns' => [
- 'pkgnum', 'int', '', '',
- 'custnum', 'int', '', '',
- 'pkgpart', 'int', '', '',
- 'otaker', 'varchar', '', 8,
- 'setup', @date_type,
- 'bill', @date_type,
- 'susp', @date_type,
- 'cancel', @date_type,
- 'expire', @date_type,
- 'manual_flag', 'char', 'NULL', 1,
- ],
- 'primary_key' => 'pkgnum',
- 'unique' => [],
- 'index' => [ ['custnum'] ],
- },
-
- 'cust_refund' => {
- 'columns' => [
- 'refundnum', 'int', '', '',
- #now cust_credit_refund #'crednum', 'int', '', '',
- 'custnum', 'int', '', '',
- '_date', @date_type,
- 'refund', @money_type,
- 'otaker', 'varchar', '', 8,
- 'reason', 'varchar', '', $char_d,
- 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index
- # into payment type table.
- 'payinfo', 'varchar', 'NULL', $char_d, #see cust_main above
- 'paybatch', 'varchar', 'NULL', $char_d,
- 'closed', 'char', 'NULL', 1,
- ],
- 'primary_key' => 'refundnum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'cust_credit_refund' => {
- 'columns' => [
- 'creditrefundnum', 'int', '', '',
- 'crednum', 'int', '', '',
- 'refundnum', 'int', '', '',
- 'amount', @money_type,
- '_date', @date_type
- ],
- 'primary_key' => 'creditrefundnum',
- 'unique' => [],
- 'index' => [ [ 'crednum', 'refundnum' ] ],
- },
-
-
- 'cust_svc' => {
- 'columns' => [
- 'svcnum', 'int', '', '',
- 'pkgnum', 'int', 'NULL', '',
- 'svcpart', 'int', '', '',
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [],
- 'index' => [ ['svcnum'], ['pkgnum'], ['svcpart'] ],
- },
-
- 'part_pkg' => {
- 'columns' => [
- 'pkgpart', 'int', '', '',
- 'pkg', 'varchar', '', $char_d,
- 'comment', 'varchar', '', $char_d,
- 'setup', @perl_type,
- 'freq', 'int', '', '', #billing frequency (months)
- 'recur', @perl_type,
- 'setuptax', 'char', 'NULL', 1,
- 'recurtax', 'char', 'NULL', 1,
- 'plan', 'varchar', 'NULL', $char_d,
- 'plandata', 'text', 'NULL', '',
- 'disabled', 'char', 'NULL', 1,
- 'taxclass', 'varchar', 'NULL', $char_d,
- ],
- 'primary_key' => 'pkgpart',
- 'unique' => [],
- 'index' => [ [ 'disabled' ] ],
- },
-
-# 'part_title' => {
-# 'columns' => [
-# 'titlenum', 'int', '', '',
-# 'title', 'varchar', '', $char_d,
-# ],
-# 'primary_key' => 'titlenum',
-# 'unique' => [ [] ],
-# 'index' => [ [] ],
-# },
-
- 'pkg_svc' => {
- 'columns' => [
- 'pkgpart', 'int', '', '',
- 'svcpart', 'int', '', '',
- 'quantity', 'int', '', '',
- ],
- 'primary_key' => '',
- 'unique' => [ ['pkgpart', 'svcpart'] ],
- 'index' => [ ['pkgpart'] ],
- },
-
- 'part_referral' => {
- 'columns' => [
- 'refnum', 'int', '', '',
- 'referral', 'varchar', '', $char_d,
- ],
- 'primary_key' => 'refnum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'part_svc' => {
- 'columns' => [
- 'svcpart', 'int', '', '',
- 'svc', 'varchar', '', $char_d,
- 'svcdb', 'varchar', '', $char_d,
- 'disabled', 'char', 'NULL', 1,
- ],
- 'primary_key' => 'svcpart',
- 'unique' => [],
- 'index' => [ [ 'disabled' ] ],
- },
-
- 'part_svc_column' => {
- 'columns' => [
- 'columnnum', 'int', '', '',
- 'svcpart', 'int', '', '',
- 'columnname', 'varchar', '', 64,
- 'columnvalue', 'varchar', 'NULL', $char_d,
- 'columnflag', 'char', 'NULL', 1,
- ],
- 'primary_key' => 'columnnum',
- 'unique' => [ [ 'svcpart', 'columnname' ] ],
- 'index' => [ [ 'svcpart' ] ],
- },
-
- #(this should be renamed to part_pop)
- 'svc_acct_pop' => {
- 'columns' => [
- 'popnum', 'int', '', '',
- 'city', 'varchar', '', $char_d,
- 'state', 'varchar', '', $char_d,
- 'ac', 'char', '', 3,
- 'exch', 'char', '', 3,
- 'loc', 'char', 'NULL', 4, #NULL for legacy purposes
- ],
- 'primary_key' => 'popnum',
- 'unique' => [],
- 'index' => [ [ 'state' ] ],
- },
-
- 'part_pop_local' => {
- 'columns' => [
- 'localnum', 'int', '', '',
- 'popnum', 'int', '', '',
- 'city', 'varchar', 'NULL', $char_d,
- 'state', 'char', 'NULL', 2,
- 'npa', 'char', '', 3,
- 'nxx', 'char', '', 3,
- ],
- 'primary_key' => 'localnum',
- 'unique' => [],
- 'index' => [ [ 'npa', 'nxx' ], [ 'popnum' ] ],
- },
-
- 'svc_acct' => {
- 'columns' => [
- 'svcnum', 'int', '', '',
- 'username', 'varchar', '', $username_len, #unique (& remove dup code)
- '_password', 'varchar', '', 50, #13 for encryped pw's plus ' *SUSPENDED* (mp5 passwords can be 34)
- 'sec_phrase', 'varchar', 'NULL', $char_d,
- 'popnum', 'int', 'NULL', '',
- 'uid', 'int', 'NULL', '',
- 'gid', 'int', 'NULL', '',
- 'finger', 'varchar', 'NULL', $char_d,
- 'dir', 'varchar', 'NULL', $char_d,
- 'shell', 'varchar', 'NULL', $char_d,
- 'quota', 'varchar', 'NULL', $char_d,
- 'slipip', 'varchar', 'NULL', 15, #four TINYINTs, bah.
- 'seconds', 'int', 'NULL', '', #uhhhh
- 'domsvc', 'int', '', '',
- ],
- 'primary_key' => 'svcnum',
- #'unique' => [ [ 'username', 'domsvc' ] ],
- 'unique' => [],
- 'index' => [ ['username'], ['domsvc'] ],
- },
-
-# 'svc_acct_sm' => {
-# 'columns' => [
-# 'svcnum', 'int', '', '',
-# 'domsvc', 'int', '', '',
-# 'domuid', 'int', '', '',
-# 'domuser', 'varchar', '', $char_d,
-# ],
-# 'primary_key' => 'svcnum',
-# 'unique' => [ [] ],
-# 'index' => [ ['domsvc'], ['domuid'] ],
-# },
-
- #'svc_charge' => {
- # 'columns' => [
- # 'svcnum', 'int', '', '',
- # 'amount', @money_type,
- # ],
- # 'primary_key' => 'svcnum',
- # 'unique' => [ [] ],
- # 'index' => [ [] ],
- #},
-
- 'svc_domain' => {
- 'columns' => [
- 'svcnum', 'int', '', '',
- 'domain', 'varchar', '', $char_d,
- 'catchall', 'int', 'NULL', '',
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [ ['domain'] ],
- 'index' => [],
- },
-
- 'domain_record' => {
- 'columns' => [
- 'recnum', 'int', '', '',
- 'svcnum', 'int', '', '',
- #'reczone', 'varchar', '', $char_d,
- 'reczone', 'varchar', '', 255,
- 'recaf', 'char', '', 2,
- 'rectype', 'char', '', 5,
- #'recdata', 'varchar', '', $char_d,
- 'recdata', 'varchar', '', 255,
- ],
- 'primary_key' => 'recnum',
- 'unique' => [],
- 'index' => [ ['svcnum'] ],
- },
-
- 'svc_forward' => {
- 'columns' => [
- 'svcnum', 'int', '', '',
- 'srcsvc', 'int', '', '',
- 'dstsvc', 'int', '', '',
- 'dst', 'varchar', 'NULL', $char_d,
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [],
- 'index' => [ ['srcsvc'], ['dstsvc'] ],
- },
-
- 'svc_www' => {
- 'columns' => [
- 'svcnum', 'int', '', '',
- 'recnum', 'int', '', '',
- 'usersvc', 'int', '', '',
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [],
- 'index' => [],
- },
-
- #'svc_wo' => {
- # 'columns' => [
- # 'svcnum', 'int', '', '',
- # 'svcnum', 'int', '', '',
- # 'svcnum', 'int', '', '',
- # 'worker', 'varchar', '', $char_d,
- # '_date', @date_type,
- # ],
- # 'primary_key' => 'svcnum',
- # 'unique' => [ [] ],
- # 'index' => [ [] ],
- #},
-
- 'prepay_credit' => {
- 'columns' => [
- 'prepaynum', 'int', '', '',
- 'identifier', 'varchar', '', $char_d,
- 'amount', @money_type,
- 'seconds', 'int', 'NULL', '',
- ],
- 'primary_key' => 'prepaynum',
- 'unique' => [ ['identifier'] ],
- 'index' => [],
- },
-
- 'port' => {
- 'columns' => [
- 'portnum', 'int', '', '',
- 'ip', 'varchar', 'NULL', 15,
- 'nasport', 'int', 'NULL', '',
- 'nasnum', 'int', '', '',
- ],
- 'primary_key' => 'portnum',
- 'unique' => [],
- 'index' => [],
- },
-
- 'nas' => {
- 'columns' => [
- 'nasnum', 'int', '', '',
- 'nas', 'varchar', '', $char_d,
- 'nasip', 'varchar', '', 15,
- 'nasfqdn', 'varchar', '', $char_d,
- 'last', 'int', '', '',
- ],
- 'primary_key' => 'nasnum',
- 'unique' => [ [ 'nas' ], [ 'nasip' ] ],
- 'index' => [ [ 'last' ] ],
- },
-
- 'session' => {
- 'columns' => [
- 'sessionnum', 'int', '', '',
- 'portnum', 'int', '', '',
- 'svcnum', 'int', '', '',
- 'login', @date_type,
- 'logout', @date_type,
- ],
- 'primary_key' => 'sessionnum',
- 'unique' => [],
- 'index' => [ [ 'portnum' ] ],
- },
-
- 'queue' => {
- 'columns' => [
- 'jobnum', 'int', '', '',
- 'job', 'text', '', '',
- '_date', 'int', '', '',
- 'status', 'varchar', '', $char_d,
- 'statustext', 'text', 'NULL', '',
- 'svcnum', 'int', 'NULL', '',
- ],
- 'primary_key' => 'jobnum',
- 'unique' => [],
- 'index' => [ [ 'svcnum' ], [ 'status' ] ],
- },
-
- 'queue_arg' => {
- 'columns' => [
- 'argnum', 'int', '', '',
- 'jobnum', 'int', '', '',
- 'arg', 'text', 'NULL', '',
- ],
- 'primary_key' => 'argnum',
- 'unique' => [],
- 'index' => [ [ 'jobnum' ] ],
- },
-
- 'queue_depend' => {
- 'columns' => [
- 'dependnum', 'int', '', '',
- 'jobnum', 'int', '', '',
- 'depend_jobnum', 'int', '', '',
- ],
- 'primary_key' => 'dependnum',
- 'unique' => [],
- 'index' => [ [ 'jobnum' ], [ 'depend_jobnum' ] ],
- },
-
- 'export_svc' => {
- 'columns' => [
- 'exportsvcnum' => 'int', '', '',
- 'exportnum' => 'int', '', '',
- 'svcpart' => 'int', '', '',
- ],
- 'primary_key' => 'exportsvcnum',
- 'unique' => [ [ 'exportnum', 'svcpart' ] ],
- 'index' => [ [ 'exportnum' ], [ 'svcpart' ] ],
- },
-
- 'part_export' => {
- 'columns' => [
- 'exportnum', 'int', '', '',
- #'svcpart', 'int', '', '',
- 'machine', 'varchar', '', $char_d,
- 'exporttype', 'varchar', '', $char_d,
- 'nodomain', 'char', 'NULL', 1,
- ],
- 'primary_key' => 'exportnum',
- 'unique' => [],
- 'index' => [ [ 'machine' ], [ 'exporttype' ] ],
- },
-
- 'part_export_option' => {
- 'columns' => [
- 'optionnum', 'int', '', '',
- 'exportnum', 'int', '', '',
- 'optionname', 'varchar', '', $char_d,
- 'optionvalue', 'text', 'NULL', '',
- ],
- 'primary_key' => 'optionnum',
- 'unique' => [],
- 'index' => [ [ 'exportnum' ], [ 'optionname' ] ],
- },
-
- 'radius_usergroup' => {
- 'columns' => [
- 'usergroupnum', 'int', '', '',
- 'svcnum', 'int', '', '',
- 'groupname', 'varchar', '', $char_d,
- ],
- 'primary_key' => 'usergroupnum',
- 'unique' => [],
- 'index' => [ [ 'svcnum' ], [ 'groupname' ] ],
- },
-
- 'msgcat' => {
- 'columns' => [
- 'msgnum', 'int', '', '',
- 'msgcode', 'varchar', '', $char_d,
- 'locale', 'varchar', '', 16,
- 'msg', 'text', '', '',
- ],
- 'primary_key' => 'msgnum',
- 'unique' => [ [ 'msgcode', 'locale' ] ],
- 'index' => [],
- },
-
- 'cust_tax_exempt' => {
- 'columns' => [
- 'exemptnum', 'int', '', '',
- 'custnum', 'int', '', '',
- 'taxnum', 'int', '', '',
- 'year', 'int', '', '',
- 'month', 'int', '', '',
- 'amount', @money_type,
- ],
- 'primary_key' => 'exemptnum',
- 'unique' => [ [ 'custnum', 'taxnum', 'year', 'month' ] ],
- 'index' => [],
- },
-
-
-
- );
-
- %tables;
-
-}
-
#!/usr/bin/perl
-foreach $file ( split(/\n/, `find . -depth -print | grep cgi\$`) ) {
+foreach $file ( split(/\n/, `find . -depth -print`) ) {
+ next unless $file =~ /(cgi|html)$/;
open(F,$file) or die "can't open $file for reading: $!";
@file = <F>;
#print "$file ". scalar(@file). "\n";
close $file;
- system("chmod u+w $file");
- open(W,">$file") or die "can't open $file for writing: $!";
- select W; $| = 1; select STDOUT;
+ $newline = ''; #avoid prepending extraneous newlines
$all = join('',@file);
+ $w = '';
+
$mode = 'html';
while ( length($all) ) {
if ( $mode eq 'html' ) {
if ( $all =~ /^(.+?)(<%=?.*)$/s && $1 !~ /<%/s ) {
- print W $1;
+ $w .= $1;
$all = $2;
next;
} elsif ( $all =~ /^<%=(.*)$/s ) {
- print W '<%';
+ $w .= '<%';
$all = $1;
$mode = 'perlv';
#die;
next;
} elsif ( $all =~ /^<%(.*)$/s ) {
- print W "\n";
+ $w .= $newline; $newline = "\n";
$all = $1;
$mode = 'perlc';
+
+ #avoid newline prepend fix from borking indented first <%
+ $w =~ s/\n\s+\z/\n/;
+ $w .= "\n" if $w =~ /.+\z/;
+
next;
} elsif ( $all !~ /<%/s ) {
- print W $all;
+ $w .= $all;
last;
} else {
warn length($all); die;
} elsif ( $mode eq 'perlv' ) {
if ( $all =~ /^(.*?%>)(.*)$/s ) {
- print W $1;
+ $w .= $1;
$all=$2;
$mode = 'html';
next;
} elsif ( $mode eq 'perlc' ) {
if ( $all =~ /^([^\n]*?)%>(.*)$/s ) {
- print W "%$1\n";
+ $w .= "%$1\n";
$all=$2;
$mode='html';
next;
}
if ( $all =~ /^([^\n]*)\n(.*)$/s ) {
- print W "%$1\n";
+ $w .= "%$1\n";
$all=$2;
next;
}
}
+ system("chmod u+w $file");
+ select W; $| = 1; select STDOUT;
+ open(W,">$file") or die "can't open $file for writing: $!";
+ print W $w;
close W;
}
#!/usr/bin/perl -Tw
-# $Id: passwd.import,v 1.5.4.3 2003-06-12 14:08:02 ivan Exp $
use strict;
use vars qw(%part_svc);
my($username,$password)=split(/:/);
#$password =~ s/^\!$/\*/;
#$password =~ s/\!+/\*SUSPENDED\* /;
+ $password =~ s/^NP$/\*/;
+ $password =~ s/^\*LK\*$/\*/;
$password{$username}=$password;
}
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+#use File::Path;
+use File::Rsync;
+use Net::SSH qw(ssh);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch); # qsearchs);
+use FS::part_export;
+#use FS::cust_pkg;
+use FS::cust_svc;
+#use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/postfix";
+mkdir $spooldir, 0700 unless -d $spooldir;
+
+my @exports = qsearch('part_export', { 'exporttype' => 'postfix' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @exports ) {
+
+ my $machine = $export->machine;
+ my $prefix = "$spooldir/$machine";
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ #construct %domain hash
+
+ my $mydomain = $export->option('mydomain');
+ my %domain;
+ foreach my $svc_forward ( $export->svc_x ) {
+
+ my( $username, $domain );
+ my $srcsvc_acct = $svc_forward->srcsvc_acct;
+ if ( $srcsvc_acct ) {
+ ( $username, $domain ) = ( $srcsvc_acct->username, $srcsvc_acct->domain );
+ } elsif ( $svc_forward->src =~ /([^@]*)\@([^@]+)$/ ) {
+ ( $username, $domain ) = ( $1, $2 );
+ } else {
+ die "bad svc_forward record? svcnum ". $svc_forward->svcnum. "\n";
+ }
+
+ my( $dusername, $ddomain );
+ my $dstsvc_acct = $svc_forward->dstsvc_acct;
+ if ( $dstsvc_acct ) {
+ $dusername = $dstsvc_acct->username;
+ $ddomain = $dstsvc_acct->domain;
+ } elsif ( $svc_forward->dst =~ /([^@]+)\@([^@]+)$/ ) {
+ ( $dusername, $ddomain ) = ( $1, $2 );
+ } else {
+ die "bad svc_forward record? svcnum ". $svc_forward->svcnum. "\n";
+ }
+ my $dest;
+ if ( $ddomain eq $mydomain ) {
+ $dest = $dusername;
+ } else {
+ $dest = "$dusername\@$ddomain";
+ }
+
+ push @{$domain{$domain}{$username}}, $dest;
+
+ }
+
+ #write aliases
+
+ my $aliases = delete $domain{$mydomain};
+ open(ALIASES, ">$prefix/aliases") or die "can't open $prefix/aliases: $!";
+ foreach my $alias ( keys %$aliases ) {
+ print ALIASES "$alias: ". join(',', @{ $aliases->{$alias} } ). "\n";
+ }
+ close ALIASES;
+
+ #write virtual
+
+ open(VIRTUAL, ">$prefix/virtual") or die "can't open $prefix/virtual: $!";
+ foreach my $domain ( keys %domain ) {
+ print VIRTUAL "$domain DOMAIN\n";
+ #foreach my $virtual ( sort { $a ne '' <=> $b ne '' } keys %{$domain{$domain}} ) {
+ foreach my $virtual ( sort { ( ($b ne '') <=> ($a ne '') ) || $a cmp $b } keys %{$domain{$domain}} ) {
+ print VIRTUAL "$virtual\@$domain ".
+ join(',', @{ $domain{$domain}{$virtual} } ). "\n";
+ }
+ print VIRTUAL "\n";
+ }
+ close VIRTUAL;
+
+ #rsync
+
+ my $user = $export->option('user');
+ $rsync->exec( {
+ src => "$prefix/aliases",
+ dest => "$user\@$machine:". $export->option('aliases'),
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+# warn $rsync->out;
+
+ ssh("$user\@$machine", $export->option('newaliases') || 'newaliases');
+# ssh("$user\@$machine", "postfix reload");
+
+ $rsync->exec( {
+ src => "$prefix/virtual",
+ dest => "$user\@$machine:". $export->option('virtual'),
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+# warn $rsync->out;
+ ssh("$user\@$machine", $export->option('postmap')
+ || 'postmap hash:/etc/postfix/virtual');
+ ssh("$user\@$machine", $export->option('reload') || 'postfix reload');
+
+}
+
+# -----
+
+sub usage {
+ die "Usage:\n postfix.export user\n";
+}
+
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+use strict;
+use vars qw(%part_svc %domain_part_svc);
+#use Date::Parse;
+use DBI;
+use Term::Query qw(query);
+use FS::UID qw(adminsuidsetup); #datasrc
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::part_svc;
+use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others?
+
+$FS::svc_Common::noexport_hack = 1;
+$FS::svc_domain::whois_hack = 1;
+
+###
+
+%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Enter part number to import.
+END
+my $mailbox_svcpart = &getpart;
+
+%domain_part_svc = map { $_->svcpart, $_ }
+ qsearch('part_svc', { 'svcdb' => 'svc_domain'} );
+
+die "No services with svcdb svc_domain!\n" unless %domain_part_svc;
+
+print "\n\n", &menu_domain_svc, "\n", <<END;
+Enter part number for domains.
+END
+my $domain_svcpart = &getdomainpart;
+
+my $datasrc = &getvalue("\n\nEnter the DBI datasource:");
+my $db_user = &getvalue("\n\nEnter the database user:");
+my $db_pass = &getvalue("\n\nEnter the database password:");
+
+sub menu_svc {
+ ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
+}
+sub menu_domain_svc {
+ ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_part_svc ). "\n";
+}
+sub getpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
+}
+sub getdomainpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %domain_part_svc ];
+ $^W=1;
+ $return;
+}
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+###
+
+my $dbh = DBI->connect( $datasrc, $db_user, $db_pass )
+ or die $DBI::errstr;
+
+my $sth = $dbh->prepare('SELECT username, password, crypt, name, domain FROM mailbox')
+ or die $dbh->errstr;
+$sth->execute or die $sth->errstr;
+
+my $row;
+while ( defined ( $row = $sth->fetchrow_arrayref ) ) {
+ my( $r_username, $password, $crypt, $finger, $r_domain ) = @$row;
+
+ my( $username, $domain );
+ if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) {
+ $username = $1;
+ $domain = $2;
+ } else {
+ $username = $r_username;
+ $domain = $r_domain;
+ }
+ my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
+ || new FS::svc_domain {
+ 'domain' => $domain,
+ 'svcpart' => $domain_svcpart,
+ 'action' => 'N',
+ };
+ unless ( $svc_domain->svcnum ) {
+ my $error = $svc_domain->insert;
+ if ( $error ) {
+ die "can't insert domain $domain: $error\n";
+ }
+ }
+
+ $password = $crypt if $password eq '*CRYPTED*';
+
+ $finger =~ s/Outdoor Power.*$/Outdoor Power/;
+
+ my $svc_acct = new FS::svc_acct {
+ 'svcpart' => $mailbox_svcpart,
+ 'username' => $username,
+ 'domsvc' => $svc_domain->svcnum,
+ '_password' => $password,
+ 'finger' => $finger,
+ };
+
+ my $error = $svc_acct->insert;
+ #my $error = $svc_acct->check;
+ if ( $error ) {
+ if ( $error =~ /duplicate/i ) {
+ warn "$r_username / $r_domain: $error";
+ } else {
+ die "$r_username / $r_domain: $error";
+ }
+ }
+
+}
+
+sub usage {
+ die "Usage:\n\n postfix_courierimap.import user\n";
+}
+
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Term::Query qw(query);
+use Net::SCP qw(iscp);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+##use FS::svc_acct_sm;
+#use FS::svc_domain;
+#use FS::domain_record;
+use FS::svc_acct;
+##use FS::part_svc;
+use FS::svc_forward;
+use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+#$FS::svc_Common::noexport_hack = 1;
+#$FS::domain_record::noserial_hack = 1;
+
+use vars qw($defaultdomain);
+$defaultdomain = 'surferz.net';
+
+use vars qw($svcpart $forward_svcpart);
+$svcpart = 2;
+$forward_svcpart = 4;
+
+use vars qw($spooldir);
+$spooldir = "/usr/local/etc/freeside/export.". datasrc. "/sendmail";
+mkdir($spooldir, 0755) unless -d $spooldir;
+
+print "\n\n", <<END;
+Enter the location and name of your Sendmail aliases file, for example
+"mail.isp.com:/etc/mail/aliases"
+END
+my($aliases)=&getvalue(":");
+
+use vars qw($aliases_machine $aliases_prefix);
+$aliases_machine = (split(/:/, $aliases))[0];
+$aliases_prefix = "$spooldir/$aliases_machine";
+mkdir($aliases_prefix, 0755) unless -d $aliases_prefix;
+
+#iscp("root\@$aliases","$aliases_prefix/aliases.import");
+iscp("ivan\@$aliases","$aliases_prefix/aliases.import");
+
+print "\n\n", <<END;
+Enter the location and name of your Sendmail virtusertable directory, for example
+"mail.isp.com:/etc/mail/virtusertable"
+END
+my($virtusertable)=&getvalue(":");
+
+use vars qw($virtusertable_machine $virtusertable_prefix);
+$virtusertable_machine = (split(/:/, $virtusertable))[0];
+$virtusertable_prefix = "$spooldir/$virtusertable_machine";
+mkdir($virtusertable_prefix, 0755) unless -d $virtusertable_prefix;
+mkdir("$virtusertable_prefix/virtusertable.import", 0755)
+ unless -d "$virtusertable_prefix/virtusertable.import";
+
+#iscp("root\@$virtusertable/*","$aliases_prefix/virtusertable.import/");
+iscp("ivan\@$virtusertable/*","$aliases_prefix/virtusertable.import/");
+
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+##
+
+foreach my $file (
+ "$aliases_prefix/aliases.import",
+ glob("$aliases_prefix/virtusertable.import/*"),
+) {
+
+ warn "importing $file\n";
+
+ open(FILE,"<$file") or die $!;
+ while (<FILE>) {
+ next if /^\s*#/ || /^\s*$/; #skip comments & blank lines
+
+ unless ( /^([\w\@\.\-]+)[:\s]\s*(.*\S)\s*$/ ) {
+ warn "Unparsable line: $_";
+ next;
+ }
+ my($rawusername, $rawdest) = ($1, $2);
+
+ my($username, $domain);
+ if ( $rawusername =~ /^([\w\-\.\&]*)\@([\w\.\-]+)$/ ) {
+ $username = $1;
+ $domain = $2;
+ } elsif ( $rawusername =~ /\@/ ) {
+ die "Unparsable username: $rawusername\n";
+ } else {
+ $username = $rawusername;
+ $domain = $defaultdomain;
+ }
+
+ #find svc_acct record or set $src
+ my($srcsvc, $src) = &svcnum_or_literal($username, $domain);
+
+ foreach my $dest ( split(/,/, $rawdest) ) {
+
+ my($dusername, $ddomain);
+ if ( $dest =~ /^([\w\-\.\&]+)\@([\w\.\-]+)$/ ) {
+ $dusername = $1;
+ $ddomain = $2;
+ } elsif ( $dest =~ /\@/ ) {
+ die "Unparsable username: $dest\n";
+ } else {
+ $dusername = $dest;
+ $ddomain = $defaultdomain;
+ }
+ my($dstsvc, $dst) = &svcnum_or_literal($dusername, $ddomain);
+
+ my $svc_forward = new FS::svc_forward ({
+ svcpart => $forward_svcpart,
+ srcsvc => $srcsvc,
+ src => $src,
+ dstsvc => $dstsvc,
+ dst => $dst,
+ });
+ my $error = $svc_forward->insert;
+ #my $error = $svc_forward->check;
+ if ( $error ) {
+ die "$rawusername: $rawdest: $error\n";
+ }
+ }
+
+
+ } #next entry
+
+} #next file
+
+##
+
+sub svcnum_or_literal {
+ my($username, $domain) = @_;
+
+ my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } );
+ my $domsvc = $svc_domain ? $svc_domain->svcnum : '';
+
+ my @svc_acct = grep { $_->cust_svc->svcpart == $svcpart }
+ qsearch('svc_acct', {
+ 'username' => $username,
+ 'domsvc' => $domsvc,
+ });
+
+ if ( scalar(@svc_acct) > 1 ) {
+ die "multiple sources found for $username\@$domain !\n";
+ }
+
+ my( $svcnum, $literal ) = ('', '');
+ if ( @svc_acct ) {
+ my $svc_acct = $svc_acct[0];
+ $svcnum = $svc_acct->svcnum;
+ } else {
+ $literal = "$username\@$domain";
+ }
+
+ return( $svcnum, $literal );
+
+}
+
+sub usage {
+ die "Usage:\n\n sendmail.import user\n";
+}
+
+
+
+
+
--- /dev/null
+#!/usr/bin/perl -w
+#
+# -d: dry-run: make no changes
+# -r: replace: overwrite existing passwords (otherwise only "*" passwords will
+# be changed)
+# -b: blowfish replace: overwrite existing passwords only if they are
+# blowfish-encrypted
+
+use strict;
+use vars qw(%part_svc);
+use Getopt::Std;
+use Term::Query qw(query);
+use Net::SCP qw(iscp);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::part_svc;
+
+use vars qw($opt_d $opt_r $opt_b);
+getopts("drb");
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others?
+
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
+
+#$FS::svc_acct::nossh_hack = 1;
+$FS::svc_Common::noexport_hack = 1;
+
+###
+
+%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Enter part number or part numbers to import.
+END
+my($shell_svcpart)=&getvalue;
+my @shell_svcpart = split(/[,\s]+/, $shell_svcpart);
+
+print "\n\n", <<END;
+Enter the location and name of your _user_ shadow file, for example
+"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd"
+END
+my($loc_shadow)=&getvalue(":");
+iscp("root\@$loc_shadow", "$spooldir/shadow.import");
+
+sub menu_svc {
+ ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
+}
+sub getpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
+}
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+###
+
+open(SHADOW,"<$spooldir/shadow.import");
+
+my($line, $updated);
+while (<SHADOW>) {
+ $line++;
+ chop;
+ my($username,$password)=split(/:/);
+
+# my @svc_acct = grep { $_->cust_svc->svcpart == $shell_svcpart }
+# qsearch('svc_acct', { 'username' => $username } );
+ my @svc_acct = grep {
+ my $svcpart = $_->cust_svc->svcpart;
+ grep { $_ == $svcpart } @shell_svcpart;
+ } qsearch('svc_acct', { 'username' => $username } );
+
+ next unless @svc_acct;
+
+ if ( scalar(@svc_acct) > 1 ) {
+ die "more than one $username found!\n";
+ next;
+ }
+
+ my $svc_acct = shift @svc_acct;
+
+ next unless $svc_acct->_password eq '*'
+ || $opt_r
+ || ( $opt_b && $svc_acct->_password =~ /^\$2a?\$/ );
+
+ next if $svc_acct->username eq 'root';
+
+ next if $password eq 'NP' || $password eq '*LK*';
+
+ next if $svc_acct->_password eq $password;
+ next if $svc_acct->_password =~ /^\*SUSPENDED\*/;
+
+ my $new_svc_acct = new FS::svc_acct( { $svc_acct->hash } );
+ $new_svc_acct->_password($password);
+ #warn "$username: ". $svc_acct->_password. " -> $password\n";
+ warn "changing password for $username\n";
+ unless ( $opt_d ) {
+ my $error = $new_svc_acct->replace($svc_acct);
+ die "$username: $error" if $error;
+ }
+
+ $updated++;
+
+}
+
+warn "$updated of $line passwords changed\n";
+
+sub usage {
+ die "Usage:\n\n shadow.reimport [ -d ] [ -r ] user\n";
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+use strict;
+use vars qw(%part_svc %domain_part_svc);
+#use Date::Parse;
+use DBI;
+use Term::Query qw(query);
+use FS::UID qw(adminsuidsetup); #datasrc
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::part_svc;
+use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others?
+
+$FS::svc_Common::noexport_hack = 1;
+$FS::svc_domain::whois_hack = 1;
+
+###
+
+%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Enter part number to import.
+END
+my $sqlradius_svcpart = &getpart;
+
+%domain_part_svc = map { $_->svcpart, $_ }
+ qsearch('part_svc', { 'svcdb' => 'svc_domain'} );
+
+die "No services with svcdb svc_domain!\n" unless %domain_part_svc;
+
+print "\n\n", &menu_domain_svc, "\n", <<END;
+Enter part number for domains.
+END
+my $domain_svcpart = &getdomainpart;
+
+my $datasrc = &getvalue("\n\nEnter the DBI datasource:");
+my $db_user = &getvalue("\n\nEnter the database user:");
+my $db_pass = &getvalue("\n\nEnter the database password:");
+
+sub menu_svc {
+ ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
+}
+sub menu_domain_svc {
+ ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_part_svc ). "\n";
+}
+sub getpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
+}
+sub getdomainpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %domain_part_svc ];
+ $^W=1;
+ $return;
+}
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+###
+
+my $dbh = DBI->connect( $datasrc, $db_user, $db_pass )
+ or die $DBI::errstr;
+
+my $sth = $dbh->prepare('SELECT DISTINCT UserName, Realm FROM radcheck')
+ or die $dbh->errstr;
+$sth->execute or die $sth->errstr;
+
+my $row;
+while ( defined ( $row = $sth->fetchrow_arrayref ) ) {
+ my( $r_username, $realm ) = @$row;
+
+ my( $username, $domain );
+ if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) {
+ $username = $1;
+ $domain = $2;
+ } else {
+ $username = $r_username;
+ $domain = $realm;
+ }
+ my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
+ || new FS::svc_domain {
+ 'domain' => $domain,
+ 'svcpart' => $domain_svcpart,
+ 'action' => 'N',
+ };
+ unless ( $svc_domain->svcnum ) {
+ my $error = $svc_domain->insert;
+ if ( $error ) {
+ die "can't insert domain $domain: $error\n";
+ }
+ }
+
+ my( $password, $finger, $group ) = ( '', '', '' );
+
+ my $rc_sth = $dbh->prepare(
+ 'SELECT Attribute, Value, Name, GroupName'.
+ ' FROM radcheck'.
+ ' WHERE UserName = ? and Realm = ?'
+ ) or die $dbh->errstr;
+ $rc_sth->execute($r_username, $realm) or die $rc_sth->errstr;
+
+ foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) {
+ my($attribute, $value, $name, $groupname) = @$rc_row;
+ if ( $attribute =~ /^((User|Crypt)-)?Password$/ ) {
+ $password = $value;
+ $finger = $name;
+ $group = $groupname;
+ } else {
+ #handle other params!
+ }
+ }
+
+ my $svc_acct = new FS::svc_acct {
+ 'svcpart' => $sqlradius_svcpart,
+ 'username' => $username,
+ 'domsvc' => $svc_domain->svcnum,
+ '_password' => $password,
+ 'finger' => $finger,
+ };
+
+ my $error = $svc_acct->insert;
+ #my $error = $svc_acct->check;
+ if ( $error ) {
+ if ( $error =~ /duplicate/i ) {
+ warn "$r_username / $realm: $error";
+ } else {
+ die "$r_username / $realm: $error";
+ }
+ }
+
+}
+
+sub usage {
+ die "Usage:\n\n sqlradius.import user\n";
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+use strict;
+use vars qw(%part_svc %domain_part_svc);
+#use Date::Parse;
+use DBI;
+use Term::Query qw(query);
+use FS::UID qw(adminsuidsetup); #datasrc
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::part_svc;
+use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others?
+
+$FS::svc_Common::noexport_hack = 1;
+$FS::svc_domain::whois_hack = 1;
+
+###
+
+%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Enter part number to import.
+END
+my $sqlradius_svcpart = &getpart;
+
+%domain_part_svc = map { $_->svcpart, $_ }
+ qsearch('part_svc', { 'svcdb' => 'svc_domain'} );
+
+die "No services with svcdb svc_domain!\n" unless %domain_part_svc;
+
+print "\n\n", &menu_domain_svc, "\n", <<END;
+Enter part number for domains.
+END
+my $domain_svcpart = &getdomainpart;
+
+my $datasrc = &getvalue("\n\nEnter the DBI datasource:");
+my $db_user = &getvalue("\n\nEnter the database user:");
+my $db_pass = &getvalue("\n\nEnter the database password:");
+
+sub menu_svc {
+ ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
+}
+sub menu_domain_svc {
+ ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_part_svc ). "\n";
+}
+sub getpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
+}
+sub getdomainpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %domain_part_svc ];
+ $^W=1;
+ $return;
+}
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+###
+
+my $dbh = DBI->connect( $datasrc, $db_user, $db_pass )
+ or die $DBI::errstr;
+
+my $sth = $dbh->prepare('SELECT DISTINCT UserName, Realm FROM radcheck')
+ or die $dbh->errstr;
+$sth->execute or die $sth->errstr;
+
+my $row;
+while ( defined ( $row = $sth->fetchrow_arrayref ) ) {
+ my( $r_username, $realm ) = @$row;
+
+ my( $username, $domain );
+ if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) {
+ $username = $1;
+ $domain = $2;
+ } else {
+ $username = $r_username;
+ $domain = $realm;
+ }
+ my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
+ || new FS::svc_domain {
+ 'domain' => $domain,
+ 'svcpart' => $domain_svcpart,
+ 'action' => 'N',
+ };
+ unless ( $svc_domain->svcnum ) {
+ die "new domain? wtf";
+ my $error = $svc_domain->insert;
+ if ( $error ) {
+ die "can't insert domain $domain: $error\n";
+ }
+ }
+
+ my( $password, $finger, $group ) = ( '', '', '' );
+
+ my $rc_sth = $dbh->prepare(
+ 'SELECT Attribute, Value, Name, GroupName'.
+ ' FROM radcheck'.
+ ' WHERE UserName = ? and Realm = ?'
+ ) or die $dbh->errstr;
+ $rc_sth->execute($r_username, $realm) or die $rc_sth->errstr;
+
+ foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) {
+ my($attribute, $value, $name, $groupname) = @$rc_row;
+ if ( $attribute =~ /^(Crypt-)?Password$/ ) {
+ $password = $value;
+ $finger = $name;
+ $group = $groupname;
+ } else {
+ #handle other params!
+ }
+ }
+
+ my @svc_acct = grep { $_->cust_svc->svcpart == $sqlradius_svcpart }
+ qsearch('svc_acct', { 'username' => $username,
+ 'domsvc' => $svc_domain->svcnum, } );
+
+ print "$r_username / $realm: $password / $finger: ";
+ if ( scalar(@svc_acct) == 0 ) {
+ print "not found\n";
+ next;
+ } elsif ( scalar(@svc_acct) > 1 ) {
+ print "multiple matches found?!?!\n";
+ next;
+ } else {
+ print "correcting password and name\n";
+ }
+
+ my $svc_acct = $svc_acct[0];
+ my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password, 'finger' => $finger };
+ my $error = $new->replace($svc_acct);
+ #my $error = $new->check;
+ die "$r_username / $realm: $error" if $error;
+
+}
+
+sub usage {
+ die "Usage:\n\n sqlradius.import user\n";
+}
+
Ivan Kohler
-1339 Hayes St.
-San Francisco, CA 94117
+12345 Test Lane
+Truckee, CA 96161
{ $first; } { $last; }:
%% UNCOMMENT the following FOUR lines and change the path if necssary to provide a logo\r
\fancyhead[LO,LE]{\r
\begin{tabular}{l}\r
-\includegraphics{/usr/local/etc/freeside/logo.eps}\r
+\includegraphics{/usr/local/etc/freeside/conf.DBI:Pg:dbname=freeside/logo.eps}\r
\end{tabular}}\r
%\r
%% The Heading comprising isue date, customer ref & INVOICE name\r
%% Header & footer changes for subsequent pages\r
%\r
\afterpage{ \fancyfoot[RO,RE]{\small{\thepage\ of \pageref{LastPage}}} }\r
-\afterpage{ \fancyfoot[CO,CE]{\small{$org_company}} }\r
+\afterpage{ \fancyfoot[CO,CE]{\small{$smallfooter}} }\r
\afterpage{ \fancyhead[LO,LE]{\small{}} }\r
\afterpage{ \fancyhead[RO,RE]{\small{\r
\begin{tabular}{ll}\r
-Date & Account number\\\r
-\textbf{ $date_of_bill} & \textbf{ $customer_ref}\\\r
+Invoice date & Invoice number\\\r
+\textbf{$date} & \textbf{$invnum}\\\r
\end{tabular}}} }\r
%\r
%\r
Ivan Kohler\\
-P.O. Box 1272\\
-Carnelian Bay, CA~~96140\\
+12345 Test Lane\\
+Truckee, CA~~96161\\
ivan@sisd.com~~~~+1 415 462 1624\\
Freeside - open-source billing - http://www.sisd.com/freeside\\
%%
\section*{\textsc{Notes}}
\begin{enumerate}
-\item PLEASE NOTE NEW ADDRESS!
\item Please make your check payable to \textbf{Ivan Kohler}.
\item If you have any questions please email or telephone.
\end{enumerate}
--- /dev/null
+Ivan Kohler~~~Freeside - open-source billing
Ivan Kohler
-1339 Hayes St.
-San Francisco, CA 94117
+12345 Test Lane
+Truckee, CA 96161
{ $address[0]; }
--- /dev/null
+%!PS-Adobe-2.0 EPSF-2.0
+%%BoundingBox: 261 345 419 447
+%%HiResBoundingBox: 261.500000 345.500000 418.500000 446.500000
+%%Creator: xpdf/pdftops 3.00
+%%LanguageLevel: 2
+%%DocumentMedia: plain 612 792 0 () ()
+%%EndComments
+% EPSF created by ps2eps 1.54
+%%BeginProlog
+save
+countdictstack
+mark
+newpath
+/showpage {} def
+/setpagedevice {pop} def
+%%EndProlog
+%%Page 1 1
+/xpdf 75 dict def xpdf begin
+% PDF special state
+/pdfDictSize 15 def
+/pdfSetup {
+ 3 1 roll 2 array astore
+ /setpagedevice where {
+ pop 3 dict begin
+ /PageSize exch def
+ /ImagingBBox null def
+ /Policies 1 dict dup begin /PageSize 3 def end def
+ { /Duplex true def } if
+ currentdict end setpagedevice
+ } {
+ pop pop
+ } ifelse
+} def
+/pdfStartPage {
+ pdfDictSize dict begin
+ /pdfFill [0] def
+ /pdfStroke [0] def
+ /pdfLastFill false def
+ /pdfLastStroke false def
+ /pdfTextMat [1 0 0 1 0 0] def
+ /pdfFontSize 0 def
+ /pdfCharSpacing 0 def
+ /pdfTextRender 0 def
+ /pdfTextRise 0 def
+ /pdfWordSpacing 0 def
+ /pdfHorizScaling 1 def
+ /pdfTextClipPath [] def
+} def
+/pdfEndPage { end } def
+% separation convention operators
+/findcmykcustomcolor where {
+ pop
+}{
+ /findcmykcustomcolor { 5 array astore } def
+} ifelse
+/setcustomcolor where {
+ pop
+}{
+ /setcustomcolor {
+ exch
+ [ exch /Separation exch dup 4 get exch /DeviceCMYK exch
+ 0 4 getinterval cvx
+ [ exch /dup load exch { mul exch dup } /forall load
+ /pop load dup ] cvx
+ ] setcolorspace setcolor
+ } def
+} ifelse
+/customcolorimage where {
+ pop
+}{
+ /customcolorimage {
+ gsave
+ [ exch /Separation exch dup 4 get exch /DeviceCMYK exch
+ 0 4 getinterval
+ [ exch /dup load exch { mul exch dup } /forall load
+ /pop load dup ] cvx
+ ] setcolorspace
+ 10 dict begin
+ /ImageType 1 def
+ /DataSource exch def
+ /ImageMatrix exch def
+ /BitsPerComponent exch def
+ /Height exch def
+ /Width exch def
+ /Decode [1 0] def
+ currentdict end
+ image
+ grestore
+ } def
+} ifelse
+% PDF color state
+/sCol {
+ pdfLastStroke not {
+ pdfStroke aload length
+ dup 1 eq {
+ pop setgray
+ }{
+ dup 3 eq {
+ pop setrgbcolor
+ }{
+ 4 eq {
+ setcmykcolor
+ }{
+ findcmykcustomcolor exch setcustomcolor
+ } ifelse
+ } ifelse
+ } ifelse
+ /pdfLastStroke true def /pdfLastFill false def
+ } if
+} def
+/fCol {
+ pdfLastFill not {
+ pdfFill aload length
+ dup 1 eq {
+ pop setgray
+ }{
+ dup 3 eq {
+ pop setrgbcolor
+ }{
+ 4 eq {
+ setcmykcolor
+ }{
+ findcmykcustomcolor exch setcustomcolor
+ } ifelse
+ } ifelse
+ } ifelse
+ /pdfLastFill true def /pdfLastStroke false def
+ } if
+} def
+% build a font
+/pdfMakeFont {
+ 4 3 roll findfont
+ 4 2 roll matrix scale makefont
+ dup length dict begin
+ { 1 index /FID ne { def } { pop pop } ifelse } forall
+ /Encoding exch def
+ currentdict
+ end
+ definefont pop
+} def
+/pdfMakeFont16 {
+ exch findfont
+ dup length dict begin
+ { 1 index /FID ne { def } { pop pop } ifelse } forall
+ /WMode exch def
+ currentdict
+ end
+ definefont pop
+} def
+/pdfMakeFont16L3 {
+ 1 index /CIDFont resourcestatus {
+ pop pop 1 index /CIDFont findresource /CIDFontType known
+ } {
+ false
+ } ifelse
+ {
+ 0 eq { /Identity-H } { /Identity-V } ifelse
+ exch 1 array astore composefont pop
+ } {
+ pdfMakeFont16
+ } ifelse
+} def
+% graphics state operators
+/q { gsave pdfDictSize dict begin } def
+/Q { end grestore } def
+/cm { concat } def
+/d { setdash } def
+/i { setflat } def
+/j { setlinejoin } def
+/J { setlinecap } def
+/M { setmiterlimit } def
+/w { setlinewidth } def
+% color operators
+/g { dup 1 array astore /pdfFill exch def setgray
+ /pdfLastFill true def /pdfLastStroke false def } def
+/G { dup 1 array astore /pdfStroke exch def setgray
+ /pdfLastStroke true def /pdfLastFill false def } def
+/rg { 3 copy 3 array astore /pdfFill exch def setrgbcolor
+ /pdfLastFill true def /pdfLastStroke false def } def
+/RG { 3 copy 3 array astore /pdfStroke exch def setrgbcolor
+ /pdfLastStroke true def /pdfLastFill false def } def
+/k { 4 copy 4 array astore /pdfFill exch def setcmykcolor
+ /pdfLastFill true def /pdfLastStroke false def } def
+/K { 4 copy 4 array astore /pdfStroke exch def setcmykcolor
+ /pdfLastStroke true def /pdfLastFill false def } def
+/ck { 6 copy 6 array astore /pdfFill exch def
+ findcmykcustomcolor exch setcustomcolor
+ /pdfLastFill true def /pdfLastStroke false def } def
+/CK { 6 copy 6 array astore /pdfStroke exch def
+ findcmykcustomcolor exch setcustomcolor
+ /pdfLastStroke true def /pdfLastFill false def } def
+% path segment operators
+/m { moveto } def
+/l { lineto } def
+/c { curveto } def
+/re { 4 2 roll moveto 1 index 0 rlineto 0 exch rlineto
+ neg 0 rlineto closepath } def
+/h { closepath } def
+% path painting operators
+/S { sCol stroke } def
+/Sf { fCol stroke } def
+/f { fCol fill } def
+/f* { fCol eofill } def
+% clipping operators
+/W { clip newpath } def
+/W* { eoclip newpath } def
+% text state operators
+/Tc { /pdfCharSpacing exch def } def
+/Tf { dup /pdfFontSize exch def
+ dup pdfHorizScaling mul exch matrix scale
+ pdfTextMat matrix concatmatrix dup 4 0 put dup 5 0 put
+ exch findfont exch makefont setfont } def
+/Tr { /pdfTextRender exch def } def
+/Ts { /pdfTextRise exch def } def
+/Tw { /pdfWordSpacing exch def } def
+/Tz { /pdfHorizScaling exch def } def
+% text positioning operators
+/Td { pdfTextMat transform moveto } def
+/Tm { /pdfTextMat exch def } def
+% text string operators
+/cshow where {
+ pop
+ /cshow2 {
+ dup {
+ pop pop
+ 1 string dup 0 3 index put 3 index exec
+ } exch cshow
+ pop pop
+ } def
+}{
+ /cshow2 {
+ currentfont /FontType get 0 eq {
+ 0 2 2 index length 1 sub {
+ 2 copy get exch 1 add 2 index exch get
+ 2 copy exch 256 mul add
+ 2 string dup 0 6 5 roll put dup 1 5 4 roll put
+ 3 index exec
+ } for
+ } {
+ dup {
+ 1 string dup 0 3 index put 3 index exec
+ } forall
+ } ifelse
+ pop pop
+ } def
+} ifelse
+/awcp {
+ exch {
+ false charpath
+ 5 index 5 index rmoveto
+ 6 index eq { 7 index 7 index rmoveto } if
+ } exch cshow2
+ 6 {pop} repeat
+} def
+/Tj {
+ fCol
+ 1 index stringwidth pdfTextMat idtransform pop
+ sub 1 index length dup 0 ne { div } { pop pop 0 } ifelse
+ pdfWordSpacing pdfHorizScaling mul 0 pdfTextMat dtransform 32
+ 4 3 roll pdfCharSpacing pdfHorizScaling mul add 0
+ pdfTextMat dtransform
+ 6 5 roll Tj1
+} def
+/Tj16 {
+ fCol
+ 2 index stringwidth pdfTextMat idtransform pop
+ sub exch div
+ pdfWordSpacing pdfHorizScaling mul 0 pdfTextMat dtransform 32
+ 4 3 roll pdfCharSpacing pdfHorizScaling mul add 0
+ pdfTextMat dtransform
+ 6 5 roll Tj1
+} def
+/Tj16V {
+ fCol
+ 2 index stringwidth pdfTextMat idtransform exch pop
+ sub exch div
+ 0 pdfWordSpacing pdfTextMat dtransform 32
+ 4 3 roll pdfCharSpacing add 0 exch
+ pdfTextMat dtransform
+ 6 5 roll Tj1
+} def
+/Tj1 {
+ 0 pdfTextRise pdfTextMat dtransform rmoveto
+ currentpoint 8 2 roll
+ pdfTextRender 1 and 0 eq {
+ 6 copy awidthshow
+ } if
+ pdfTextRender 3 and dup 1 eq exch 2 eq or {
+ 7 index 7 index moveto
+ 6 copy
+ currentfont /FontType get 3 eq { fCol } { sCol } ifelse
+ false awcp currentpoint stroke moveto
+ } if
+ pdfTextRender 4 and 0 ne {
+ 8 6 roll moveto
+ false awcp
+ /pdfTextClipPath [ pdfTextClipPath aload pop
+ {/moveto cvx}
+ {/lineto cvx}
+ {/curveto cvx}
+ {/closepath cvx}
+ pathforall ] def
+ currentpoint newpath moveto
+ } {
+ 8 {pop} repeat
+ } ifelse
+ 0 pdfTextRise neg pdfTextMat dtransform rmoveto
+} def
+/TJm { pdfFontSize 0.001 mul mul neg 0
+ pdfTextMat dtransform rmoveto } def
+/TJmV { pdfFontSize 0.001 mul mul neg 0 exch
+ pdfTextMat dtransform rmoveto } def
+/Tclip { pdfTextClipPath cvx exec clip newpath
+ /pdfTextClipPath [] def } def
+% Level 2 image operators
+/pdfImBuf 100 string def
+/pdfIm {
+ image
+ { currentfile pdfImBuf readline
+ not { pop exit } if
+ (%-EOD-) eq { exit } if } loop
+} def
+/pdfImSep {
+ findcmykcustomcolor exch
+ dup /Width get /pdfImBuf1 exch string def
+ dup /Decode get aload pop 1 index sub /pdfImDecodeRange exch def
+ /pdfImDecodeLow exch def
+ begin Width Height BitsPerComponent ImageMatrix DataSource end
+ /pdfImData exch def
+ { pdfImData pdfImBuf1 readstring pop
+ 0 1 2 index length 1 sub {
+ 1 index exch 2 copy get
+ pdfImDecodeRange mul 255 div pdfImDecodeLow add round cvi
+ 255 exch sub put
+ } for }
+ 6 5 roll customcolorimage
+ { currentfile pdfImBuf readline
+ not { pop exit } if
+ (%-EOD-) eq { exit } if } loop
+} def
+/pdfImM {
+ fCol imagemask
+ { currentfile pdfImBuf readline
+ not { pop exit } if
+ (%-EOD-) eq { exit } if } loop
+} def
+end
+xpdf begin
+/F2_0 /Helvetica 1 1
+[ /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
+ /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
+ /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
+ /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
+ /space/exclam/quotedbl/numbersign/dollar/percent/ampersand/quotesingle
+ /parenleft/parenright/asterisk/plus/comma/hyphen/period/slash
+ /zero/one/two/three/four/five/six/seven
+ /eight/nine/colon/semicolon/less/equal/greater/question
+ /at/A/B/C/D/E/F/G
+ /H/I/J/K/L/M/N/O
+ /P/Q/R/S/T/U/V/W
+ /X/Y/Z/bracketleft/backslash/bracketright/asciicircum/underscore
+ /grave/a/b/c/d/e/f/g
+ /h/i/j/k/l/m/n/o
+ /p/q/r/s/t/u/v/w
+ /x/y/z/braceleft/bar/braceright/asciitilde/bullet
+ /Euro/bullet/quotesinglbase/florin/quotedblbase/ellipsis/dagger/daggerdbl
+ /circumflex/perthousand/Scaron/guilsinglleft/OE/bullet/Zcaron/bullet
+ /bullet/quoteleft/quoteright/quotedblleft/quotedblright/bullet/endash/emdash
+ /tilde/trademark/scaron/guilsinglright/oe/bullet/zcaron/Ydieresis
+ /space/exclamdown/cent/sterling/currency/yen/brokenbar/section
+ /dieresis/copyright/ordfeminine/guillemotleft/logicalnot/hyphen/registered/macron
+ /degree/plusminus/twosuperior/threesuperior/acute/mu/paragraph/periodcentered
+ /cedilla/onesuperior/ordmasculine/guillemotright/onequarter/onehalf/threequarters/questiondown
+ /Agrave/Aacute/Acircumflex/Atilde/Adieresis/Aring/AE/Ccedilla
+ /Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute/Icircumflex/Idieresis
+ /Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis/multiply
+ /Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls
+ /agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla
+ /egrave/eacute/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis
+ /eth/ntilde/ograve/oacute/ocircumflex/otilde/odieresis/divide
+ /oslash/ugrave/uacute/ucircumflex/udieresis/yacute/thorn/ydieresis]
+pdfMakeFont
+612 792 false pdfSetup
+pdfStartPage
+26.1663 -1.02141e-14 translate
+0.9406 0.9406 scale
+[] 0 d
+1 i
+0 j
+0 J
+10 M
+1 w
+0 g
+0 G
+q
+[1 0 0 1 0 0] cm
+[1 0 0 1 0 0] Tm
+0 0 Td
+0 g
+328.715 366.945 10.4374 0.2006 re
+f*
+0 g
+324.902 367.146 18.0648 0.2005 re
+f*
+0 g
+322.292 367.346 23.2834 0.2006 re
+f*
+0 g
+320.285 367.547 27.2978 0.2005 re
+f*
+0 g
+318.278 367.747 31.3122 0.2006 re
+f*
+0 g
+316.672 367.948 34.323 0.2006 re
+f*
+0 g
+315.267 368.148 37.3338 0.2005 re
+f*
+0 g
+313.862 368.349 39.9433 0.2005 re
+f*
+0 g
+312.658 368.549 42.5525 0.2006 re
+f*
+0 g
+311.453 368.75 44.9612 0.2006 re
+f*
+0 g
+310.249 368.951 47.1691 0.2006 re
+f*
+0 g
+309.245 369.151 49.377 0.2005 re
+f*
+0 g
+308.242 369.352 50.5813 0.2005 re
+f*
+0 g
+307.238 369.552 49.377 0.2006 re
+f*
+0 g
+306.435 369.753 47.9719 0.2006 re
+f*
+0 g
+305.432 369.953 47.3698 0.2006 re
+f*
+0 g
+304.629 370.154 46.5669 0.2005 re
+f*
+0 g
+303.826 370.355 46.1654 0.2006 re
+f*
+0 g
+303.023 370.555 45.7641 0.2005 re
+f*
+1 g
+348.787 370.555 13.8496 0.2005 re
+f*
+0.498 0 0.482 rg
+362.637 370.555 2.2079 0.2005 re
+f*
+0 g
+302.22 370.756 45.3626 0.2006 re
+f*
+1 g
+347.583 370.756 13.8497 0.2006 re
+f*
+0.498 0 0.482 rg
+361.433 370.756 4.2151 0.2006 re
+f*
+0 g
+301.417 370.956 45.1618 0.2005 re
+f*
+1 g
+346.579 370.956 13.6489 0.2005 re
+f*
+0.498 0 0.482 rg
+360.228 370.956 6.2224 0.2005 re
+f*
+0 g
+300.615 371.157 45.1619 0.2006 re
+f*
+1 g
+345.776 371.157 13.4481 0.2006 re
+f*
+0.498 0 0.482 rg
+359.225 371.157 7.8281 0.2006 re
+f*
+0 g
+300.012 371.357 44.7605 0.2005 re
+f*
+1 g
+344.773 371.357 13.4481 0.2005 re
+f*
+0.498 0 0.482 rg
+358.221 371.357 9.6346 0.2005 re
+f*
+0 g
+299.209 371.558 44.7604 0.2006 re
+f*
+1 g
+343.97 371.558 13.2475 0.2006 re
+f*
+0.498 0 0.482 rg
+357.217 371.558 11.2403 0.2006 re
+f*
+0 g
+298.607 371.758 44.5597 0.2006 re
+f*
+1 g
+343.167 371.758 13.0467 0.2006 re
+f*
+0.498 0 0.482 rg
+356.214 371.758 13.0468 0.2006 re
+f*
+0 g
+298.005 371.959 44.5597 0.2005 re
+f*
+1 g
+342.565 371.959 12.8461 0.2005 re
+f*
+0.498 0 0.482 rg
+355.411 371.959 14.4518 0.2005 re
+f*
+0 g
+297.202 372.16 44.5597 0.2005 re
+f*
+1 g
+341.762 372.16 12.846 0.2005 re
+f*
+0.498 0 0.482 rg
+354.608 372.16 16.0576 0.2005 re
+f*
+0 g
+296.6 372.36 44.5597 0.2006 re
+f*
+1 g
+341.16 372.36 12.6454 0.2006 re
+f*
+0.498 0 0.482 rg
+353.805 372.36 17.4625 0.2006 re
+f*
+0 g
+295.998 372.561 44.359 0.2006 re
+f*
+1 g
+340.357 372.561 12.6453 0.2006 re
+f*
+0.498 0 0.482 rg
+353.002 372.561 18.8677 0.2006 re
+f*
+0 g
+295.396 372.761 44.359 0.2006 re
+f*
+1 g
+339.755 372.761 12.4446 0.2006 re
+f*
+0.498 0 0.482 rg
+352.2 372.761 20.2726 0.2006 re
+f*
+0 g
+294.794 372.962 44.359 0.2006 re
+f*
+1 g
+339.153 372.962 12.2439 0.2006 re
+f*
+0.498 0 0.482 rg
+351.397 372.962 21.6777 0.2006 re
+f*
+0 g
+294.192 373.162 44.359 0.2005 re
+f*
+1 g
+338.551 373.162 12.2439 0.2005 re
+f*
+0.498 0 0.482 rg
+350.794 373.162 22.882 0.2005 re
+f*
+0 g
+293.589 373.363 44.5597 0.2005 re
+f*
+1 g
+338.149 373.363 11.8424 0.2005 re
+f*
+0.498 0 0.482 rg
+349.991 373.363 24.2871 0.2005 re
+f*
+0 g
+292.987 373.563 44.5598 0.2006 re
+f*
+1 g
+337.547 373.563 11.8424 0.2006 re
+f*
+0.498 0 0.482 rg
+349.389 373.563 25.4914 0.2006 re
+f*
+0 g
+292.385 373.764 44.5597 0.2006 re
+f*
+1 g
+336.945 373.764 11.8425 0.2006 re
+f*
+0.498 0 0.482 rg
+348.787 373.764 26.6956 0.2006 re
+f*
+0 g
+291.783 373.965 44.7605 0.2005 re
+f*
+1 g
+336.543 373.965 11.6417 0.2005 re
+f*
+0.498 0 0.482 rg
+348.185 373.965 27.6993 0.2005 re
+f*
+0 g
+291.381 374.165 44.5597 0.2005 re
+f*
+1 g
+335.941 374.165 11.6417 0.2005 re
+f*
+0.498 0 0.482 rg
+347.583 374.165 28.9036 0.2005 re
+f*
+0 g
+290.779 374.366 44.7605 0.2006 re
+f*
+1 g
+335.54 374.366 11.4409 0.2006 re
+f*
+0.498 0 0.482 rg
+346.981 374.366 30.108 0.2006 re
+f*
+0 g
+290.378 374.566 44.5597 0.2006 re
+f*
+1 g
+334.938 374.566 11.441 0.2006 re
+f*
+0.498 0 0.482 rg
+346.379 374.566 31.1115 0.2006 re
+f*
+0 g
+289.776 374.767 44.7605 0.2005 re
+f*
+1 g
+334.536 374.767 11.4409 0.2005 re
+f*
+0.498 0 0.482 rg
+345.977 374.767 32.1152 0.2005 re
+f*
+0 g
+289.174 374.967 44.9611 0.2006 re
+f*
+1 g
+334.135 374.967 11.2403 0.2006 re
+f*
+0.498 0 0.482 rg
+345.375 374.967 33.1187 0.2006 re
+f*
+0 g
+288.772 375.168 44.9612 0.2005 re
+f*
+1 g
+333.733 375.168 11.0396 0.2005 re
+f*
+0.498 0 0.482 rg
+344.773 375.168 34.323 0.2005 re
+f*
+0 g
+288.371 375.368 44.9611 0.2006 re
+f*
+1 g
+333.332 375.368 11.0396 0.2006 re
+f*
+0.498 0 0.482 rg
+344.371 375.368 35.1259 0.2006 re
+f*
+0 g
+287.768 375.569 45.1619 0.2006 re
+f*
+1 g
+332.93 375.569 10.8389 0.2006 re
+f*
+0.498 0 0.482 rg
+343.769 375.569 36.3302 0.2006 re
+f*
+0 g
+287.367 375.77 45.1619 0.2006 re
+f*
+1 g
+332.529 375.77 10.8388 0.2006 re
+f*
+0.498 0 0.482 rg
+343.368 375.77 37.1331 0.2006 re
+f*
+0 g
+286.765 375.97 45.3626 0.2005 re
+f*
+1 g
+332.127 375.97 10.6382 0.2005 re
+f*
+0.498 0 0.482 rg
+342.766 375.97 38.1367 0.2005 re
+f*
+0 g
+286.363 376.171 45.3626 0.2005 re
+f*
+1 g
+331.726 376.171 10.6381 0.2005 re
+f*
+0.498 0 0.482 rg
+342.364 376.171 39.1403 0.2005 re
+f*
+0 g
+285.962 376.371 45.3625 0.2006 re
+f*
+1 g
+331.325 376.371 10.4375 0.2006 re
+f*
+0.498 0 0.482 rg
+341.762 376.371 40.1439 0.2006 re
+f*
+0 g
+285.561 376.572 45.3626 0.2006 re
+f*
+1 g
+330.923 376.572 10.4374 0.2006 re
+f*
+0.498 0 0.482 rg
+341.361 376.572 40.9468 0.2006 re
+f*
+0 g
+284.958 376.772 45.5633 0.2005 re
+f*
+1 g
+330.522 376.772 10.4374 0.2005 re
+f*
+0.498 0 0.482 rg
+340.959 376.772 41.7496 0.2005 re
+f*
+0 g
+284.557 376.973 45.7639 0.2006 re
+f*
+1 g
+330.321 376.973 10.2368 0.2006 re
+f*
+0.498 0 0.482 rg
+340.558 376.973 42.7532 0.2006 re
+f*
+0 g
+284.156 377.173 45.764 0.2005 re
+f*
+1 g
+329.92 377.173 10.2367 0.2005 re
+f*
+0.498 0 0.482 rg
+340.156 377.173 43.5561 0.2005 re
+f*
+0 g
+283.754 377.374 45.7641 0.2006 re
+f*
+1 g
+329.518 377.374 10.2367 0.2006 re
+f*
+0.498 0 0.482 rg
+339.755 377.374 44.3589 0.2006 re
+f*
+0 g
+283.353 377.575 45.9648 0.2006 re
+f*
+1 g
+329.317 377.575 10.0359 0.2006 re
+f*
+0.498 0 0.482 rg
+339.353 377.575 45.1619 0.2006 re
+f*
+0 g
+282.951 377.775 45.9647 0.2005 re
+f*
+1 g
+328.916 377.775 10.036 0.2005 re
+f*
+0.498 0 0.482 rg
+338.952 377.775 45.9647 0.2005 re
+f*
+0 g
+282.55 377.976 45.9647 0.2006 re
+f*
+1 g
+328.515 377.976 10.036 0.2006 re
+f*
+0.498 0 0.482 rg
+338.551 377.976 46.7676 0.2006 re
+f*
+0 g
+282.148 378.176 46.1655 0.2005 re
+f*
+1 g
+328.314 378.176 9.8352 0.2005 re
+f*
+0.498 0 0.482 rg
+338.149 378.176 47.5705 0.2005 re
+f*
+0 g
+281.747 378.377 46.1655 0.2006 re
+f*
+1 g
+327.912 378.377 9.8353 0.2006 re
+f*
+0.498 0 0.482 rg
+337.748 378.377 48.3733 0.2006 re
+f*
+0 g
+281.346 378.577 46.3662 0.2006 re
+f*
+1 g
+327.712 378.577 9.6346 0.2006 re
+f*
+0.498 0 0.482 rg
+337.346 378.577 49.1762 0.2006 re
+f*
+0 g
+280.944 378.778 46.3662 0.2005 re
+f*
+1 g
+327.31 378.778 9.6345 0.2005 re
+f*
+0.498 0 0.482 rg
+336.945 378.778 49.9792 0.2005 re
+f*
+0 g
+280.543 378.978 46.5668 0.2006 re
+f*
+1 g
+327.11 378.978 9.4339 0.2006 re
+f*
+0.498 0 0.482 rg
+336.543 378.978 50.7819 0.2006 re
+f*
+0 g
+280.141 379.179 46.7676 0.2005 re
+f*
+1 g
+326.909 379.179 9.4339 0.2005 re
+f*
+0.498 0 0.482 rg
+336.343 379.179 51.3841 0.2005 re
+f*
+0 g
+279.74 379.38 46.7677 0.2006 re
+f*
+1 g
+326.507 379.38 9.4338 0.2006 re
+f*
+0.498 0 0.482 rg
+335.941 379.38 52.187 0.2006 re
+f*
+0 g
+279.338 379.58 46.9684 0.2006 re
+f*
+1 g
+326.307 379.58 9.2331 0.2006 re
+f*
+0.498 0 0.482 rg
+335.54 379.58 52.9899 0.2006 re
+f*
+0 g
+278.937 379.781 46.9683 0.2005 re
+f*
+1 g
+325.905 379.781 9.2331 0.2005 re
+f*
+0.498 0 0.482 rg
+335.138 379.781 53.5921 0.2005 re
+f*
+0 g
+278.736 379.981 46.9684 0.2006 re
+f*
+1 g
+325.704 379.981 9.2331 0.2006 re
+f*
+0.498 0 0.482 rg
+334.938 379.981 54.1942 0.2006 re
+f*
+0 g
+278.335 380.182 47.1691 0.2005 re
+f*
+1 g
+325.504 380.182 9.0324 0.2005 re
+f*
+0.498 0 0.482 rg
+334.536 380.182 54.9971 0.2005 re
+f*
+0 g
+277.933 380.382 47.3698 0.2006 re
+f*
+1 g
+325.303 380.382 9.0323 0.2006 re
+f*
+0.498 0 0.482 rg
+334.335 380.382 55.5994 0.2006 re
+f*
+0 g
+277.532 380.583 47.3697 0.2005 re
+f*
+1 g
+324.902 380.583 9.0324 0.2005 re
+f*
+0.498 0 0.482 rg
+333.934 380.583 56.4022 0.2005 re
+f*
+0 g
+277.331 380.783 47.3698 0.2006 re
+f*
+1 g
+324.701 380.783 9.0324 0.2006 re
+f*
+0.498 0 0.482 rg
+333.733 380.783 56.8036 0.2006 re
+f*
+0 g
+287.367 380.984 37.1331 0.2006 re
+f*
+1 g
+324.5 380.984 8.8316 0.2006 re
+f*
+0.498 0 0.482 rg
+333.332 380.984 57.6066 0.2006 re
+f*
+0 g
+287.367 381.185 36.9324 0.2005 re
+f*
+1 g
+324.299 381.185 8.8316 0.2005 re
+f*
+0.498 0 0.482 rg
+333.131 381.185 58.2087 0.2005 re
+f*
+0 g
+287.367 381.385 36.5309 0.2006 re
+f*
+1 g
+323.898 381.385 8.8317 0.2006 re
+f*
+0.498 0 0.482 rg
+332.73 381.385 58.8108 0.2006 re
+f*
+0 g
+287.367 381.586 36.3302 0.2005 re
+f*
+1 g
+323.697 381.586 8.8317 0.2005 re
+f*
+0.498 0 0.482 rg
+332.529 381.586 59.413 0.2005 re
+f*
+0 g
+287.367 381.786 36.1295 0.2006 re
+f*
+1 g
+323.497 381.786 8.6309 0.2006 re
+f*
+0.498 0 0.482 rg
+332.127 381.786 60.2159 0.2006 re
+f*
+0 g
+287.367 381.987 35.9288 0.2006 re
+f*
+1 g
+323.296 381.987 8.6309 0.2006 re
+f*
+0.498 0 0.482 rg
+331.927 381.987 60.6173 0.2006 re
+f*
+0 g
+278.937 382.188 0.2007 0.2005 re
+f*
+1 g
+279.138 382.188 8.2295 0.2005 re
+f*
+0 g
+287.367 382.188 35.7281 0.2005 re
+f*
+1 g
+323.095 382.188 8.4302 0.2005 re
+f*
+0.498 0 0.482 rg
+331.525 382.188 61.4201 0.2005 re
+f*
+0 g
+278.937 382.388 43.9575 0.2006 re
+f*
+1 g
+322.894 382.388 8.4302 0.2006 re
+f*
+0.498 0 0.482 rg
+331.325 382.388 61.8216 0.2006 re
+f*
+0 g
+278.937 382.589 43.7569 0.2005 re
+f*
+1 g
+322.694 382.589 8.4301 0.2005 re
+f*
+0.498 0 0.482 rg
+331.124 382.589 62.4238 0.2005 re
+f*
+0 g
+278.937 382.789 43.5561 0.2006 re
+f*
+1 g
+322.493 382.789 8.2295 0.2006 re
+f*
+0.498 0 0.482 rg
+330.722 382.789 63.2266 0.2006 re
+f*
+0 g
+278.937 382.99 43.3554 0.2006 re
+f*
+1 g
+322.292 382.99 8.2295 0.2006 re
+f*
+0.498 0 0.482 rg
+330.522 382.99 63.628 0.2006 re
+f*
+0 g
+278.937 383.19 43.1547 0.2005 re
+f*
+1 g
+322.092 383.19 8.2294 0.2005 re
+f*
+0.498 0 0.482 rg
+330.321 383.19 64.2303 0.2005 re
+f*
+0 g
+278.937 383.391 42.9539 0.2006 re
+f*
+1 g
+321.891 383.391 8.2295 0.2006 re
+f*
+0.498 0 0.482 rg
+330.12 383.391 64.6317 0.2006 re
+f*
+0 g
+278.937 383.591 42.7533 0.2005 re
+f*
+1 g
+321.69 383.591 8.0287 0.2005 re
+f*
+0.498 0 0.482 rg
+329.719 383.591 65.4345 0.2005 re
+f*
+0 g
+278.937 383.792 42.5525 0.2006 re
+f*
+1 g
+321.489 383.792 8.0288 0.2006 re
+f*
+0.498 0 0.482 rg
+329.518 383.792 65.8359 0.2006 re
+f*
+0 g
+278.937 383.992 42.3518 0.2006 re
+f*
+1 g
+321.289 383.992 8.0288 0.2006 re
+f*
+0.498 0 0.482 rg
+329.317 383.992 66.4381 0.2006 re
+f*
+0 g
+278.937 384.193 42.1511 0.2005 re
+f*
+1 g
+321.088 384.193 8.0287 0.2005 re
+f*
+0.498 0 0.482 rg
+329.117 384.193 66.8396 0.2005 re
+f*
+0 g
+278.937 384.394 41.9503 0.2005 re
+f*
+1 g
+320.887 384.394 8.0288 0.2005 re
+f*
+0.498 0 0.482 rg
+328.916 384.394 67.241 0.2005 re
+f*
+0 g
+278.937 384.594 41.7497 0.2006 re
+f*
+1 g
+320.687 384.594 7.828 0.2006 re
+f*
+0.498 0 0.482 rg
+328.515 384.594 68.0439 0.2006 re
+f*
+0 g
+271.109 384.795 0.2008 0.2006 re
+f*
+1 g
+271.31 384.795 7.6273 0.2006 re
+f*
+0 g
+278.937 384.795 41.5489 0.2006 re
+f*
+1 g
+320.486 384.795 7.8281 0.2006 re
+f*
+0.498 0 0.482 rg
+328.314 384.795 68.4453 0.2006 re
+f*
+0 g
+270.707 384.995 0.6022 0.2006 re
+f*
+1 g
+271.31 384.995 7.6273 0.2006 re
+f*
+0 g
+278.937 384.995 41.3482 0.2006 re
+f*
+1 g
+320.285 384.995 7.828 0.2006 re
+f*
+0.498 0 0.482 rg
+328.113 384.995 69.0475 0.2006 re
+f*
+0 g
+270.507 385.196 0.8029 0.2005 re
+f*
+1 g
+271.31 385.196 7.6273 0.2005 re
+f*
+0 g
+278.937 385.196 41.1475 0.2005 re
+f*
+1 g
+320.084 385.196 7.828 0.2005 re
+f*
+0.498 0 0.482 rg
+327.912 385.196 69.4489 0.2005 re
+f*
+0 g
+270.306 385.396 1.0036 0.2006 re
+f*
+1 g
+271.31 385.396 7.6273 0.2006 re
+f*
+0 g
+278.937 385.396 40.9467 0.2006 re
+f*
+1 g
+319.884 385.396 7.8281 0.2006 re
+f*
+0.498 0 0.482 rg
+327.712 385.396 69.8504 0.2006 re
+f*
+0 g
+269.904 385.597 1.4051 0.2005 re
+f*
+1 g
+271.31 385.597 7.6273 0.2005 re
+f*
+0 g
+278.937 385.597 40.7461 0.2005 re
+f*
+1 g
+319.683 385.597 7.828 0.2005 re
+f*
+0.498 0 0.482 rg
+327.511 385.597 70.4525 0.2005 re
+f*
+0 g
+269.704 385.797 1.6058 0.2006 re
+f*
+1 g
+271.31 385.797 7.6273 0.2006 re
+f*
+0 g
+278.937 385.797 40.7461 0.2006 re
+f*
+1 g
+319.683 385.797 7.6273 0.2006 re
+f*
+0.498 0 0.482 rg
+327.31 385.797 70.8539 0.2006 re
+f*
+0 g
+269.503 385.998 1.8065 0.2005 re
+f*
+1 g
+271.31 385.998 7.6273 0.2005 re
+f*
+0 g
+278.937 385.998 40.5453 0.2005 re
+f*
+1 g
+319.482 385.998 7.6273 0.2005 re
+f*
+0.498 0 0.482 rg
+327.11 385.998 71.2554 0.2005 re
+f*
+0 g
+269.102 386.199 2.208 0.2006 re
+f*
+1 g
+271.31 386.199 7.6273 0.2006 re
+f*
+0 g
+278.937 386.199 40.3446 0.2006 re
+f*
+1 g
+319.281 386.199 7.6273 0.2006 re
+f*
+0.498 0 0.482 rg
+326.909 386.199 71.8576 0.2006 re
+f*
+0 g
+268.901 386.399 2.4087 0.2005 re
+f*
+1 g
+271.31 386.399 7.6273 0.2005 re
+f*
+0 g
+278.937 386.399 40.1438 0.2005 re
+f*
+1 g
+319.081 386.399 7.6274 0.2005 re
+f*
+0.498 0 0.482 rg
+326.708 386.399 72.259 0.2005 re
+f*
+0 g
+268.7 386.6 2.6094 0.2006 re
+f*
+1 g
+271.31 386.6 7.6273 0.2006 re
+f*
+0 g
+278.937 386.6 39.9431 0.2006 re
+f*
+1 g
+318.88 386.6 7.6274 0.2006 re
+f*
+0.498 0 0.482 rg
+326.507 386.6 72.6604 0.2006 re
+f*
+0 g
+268.299 386.8 3.0108 0.2006 re
+f*
+1 g
+271.31 386.8 7.6273 0.2006 re
+f*
+0 g
+278.937 386.8 39.9431 0.2006 re
+f*
+1 g
+318.88 386.8 7.4267 0.2006 re
+f*
+0.498 0 0.482 rg
+326.307 386.8 73.0618 0.2006 re
+f*
+0 g
+268.098 387.001 3.2115 0.2005 re
+f*
+1 g
+271.31 387.001 7.6273 0.2005 re
+f*
+0 g
+278.937 387.001 39.7425 0.2005 re
+f*
+1 g
+318.679 387.001 7.4265 0.2005 re
+f*
+0.498 0 0.482 rg
+326.106 387.001 73.6641 0.2005 re
+f*
+0 g
+267.897 387.201 3.4123 0.2005 re
+f*
+1 g
+271.31 387.201 7.6273 0.2005 re
+f*
+0 g
+278.937 387.201 39.5417 0.2005 re
+f*
+1 g
+318.479 387.201 7.4266 0.2005 re
+f*
+0.498 0 0.482 rg
+325.905 387.201 74.0655 0.2005 re
+f*
+0 g
+267.697 387.402 3.613 0.2006 re
+f*
+1 g
+271.31 387.402 7.6273 0.2006 re
+f*
+0 g
+278.937 387.402 39.341 0.2006 re
+f*
+1 g
+318.278 387.402 7.4266 0.2006 re
+f*
+0.498 0 0.482 rg
+325.704 387.402 74.4669 0.2006 re
+f*
+0 g
+267.295 387.603 4.0144 0.2006 re
+f*
+1 g
+271.31 387.603 7.6273 0.2006 re
+f*
+0 g
+278.937 387.603 39.341 0.2006 re
+f*
+1 g
+318.278 387.603 7.2259 0.2006 re
+f*
+0.498 0 0.482 rg
+325.504 387.603 74.8683 0.2006 re
+f*
+0 g
+267.094 387.803 4.2151 0.2006 re
+f*
+1 g
+271.31 387.803 7.6273 0.2006 re
+f*
+0 g
+278.937 387.803 39.1402 0.2006 re
+f*
+1 g
+318.077 387.803 7.226 0.2006 re
+f*
+0.498 0 0.482 rg
+325.303 387.803 75.4705 0.2006 re
+f*
+0 g
+266.894 388.004 4.4159 0.2006 re
+f*
+1 g
+271.31 388.004 7.6273 0.2006 re
+f*
+0 g
+278.937 388.004 38.9395 0.2006 re
+f*
+1 g
+317.876 388.004 7.226 0.2006 re
+f*
+0.498 0 0.482 rg
+325.102 388.004 75.8719 0.2006 re
+f*
+0 g
+266.693 388.204 4.6166 0.2005 re
+f*
+1 g
+271.31 388.204 7.6273 0.2005 re
+f*
+0 g
+278.937 388.204 38.7389 0.2005 re
+f*
+1 g
+317.676 388.204 7.2258 0.2005 re
+f*
+0.498 0 0.482 rg
+324.902 388.204 76.2734 0.2005 re
+f*
+0 g
+266.492 388.405 4.8173 0.2005 re
+f*
+1 g
+271.31 388.405 7.6273 0.2005 re
+f*
+0 g
+278.937 388.405 38.7389 0.2005 re
+f*
+1 g
+317.676 388.405 7.0251 0.2005 re
+f*
+0.498 0 0.482 rg
+324.701 388.405 76.6748 0.2005 re
+f*
+0 g
+266.292 388.605 5.018 0.2006 re
+f*
+1 g
+271.31 388.605 7.6273 0.2006 re
+f*
+0 g
+278.937 388.605 38.5381 0.2006 re
+f*
+1 g
+317.475 388.605 7.0252 0.2006 re
+f*
+0.498 0 0.482 rg
+324.5 388.605 77.0762 0.2006 re
+f*
+0 g
+265.89 388.806 5.4195 0.2006 re
+f*
+1 g
+271.31 388.806 7.6273 0.2006 re
+f*
+0 g
+278.937 388.806 38.3374 0.2006 re
+f*
+1 g
+317.274 388.806 7.0252 0.2006 re
+f*
+0.498 0 0.482 rg
+324.299 388.806 77.4777 0.2006 re
+f*
+0 g
+265.689 389.006 5.6202 0.2005 re
+f*
+1 g
+271.31 389.006 7.6273 0.2005 re
+f*
+0 g
+278.937 389.006 38.3374 0.2005 re
+f*
+1 g
+317.274 389.006 7.0252 0.2005 re
+f*
+0.498 0 0.482 rg
+324.299 389.006 77.8791 0.2005 re
+f*
+0 g
+265.489 389.207 5.8209 0.2005 re
+f*
+1 g
+271.31 389.207 7.6273 0.2005 re
+f*
+0 g
+278.937 389.207 38.1367 0.2005 re
+f*
+1 g
+317.074 389.207 7.0252 0.2005 re
+f*
+0.498 0 0.482 rg
+324.099 389.207 78.2805 0.2005 re
+f*
+0 g
+265.288 389.407 6.0216 0.2006 re
+f*
+1 g
+271.31 389.407 7.6273 0.2006 re
+f*
+0 g
+278.937 389.407 37.9359 0.2006 re
+f*
+1 g
+316.873 389.407 7.0252 0.2006 re
+f*
+0.498 0 0.482 rg
+323.898 389.407 78.682 0.2006 re
+f*
+0 g
+265.087 389.608 6.2224 0.2006 re
+f*
+1 g
+271.31 389.608 7.6273 0.2006 re
+f*
+0 g
+278.937 389.608 37.9359 0.2006 re
+f*
+1 g
+316.873 389.608 6.8245 0.2006 re
+f*
+0.498 0 0.482 rg
+323.697 389.608 79.0835 0.2006 re
+f*
+0 g
+264.886 389.809 6.4231 0.2005 re
+f*
+1 g
+271.31 389.809 7.6273 0.2005 re
+f*
+0 g
+278.937 389.809 37.7352 0.2005 re
+f*
+1 g
+316.672 389.809 6.8245 0.2005 re
+f*
+0.498 0 0.482 rg
+323.497 389.809 79.4849 0.2005 re
+f*
+0 g
+264.686 390.009 6.6238 0.2006 re
+f*
+1 g
+271.31 390.009 7.6273 0.2006 re
+f*
+0 g
+278.937 390.009 37.5345 0.2006 re
+f*
+1 g
+316.471 390.009 7.0252 0.2006 re
+f*
+0.498 0 0.482 rg
+323.497 390.009 79.6856 0.2006 re
+f*
+0 g
+264.485 390.21 6.8245 0.2005 re
+f*
+1 g
+271.31 390.21 7.6273 0.2005 re
+f*
+0 g
+278.937 390.21 37.5345 0.2005 re
+f*
+1 g
+316.471 390.21 6.8245 0.2005 re
+f*
+0.498 0 0.482 rg
+323.296 390.21 80.087 0.2005 re
+f*
+0 g
+264.284 390.41 7.0252 0.2006 re
+f*
+1 g
+271.31 390.41 7.6273 0.2006 re
+f*
+0 g
+278.937 390.41 37.3338 0.2006 re
+f*
+1 g
+316.271 390.41 6.8245 0.2006 re
+f*
+0.498 0 0.482 rg
+323.095 390.41 80.4884 0.2006 re
+f*
+0 g
+264.084 390.611 7.226 0.2006 re
+f*
+1 g
+271.31 390.611 7.6273 0.2006 re
+f*
+0 g
+278.937 390.611 37.1331 0.2006 re
+f*
+1 g
+316.07 390.611 6.8244 0.2006 re
+f*
+0.498 0 0.482 rg
+322.894 390.611 80.89 0.2006 re
+f*
+0 g
+263.883 390.811 7.4267 0.2006 re
+f*
+1 g
+271.31 390.811 7.6273 0.2006 re
+f*
+0 g
+278.937 390.811 37.1331 0.2006 re
+f*
+1 g
+316.07 390.811 6.8244 0.2006 re
+f*
+0.498 0 0.482 rg
+322.894 390.811 81.0907 0.2006 re
+f*
+0 g
+263.682 391.012 7.6274 0.2005 re
+f*
+1 g
+271.31 391.012 7.6273 0.2005 re
+f*
+0 g
+278.937 391.012 36.9323 0.2005 re
+f*
+1 g
+315.869 391.012 6.8246 0.2005 re
+f*
+0.498 0 0.482 rg
+322.694 391.012 81.492 0.2005 re
+f*
+0 g
+263.281 391.213 8.0288 0.2005 re
+f*
+1 g
+271.31 391.213 7.6273 0.2005 re
+f*
+0 g
+278.937 391.213 36.9323 0.2005 re
+f*
+1 g
+315.869 391.213 6.6238 0.2005 re
+f*
+0.498 0 0.482 rg
+322.493 391.213 81.8935 0.2005 re
+f*
+0 g
+263.08 391.413 8.2296 0.2006 re
+f*
+1 g
+271.31 391.413 7.6273 0.2006 re
+f*
+0 g
+278.937 391.413 36.7317 0.2006 re
+f*
+1 g
+315.669 391.413 6.6237 0.2006 re
+f*
+0.498 0 0.482 rg
+322.292 391.413 82.2949 0.2006 re
+f*
+0 g
+262.879 391.614 8.4303 0.2006 re
+f*
+1 g
+271.31 391.614 7.6273 0.2006 re
+f*
+0 g
+278.937 391.614 36.5309 0.2006 re
+f*
+1 g
+315.468 391.614 6.8245 0.2006 re
+f*
+0.498 0 0.482 rg
+322.292 391.614 82.4957 0.2006 re
+f*
+0 g
+262.679 391.814 8.631 0.2005 re
+f*
+1 g
+271.31 391.814 7.6273 0.2005 re
+f*
+0 g
+278.937 391.814 36.5309 0.2005 re
+f*
+1 g
+315.468 391.814 6.6238 0.2005 re
+f*
+0.498 0 0.482 rg
+322.092 391.814 82.8971 0.2005 re
+f*
+0 g
+262.478 392.015 8.8317 0.2006 re
+f*
+1 g
+271.31 392.015 7.6273 0.2006 re
+f*
+0 g
+278.937 392.015 36.3302 0.2006 re
+f*
+1 g
+315.267 392.015 6.6237 0.2006 re
+f*
+0.498 0 0.482 rg
+321.891 392.015 83.2986 0.2006 re
+f*
+0 g
+262.277 392.215 9.0324 0.2005 re
+f*
+1 g
+271.31 392.215 7.6273 0.2005 re
+f*
+0 g
+278.937 392.215 36.3302 0.2005 re
+f*
+1 g
+315.267 392.215 6.6237 0.2005 re
+f*
+0.498 0 0.482 rg
+321.891 392.215 83.4993 0.2005 re
+f*
+0 g
+262.277 392.416 9.0324 0.2006 re
+f*
+1 g
+271.31 392.416 7.6273 0.2006 re
+f*
+0 g
+278.937 392.416 36.1295 0.2006 re
+f*
+1 g
+315.066 392.416 6.6238 0.2006 re
+f*
+0.498 0 0.482 rg
+321.69 392.416 83.9007 0.2006 re
+f*
+0 g
+262.076 392.616 9.2332 0.2006 re
+f*
+1 g
+271.31 392.616 7.6273 0.2006 re
+f*
+0 g
+278.937 392.616 36.1295 0.2006 re
+f*
+1 g
+315.066 392.616 6.423 0.2006 re
+f*
+0.498 0 0.482 rg
+321.489 392.616 84.3022 0.2006 re
+f*
+0 g
+261.876 392.817 9.4339 0.2005 re
+f*
+1 g
+271.31 392.817 7.6273 0.2005 re
+f*
+0 g
+278.937 392.817 35.9287 0.2005 re
+f*
+1 g
+314.866 392.817 6.6238 0.2005 re
+f*
+0.498 0 0.482 rg
+321.489 392.817 84.5029 0.2005 re
+f*
+0 g
+261.675 393.018 9.6346 0.2006 re
+f*
+1 g
+271.31 393.018 7.6273 0.2006 re
+f*
+0 g
+278.937 393.018 35.9287 0.2006 re
+f*
+1 g
+314.866 393.018 6.4231 0.2006 re
+f*
+0.498 0 0.482 rg
+321.289 393.018 84.9043 0.2006 re
+f*
+0 g
+261.474 393.218 9.8353 0.2005 re
+f*
+1 g
+271.31 393.218 7.6273 0.2005 re
+f*
+0 g
+278.937 393.218 35.7281 0.2005 re
+f*
+1 g
+314.665 393.218 6.423 0.2005 re
+f*
+0.498 0 0.482 rg
+321.088 393.218 85.3057 0.2005 re
+f*
+0 g
+261.274 393.419 10.036 0.2006 re
+f*
+1 g
+271.31 393.419 7.6273 0.2006 re
+f*
+0 g
+278.937 393.419 35.7281 0.2006 re
+f*
+1 g
+314.665 393.419 6.423 0.2006 re
+f*
+0.498 0 0.482 rg
+321.088 393.419 85.5064 0.2006 re
+f*
+0 g
+261.073 393.619 10.2368 0.2006 re
+f*
+1 g
+271.31 393.619 7.6273 0.2006 re
+f*
+0 g
+278.937 393.619 35.5273 0.2006 re
+f*
+1 g
+314.464 393.619 6.423 0.2006 re
+f*
+0.498 0 0.482 rg
+320.887 393.619 85.908 0.2006 re
+f*
+0 g
+260.872 393.82 10.4375 0.2005 re
+f*
+1 g
+271.31 393.82 7.6273 0.2005 re
+f*
+0 g
+278.937 393.82 35.5273 0.2005 re
+f*
+1 g
+314.464 393.82 6.423 0.2005 re
+f*
+0.498 0 0.482 rg
+320.887 393.82 86.1087 0.2005 re
+f*
+0 g
+260.671 394.02 10.6382 0.2006 re
+f*
+1 g
+271.31 394.02 7.6273 0.2006 re
+f*
+0 g
+278.937 394.02 35.3266 0.2006 re
+f*
+1 g
+314.263 394.02 6.4231 0.2006 re
+f*
+0.498 0 0.482 rg
+320.687 394.02 86.51 0.2006 re
+f*
+0 g
+260.471 394.221 10.8389 0.2005 re
+f*
+1 g
+271.31 394.221 7.6273 0.2005 re
+f*
+0 g
+278.937 394.221 35.3266 0.2005 re
+f*
+1 g
+314.263 394.221 6.2223 0.2005 re
+f*
+0.498 0 0.482 rg
+320.486 394.221 86.9115 0.2005 re
+f*
+0 g
+260.27 394.421 11.0396 0.2006 re
+f*
+1 g
+271.31 394.421 7.6273 0.2006 re
+f*
+0 g
+278.937 394.421 35.1259 0.2006 re
+f*
+1 g
+314.063 394.421 6.423 0.2006 re
+f*
+0.498 0 0.482 rg
+320.486 394.421 86.9115 0.2006 re
+f*
+0 g
+260.27 394.622 11.0396 0.2006 re
+f*
+1 g
+271.31 394.622 7.6273 0.2006 re
+f*
+0 g
+278.937 394.622 35.1259 0.2006 re
+f*
+1 g
+314.063 394.622 6.2223 0.2006 re
+f*
+0.498 0 0.482 rg
+320.285 394.622 87.3129 0.2006 re
+f*
+0 g
+260.069 394.823 11.2403 0.2005 re
+f*
+1 g
+271.31 394.823 7.6273 0.2005 re
+f*
+0 g
+278.937 394.823 34.9251 0.2005 re
+f*
+1 g
+313.862 394.823 6.4231 0.2005 re
+f*
+0.498 0 0.482 rg
+320.285 394.823 87.5137 0.2005 re
+f*
+0 g
+259.868 395.023 11.4411 0.2006 re
+f*
+1 g
+271.31 395.023 7.6273 0.2006 re
+f*
+0 g
+278.937 395.023 34.9251 0.2006 re
+f*
+1 g
+313.862 395.023 6.2224 0.2006 re
+f*
+0.498 0 0.482 rg
+320.084 395.023 87.9151 0.2006 re
+f*
+0 g
+259.668 395.224 11.6418 0.2005 re
+f*
+1 g
+271.31 395.224 7.6273 0.2005 re
+f*
+0 g
+278.937 395.224 34.7245 0.2005 re
+f*
+1 g
+313.661 395.224 6.423 0.2005 re
+f*
+0.498 0 0.482 rg
+320.084 395.224 88.1158 0.2005 re
+f*
+0 g
+259.467 395.424 11.8425 0.2006 re
+f*
+1 g
+271.31 395.424 7.6273 0.2006 re
+f*
+0 g
+278.937 395.424 34.7245 0.2006 re
+f*
+1 g
+313.661 395.424 6.2222 0.2006 re
+f*
+0.498 0 0.482 rg
+319.884 395.424 88.5173 0.2006 re
+f*
+0 g
+259.266 395.625 12.0432 0.2005 re
+f*
+1 g
+271.31 395.625 7.6273 0.2005 re
+f*
+0 g
+278.937 395.625 34.5237 0.2005 re
+f*
+1 g
+313.461 395.625 6.423 0.2005 re
+f*
+0.498 0 0.482 rg
+319.884 395.625 88.5173 0.2005 re
+f*
+0 g
+259.266 395.825 12.0432 0.2006 re
+f*
+1 g
+271.31 395.825 7.6273 0.2006 re
+f*
+0 g
+278.937 395.825 34.5237 0.2006 re
+f*
+1 g
+313.461 395.825 6.2224 0.2006 re
+f*
+0.498 0 0.482 rg
+319.683 395.825 88.9186 0.2006 re
+f*
+0 g
+259.066 396.026 12.2439 0.2006 re
+f*
+1 g
+271.31 396.026 7.6273 0.2006 re
+f*
+0 g
+278.937 396.026 34.5237 0.2006 re
+f*
+1 g
+313.461 396.026 6.2224 0.2006 re
+f*
+0.498 0 0.482 rg
+319.683 396.026 89.1194 0.2006 re
+f*
+0 g
+258.865 396.227 12.4447 0.2005 re
+f*
+1 g
+271.31 396.227 7.6273 0.2005 re
+f*
+0 g
+278.937 396.227 34.323 0.2005 re
+f*
+1 g
+313.26 396.227 6.2223 0.2005 re
+f*
+0.498 0 0.482 rg
+319.482 396.227 89.5209 0.2005 re
+f*
+0 g
+258.664 396.427 12.6454 0.2006 re
+f*
+1 g
+271.31 396.427 7.6273 0.2006 re
+f*
+0 g
+278.937 396.427 34.323 0.2006 re
+f*
+1 g
+313.26 396.427 6.2223 0.2006 re
+f*
+0.498 0 0.482 rg
+319.482 396.427 89.7216 0.2006 re
+f*
+0 g
+258.463 396.628 12.8461 0.2005 re
+f*
+1 g
+271.31 396.628 7.6273 0.2005 re
+f*
+0 g
+278.937 396.628 34.1223 0.2005 re
+f*
+1 g
+313.059 396.628 6.2223 0.2005 re
+f*
+0.498 0 0.482 rg
+319.281 396.628 89.9223 0.2005 re
+f*
+0 g
+258.463 396.828 12.8461 0.2006 re
+f*
+1 g
+271.31 396.828 7.6273 0.2006 re
+f*
+0 g
+278.937 396.828 34.1223 0.2006 re
+f*
+1 g
+313.059 396.828 6.2223 0.2006 re
+f*
+0.498 0 0.482 rg
+319.281 396.828 90.123 0.2006 re
+f*
+0 g
+258.263 397.029 13.0468 0.2006 re
+f*
+1 g
+271.31 397.029 7.6273 0.2006 re
+f*
+0 g
+278.937 397.029 34.1223 0.2006 re
+f*
+1 g
+313.059 397.029 6.0215 0.2006 re
+f*
+0.498 0 0.482 rg
+319.081 397.029 90.5245 0.2006 re
+f*
+0 g
+258.062 397.229 13.2475 0.2005 re
+f*
+1 g
+271.31 397.229 7.6273 0.2005 re
+f*
+0 g
+278.937 397.229 33.9216 0.2005 re
+f*
+1 g
+312.858 397.229 6.2222 0.2005 re
+f*
+0.498 0 0.482 rg
+319.081 397.229 90.7253 0.2005 re
+f*
+0 g
+258.062 397.43 13.2475 0.2006 re
+f*
+1 g
+271.31 397.43 7.6273 0.2006 re
+f*
+0 g
+278.937 397.43 33.9216 0.2006 re
+f*
+1 g
+312.858 397.43 6.0215 0.2006 re
+f*
+0.498 0 0.482 rg
+318.88 397.43 90.926 0.2006 re
+f*
+0 g
+257.861 397.63 13.4483 0.2005 re
+f*
+1 g
+271.31 397.63 7.6273 0.2005 re
+f*
+0 g
+278.937 397.63 33.7209 0.2005 re
+f*
+1 g
+312.658 397.63 6.2222 0.2005 re
+f*
+0.498 0 0.482 rg
+318.88 397.63 91.1267 0.2005 re
+f*
+0 g
+257.661 397.831 13.649 0.2006 re
+f*
+1 g
+271.31 397.831 7.6273 0.2006 re
+f*
+0 g
+278.937 397.831 33.7209 0.2006 re
+f*
+1 g
+312.658 397.831 6.2222 0.2006 re
+f*
+0.498 0 0.482 rg
+318.88 397.831 91.3274 0.2006 re
+f*
+0 g
+257.46 398.032 13.8497 0.2006 re
+f*
+1 g
+271.31 398.032 7.6273 0.2006 re
+f*
+0 g
+278.937 398.032 33.7209 0.2006 re
+f*
+1 g
+312.658 398.032 6.0216 0.2006 re
+f*
+0.498 0 0.482 rg
+318.679 398.032 91.7287 0.2006 re
+f*
+0 g
+257.46 398.232 13.8497 0.2005 re
+f*
+1 g
+271.31 398.232 7.6273 0.2005 re
+f*
+0 g
+278.937 398.232 33.5201 0.2005 re
+f*
+1 g
+312.457 398.232 6.2224 0.2005 re
+f*
+0.498 0 0.482 rg
+318.679 398.232 91.7287 0.2005 re
+f*
+0 g
+257.259 398.433 14.0504 0.2006 re
+f*
+1 g
+271.31 398.433 7.6273 0.2006 re
+f*
+0 g
+278.937 398.433 33.5201 0.2006 re
+f*
+1 g
+312.457 398.433 6.0216 0.2006 re
+f*
+0.498 0 0.482 rg
+318.479 398.433 92.1302 0.2006 re
+f*
+0 g
+257.058 398.633 14.2511 0.2005 re
+f*
+1 g
+271.31 398.633 7.6273 0.2005 re
+f*
+0 g
+278.937 398.633 33.5201 0.2005 re
+f*
+1 g
+312.457 398.633 6.0216 0.2005 re
+f*
+0.498 0 0.482 rg
+318.479 398.633 92.3309 0.2005 re
+f*
+0 g
+257.058 398.834 14.2511 0.2006 re
+f*
+1 g
+271.31 398.834 7.6273 0.2006 re
+f*
+0 g
+278.937 398.834 33.3194 0.2006 re
+f*
+1 g
+312.256 398.834 6.2223 0.2006 re
+f*
+0.498 0 0.482 rg
+318.479 398.834 92.3309 0.2006 re
+f*
+0 g
+256.858 399.034 14.4519 0.2006 re
+f*
+1 g
+271.31 399.034 7.6273 0.2006 re
+f*
+0 g
+278.937 399.034 33.3194 0.2006 re
+f*
+1 g
+312.256 399.034 6.0216 0.2006 re
+f*
+0.498 0 0.482 rg
+318.278 399.034 92.7324 0.2006 re
+f*
+0 g
+256.657 399.235 14.6526 0.2005 re
+f*
+1 g
+271.31 399.235 7.6273 0.2005 re
+f*
+0 g
+278.937 399.235 33.3194 0.2005 re
+f*
+1 g
+312.256 399.235 6.0216 0.2005 re
+f*
+0.498 0 0.482 rg
+318.278 399.235 92.9331 0.2005 re
+f*
+0 g
+256.657 399.435 14.6526 0.2005 re
+f*
+1 g
+271.31 399.435 7.6273 0.2005 re
+f*
+0 g
+278.937 399.435 33.1187 0.2005 re
+f*
+1 g
+312.056 399.435 6.2223 0.2005 re
+f*
+0.498 0 0.482 rg
+318.278 399.435 92.9331 0.2005 re
+f*
+0 g
+256.456 399.636 14.8533 0.2006 re
+f*
+1 g
+271.31 399.636 7.6273 0.2006 re
+f*
+0 g
+278.937 399.636 33.1187 0.2006 re
+f*
+1 g
+312.056 399.636 6.0215 0.2006 re
+f*
+0.498 0 0.482 rg
+318.077 399.636 93.3346 0.2006 re
+f*
+0 g
+256.256 399.837 15.054 0.2006 re
+f*
+1 g
+271.31 399.837 7.6273 0.2006 re
+f*
+0 g
+278.937 399.837 33.1187 0.2006 re
+f*
+1 g
+312.056 399.837 6.0215 0.2006 re
+f*
+0.498 0 0.482 rg
+318.077 399.837 93.5353 0.2006 re
+f*
+0 g
+256.256 400.037 15.054 0.2006 re
+f*
+1 g
+271.31 400.037 7.6273 0.2006 re
+f*
+0 g
+278.937 400.037 32.918 0.2006 re
+f*
+1 g
+311.855 400.037 6.2222 0.2006 re
+f*
+0.498 0 0.482 rg
+318.077 400.037 93.5353 0.2006 re
+f*
+0 g
+256.055 400.238 15.2547 0.2005 re
+f*
+1 g
+271.31 400.238 7.6273 0.2005 re
+f*
+0 g
+278.937 400.238 32.918 0.2005 re
+f*
+1 g
+311.855 400.238 6.0215 0.2005 re
+f*
+0.498 0 0.482 rg
+317.876 400.238 93.9367 0.2005 re
+f*
+0 g
+255.854 400.438 15.4555 0.2006 re
+f*
+1 g
+271.31 400.438 7.6273 0.2006 re
+f*
+0 g
+278.937 400.438 32.918 0.2006 re
+f*
+1 g
+311.855 400.438 6.0215 0.2006 re
+f*
+0.498 0 0.482 rg
+317.876 400.438 93.9367 0.2006 re
+f*
+0 g
+255.854 400.639 15.4555 0.2005 re
+f*
+1 g
+271.31 400.639 7.6273 0.2005 re
+f*
+0 g
+278.937 400.639 32.7173 0.2005 re
+f*
+1 g
+311.654 400.639 6.2222 0.2005 re
+f*
+0.498 0 0.482 rg
+317.876 400.639 94.1375 0.2005 re
+f*
+0 g
+255.653 400.839 15.6562 0.2006 re
+f*
+1 g
+271.31 400.839 7.6273 0.2006 re
+f*
+0 g
+278.937 400.839 32.7173 0.2006 re
+f*
+1 g
+311.654 400.839 6.0216 0.2006 re
+f*
+0.498 0 0.482 rg
+317.676 400.839 94.5388 0.2006 re
+f*
+0 g
+255.653 401.04 15.6562 0.2006 re
+f*
+1 g
+271.31 401.04 7.6273 0.2006 re
+f*
+0 g
+278.937 401.04 32.7173 0.2006 re
+f*
+1 g
+311.654 401.04 6.0216 0.2006 re
+f*
+0.498 0 0.482 rg
+317.676 401.04 94.5388 0.2006 re
+f*
+0 g
+255.453 401.241 15.8569 0.2005 re
+f*
+1 g
+271.31 401.241 7.6273 0.2005 re
+f*
+0 g
+278.937 401.241 32.5165 0.2005 re
+f*
+1 g
+311.453 401.241 6.2224 0.2005 re
+f*
+0.498 0 0.482 rg
+317.676 401.241 94.7395 0.2005 re
+f*
+0 g
+255.252 401.441 16.0576 0.2005 re
+f*
+1 g
+271.31 401.441 7.6273 0.2005 re
+f*
+0 g
+278.937 401.441 32.5165 0.2005 re
+f*
+1 g
+311.453 401.441 6.2224 0.2005 re
+f*
+0.498 0 0.482 rg
+317.676 401.441 94.9402 0.2005 re
+f*
+0 g
+255.252 401.642 16.0576 0.2006 re
+f*
+1 g
+271.31 401.642 7.6273 0.2006 re
+f*
+0 g
+278.937 401.642 32.5165 0.2006 re
+f*
+1 g
+311.453 401.642 6.0216 0.2006 re
+f*
+0.498 0 0.482 rg
+317.475 401.642 95.141 0.2006 re
+f*
+0 g
+255.051 401.842 16.2583 0.2006 re
+f*
+1 g
+271.31 401.842 7.6273 0.2006 re
+f*
+0 g
+278.937 401.842 32.5165 0.2006 re
+f*
+1 g
+311.453 401.842 6.0216 0.2006 re
+f*
+0.498 0 0.482 rg
+317.475 401.842 95.3417 0.2006 re
+f*
+0 g
+255.051 402.043 16.2583 0.2005 re
+f*
+1 g
+271.31 402.043 7.6273 0.2005 re
+f*
+0 g
+278.937 402.043 32.3158 0.2005 re
+f*
+1 g
+311.253 402.043 6.2223 0.2005 re
+f*
+0.498 0 0.482 rg
+317.475 402.043 95.3417 0.2005 re
+f*
+0 g
+254.851 402.243 16.4591 0.2005 re
+f*
+1 g
+271.31 402.243 7.6273 0.2005 re
+f*
+0 g
+278.937 402.243 32.3158 0.2005 re
+f*
+1 g
+311.253 402.243 6.2223 0.2005 re
+f*
+0.498 0 0.482 rg
+317.475 402.243 95.5425 0.2005 re
+f*
+0 g
+254.851 402.444 16.4591 0.2006 re
+f*
+1 g
+271.31 402.444 7.6273 0.2006 re
+f*
+0 g
+278.937 402.444 32.3158 0.2006 re
+f*
+1 g
+311.253 402.444 6.0216 0.2006 re
+f*
+0.498 0 0.482 rg
+317.274 402.444 95.7432 0.2006 re
+f*
+0 g
+254.65 402.644 16.6598 0.2006 re
+f*
+1 g
+271.31 402.644 7.6273 0.2006 re
+f*
+0 g
+278.937 402.644 32.1151 0.2006 re
+f*
+1 g
+311.052 402.644 6.2223 0.2006 re
+f*
+0.498 0 0.482 rg
+317.274 402.644 95.9438 0.2006 re
+f*
+0 g
+254.449 402.845 16.8605 0.2006 re
+f*
+1 g
+271.31 402.845 7.6273 0.2006 re
+f*
+0 g
+278.937 402.845 32.1151 0.2006 re
+f*
+1 g
+311.052 402.845 6.2223 0.2006 re
+f*
+0.498 0 0.482 rg
+317.274 402.845 95.9438 0.2006 re
+f*
+0 g
+254.449 403.046 16.8605 0.2006 re
+f*
+1 g
+271.31 403.046 7.6273 0.2006 re
+f*
+0 g
+278.937 403.046 32.1151 0.2006 re
+f*
+1 g
+311.052 403.046 6.2223 0.2006 re
+f*
+0.498 0 0.482 rg
+317.274 403.046 96.1446 0.2006 re
+f*
+0 g
+254.248 403.246 17.0612 0.2005 re
+f*
+1 g
+271.31 403.246 7.6273 0.2005 re
+f*
+0 g
+278.937 403.246 32.1151 0.2005 re
+f*
+1 g
+311.052 403.246 6.2223 0.2005 re
+f*
+0.498 0 0.482 rg
+317.274 403.246 96.1446 0.2005 re
+f*
+0 g
+254.248 403.447 17.0612 0.2005 re
+f*
+1 g
+271.31 403.447 7.6273 0.2005 re
+f*
+0 g
+278.937 403.447 31.9144 0.2005 re
+f*
+1 g
+310.851 403.447 6.423 0.2005 re
+f*
+0.498 0 0.482 rg
+317.274 403.447 96.3453 0.2005 re
+f*
+0 g
+254.048 403.647 17.2619 0.2006 re
+f*
+1 g
+271.31 403.647 7.6273 0.2006 re
+f*
+0 g
+278.937 403.647 31.9144 0.2006 re
+f*
+1 g
+310.851 403.647 6.2223 0.2006 re
+f*
+0.498 0 0.482 rg
+317.074 403.647 96.546 0.2006 re
+f*
+0 g
+254.048 403.848 17.2619 0.2006 re
+f*
+1 g
+271.31 403.848 7.6273 0.2006 re
+f*
+0 g
+278.937 403.848 31.9144 0.2006 re
+f*
+1 g
+310.851 403.848 6.2223 0.2006 re
+f*
+0.498 0 0.482 rg
+317.074 403.848 96.7467 0.2006 re
+f*
+0 g
+253.847 404.048 17.4626 0.2005 re
+f*
+1 g
+271.31 404.048 7.6273 0.2005 re
+f*
+0 g
+278.937 404.048 31.9144 0.2005 re
+f*
+1 g
+310.851 404.048 6.2223 0.2005 re
+f*
+0.498 0 0.482 rg
+317.074 404.048 13.6489 0.2005 re
+f*
+1 g
+330.722 404.048 8.4302 0.2005 re
+f*
+0.498 0 0.482 rg
+339.153 404.048 74.6676 0.2005 re
+f*
+0 g
+253.847 404.249 17.4626 0.2005 re
+f*
+1 g
+271.31 404.249 7.6273 0.2005 re
+f*
+0 g
+278.937 404.249 31.7137 0.2005 re
+f*
+1 g
+310.651 404.249 6.423 0.2005 re
+f*
+0.498 0 0.482 rg
+317.074 404.249 12.2439 0.2005 re
+f*
+1 g
+329.317 404.249 11.2403 0.2005 re
+f*
+0.498 0 0.482 rg
+340.558 404.249 73.4633 0.2005 re
+f*
+0 g
+253.646 404.449 17.6633 0.2006 re
+f*
+1 g
+271.31 404.449 7.6273 0.2006 re
+f*
+0 g
+278.937 404.449 31.7137 0.2006 re
+f*
+1 g
+310.651 404.449 6.423 0.2006 re
+f*
+0.498 0 0.482 rg
+317.074 404.449 11.0395 0.2006 re
+f*
+1 g
+328.113 404.449 13.4483 0.2006 re
+f*
+0.498 0 0.482 rg
+341.561 404.449 72.4597 0.2006 re
+f*
+0 g
+253.646 404.65 17.6633 0.2006 re
+f*
+1 g
+271.31 404.65 7.6273 0.2006 re
+f*
+0 g
+278.937 404.65 31.7137 0.2006 re
+f*
+1 g
+310.651 404.65 6.423 0.2006 re
+f*
+0.498 0 0.482 rg
+317.074 404.65 9.8352 0.2006 re
+f*
+1 g
+326.909 404.65 15.6561 0.2006 re
+f*
+0.498 0 0.482 rg
+342.565 404.65 71.6568 0.2006 re
+f*
+0 g
+253.445 404.851 17.8641 0.2005 re
+f*
+1 g
+271.31 404.851 7.6273 0.2005 re
+f*
+0 g
+278.937 404.851 31.7137 0.2005 re
+f*
+1 g
+310.651 404.851 6.423 0.2005 re
+f*
+0.498 0 0.482 rg
+317.074 404.851 8.8316 0.2005 re
+f*
+1 g
+325.905 404.851 17.2619 0.2005 re
+f*
+0.498 0 0.482 rg
+343.167 404.851 71.0546 0.2005 re
+f*
+0 g
+253.445 405.051 17.8641 0.2006 re
+f*
+1 g
+271.31 405.051 7.6273 0.2006 re
+f*
+0 g
+278.937 405.051 31.7137 0.2006 re
+f*
+1 g
+310.651 405.051 6.423 0.2006 re
+f*
+0.498 0 0.482 rg
+317.074 405.051 8.0288 0.2006 re
+f*
+1 g
+325.102 405.051 7.0251 0.2006 re
+f*
+0 g
+332.127 405.051 6.2223 0.2006 re
+f*
+1 g
+338.35 405.051 5.6201 0.2006 re
+f*
+0.498 0 0.482 rg
+343.97 405.051 70.4526 0.2006 re
+f*
+0 g
+253.445 405.252 17.8641 0.2005 re
+f*
+1 g
+271.31 405.252 7.6273 0.2005 re
+f*
+0 g
+278.937 405.252 31.513 0.2005 re
+f*
+1 g
+310.45 405.252 6.4229 0.2005 re
+f*
+0.498 0 0.482 rg
+316.873 405.252 7.6274 0.2005 re
+f*
+1 g
+324.5 405.252 5.6201 0.2005 re
+f*
+0 g
+330.12 405.252 9.8353 0.2005 re
+f*
+1 g
+339.956 405.252 4.6165 0.2005 re
+f*
+0.498 0 0.482 rg
+344.572 405.252 69.8504 0.2005 re
+f*
+0 g
+253.245 405.452 18.0648 0.2006 re
+f*
+1 g
+271.31 405.452 7.6273 0.2006 re
+f*
+0 g
+278.937 405.452 31.513 0.2006 re
+f*
+1 g
+310.45 405.452 6.4229 0.2006 re
+f*
+0.498 0 0.482 rg
+316.873 405.452 7.0252 0.2006 re
+f*
+1 g
+323.898 405.452 5.2187 0.2006 re
+f*
+0 g
+329.117 405.452 12.0432 0.2006 re
+f*
+1 g
+341.16 405.452 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+344.973 405.452 69.6497 0.2006 re
+f*
+0 g
+253.245 405.653 18.0648 0.2006 re
+f*
+1 g
+271.31 405.653 7.6273 0.2006 re
+f*
+0 g
+278.937 405.653 31.513 0.2006 re
+f*
+1 g
+310.45 405.653 6.4229 0.2006 re
+f*
+0.498 0 0.482 rg
+316.873 405.653 6.4231 0.2006 re
+f*
+1 g
+323.296 405.653 4.8172 0.2006 re
+f*
+0 g
+328.113 405.653 13.8497 0.2006 re
+f*
+1 g
+341.963 405.653 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+345.576 405.653 69.0475 0.2006 re
+f*
+0 g
+253.044 405.853 18.2655 0.2006 re
+f*
+1 g
+271.31 405.853 7.6273 0.2006 re
+f*
+0 g
+278.937 405.853 31.513 0.2006 re
+f*
+1 g
+310.45 405.853 6.4229 0.2006 re
+f*
+0.498 0 0.482 rg
+316.873 405.853 5.821 0.2006 re
+f*
+1 g
+322.694 405.853 4.8172 0.2006 re
+f*
+0 g
+327.511 405.853 15.0539 0.2006 re
+f*
+1 g
+342.565 405.853 3.4122 0.2006 re
+f*
+0.498 0 0.482 rg
+345.977 405.853 68.8468 0.2006 re
+f*
+0 g
+253.044 406.054 18.2655 0.2005 re
+f*
+1 g
+271.31 406.054 7.6273 0.2005 re
+f*
+0 g
+278.937 406.054 31.513 0.2005 re
+f*
+1 g
+310.45 406.054 6.4229 0.2005 re
+f*
+0.498 0 0.482 rg
+316.873 406.054 5.2188 0.2005 re
+f*
+1 g
+322.092 406.054 4.6165 0.2005 re
+f*
+0 g
+326.708 406.054 16.459 0.2005 re
+f*
+1 g
+343.167 406.054 3.2115 0.2005 re
+f*
+0.498 0 0.482 rg
+346.379 406.054 68.4453 0.2005 re
+f*
+0 g
+252.843 406.255 18.4662 0.2005 re
+f*
+1 g
+271.31 406.255 7.6273 0.2005 re
+f*
+0 g
+278.937 406.255 31.3122 0.2005 re
+f*
+1 g
+310.249 406.255 6.6237 0.2005 re
+f*
+0.498 0 0.482 rg
+316.873 406.255 4.8174 0.2005 re
+f*
+1 g
+321.69 406.255 4.6165 0.2005 re
+f*
+0 g
+326.307 406.255 17.4626 0.2005 re
+f*
+1 g
+343.769 406.255 3.0108 0.2005 re
+f*
+0.498 0 0.482 rg
+346.78 406.255 68.0438 0.2005 re
+f*
+0 g
+252.843 406.455 18.4662 0.2006 re
+f*
+1 g
+271.31 406.455 7.6273 0.2006 re
+f*
+0 g
+278.937 406.455 31.3122 0.2006 re
+f*
+1 g
+310.249 406.455 6.6237 0.2006 re
+f*
+0.498 0 0.482 rg
+316.873 406.455 4.2152 0.2006 re
+f*
+1 g
+321.088 406.455 4.6165 0.2006 re
+f*
+0 g
+325.704 406.455 18.4662 0.2006 re
+f*
+1 g
+344.171 406.455 3.2115 0.2006 re
+f*
+0.498 0 0.482 rg
+347.382 406.455 67.6425 0.2006 re
+f*
+0 g
+252.843 406.656 18.4662 0.2006 re
+f*
+1 g
+271.31 406.656 7.6273 0.2006 re
+f*
+0 g
+278.937 406.656 31.3122 0.2006 re
+f*
+1 g
+310.249 406.656 6.6237 0.2006 re
+f*
+0.498 0 0.482 rg
+316.873 406.656 3.8138 0.2006 re
+f*
+1 g
+320.687 406.656 4.6165 0.2006 re
+f*
+0 g
+325.303 406.656 19.269 0.2006 re
+f*
+1 g
+344.572 406.656 3.2116 0.2006 re
+f*
+0.498 0 0.482 rg
+347.784 406.656 67.241 0.2006 re
+f*
+0 g
+252.643 406.856 18.6669 0.2005 re
+f*
+1 g
+271.31 406.856 7.6273 0.2005 re
+f*
+0 g
+278.937 406.856 31.3122 0.2005 re
+f*
+1 g
+310.249 406.856 6.8245 0.2005 re
+f*
+0.498 0 0.482 rg
+317.074 406.856 3.0108 0.2005 re
+f*
+1 g
+320.084 406.856 4.8172 0.2005 re
+f*
+0 g
+324.902 406.856 20.0719 0.2005 re
+f*
+1 g
+344.973 406.856 3.2116 0.2005 re
+f*
+0.498 0 0.482 rg
+348.185 406.856 67.0402 0.2005 re
+f*
+0 g
+252.643 407.057 18.6669 0.2006 re
+f*
+1 g
+271.31 407.057 7.6273 0.2006 re
+f*
+0 g
+278.937 407.057 31.3122 0.2006 re
+f*
+1 g
+310.249 407.057 6.8245 0.2006 re
+f*
+0.498 0 0.482 rg
+317.074 407.057 2.4086 0.2006 re
+f*
+1 g
+319.482 407.057 4.8173 0.2006 re
+f*
+0 g
+324.299 407.057 21.0755 0.2006 re
+f*
+1 g
+345.375 407.057 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+348.386 407.057 66.8395 0.2006 re
+f*
+0 g
+252.442 407.257 18.8677 0.2005 re
+f*
+1 g
+271.31 407.257 7.6273 0.2005 re
+f*
+0 g
+278.937 407.257 31.1115 0.2005 re
+f*
+1 g
+310.048 407.257 7.0252 0.2005 re
+f*
+0.498 0 0.482 rg
+317.074 407.257 2.0071 0.2005 re
+f*
+1 g
+319.081 407.257 5.0181 0.2005 re
+f*
+0 g
+324.099 407.257 21.4769 0.2005 re
+f*
+1 g
+345.576 407.257 3.2116 0.2005 re
+f*
+0.498 0 0.482 rg
+348.787 407.257 66.438 0.2005 re
+f*
+0 g
+252.442 407.458 18.8677 0.2006 re
+f*
+1 g
+271.31 407.458 7.6273 0.2006 re
+f*
+0 g
+278.937 407.458 31.1115 0.2006 re
+f*
+1 g
+310.048 407.458 7.0252 0.2006 re
+f*
+0.498 0 0.482 rg
+317.074 407.458 1.405 0.2006 re
+f*
+1 g
+318.479 407.458 5.2187 0.2006 re
+f*
+0 g
+323.697 407.458 22.2798 0.2006 re
+f*
+1 g
+345.977 407.458 3.2116 0.2006 re
+f*
+0.498 0 0.482 rg
+349.189 407.458 66.2374 0.2006 re
+f*
+0 g
+252.442 407.658 18.8677 0.2006 re
+f*
+1 g
+271.31 407.658 7.6273 0.2006 re
+f*
+0 g
+278.937 407.658 31.1115 0.2006 re
+f*
+1 g
+310.048 407.658 7.0252 0.2006 re
+f*
+0.498 0 0.482 rg
+317.074 407.658 1.0035 0.2006 re
+f*
+1 g
+318.077 407.658 5.2188 0.2006 re
+f*
+0 g
+323.296 407.658 22.882 0.2006 re
+f*
+1 g
+346.178 407.658 3.2115 0.2006 re
+f*
+0.498 0 0.482 rg
+349.389 407.658 66.0367 0.2006 re
+f*
+0 g
+252.241 407.859 19.0684 0.2005 re
+f*
+1 g
+271.31 407.859 7.6273 0.2005 re
+f*
+0 g
+278.937 407.859 31.1115 0.2005 re
+f*
+1 g
+310.048 407.859 7.0252 0.2005 re
+f*
+0.498 0 0.482 rg
+317.074 407.859 0.4014 0.2005 re
+f*
+1 g
+317.475 407.859 5.4194 0.2005 re
+f*
+0 g
+322.894 407.859 23.6849 0.2005 re
+f*
+1 g
+346.579 407.859 3.2116 0.2005 re
+f*
+0.498 0 0.482 rg
+349.791 407.859 65.8359 0.2005 re
+f*
+0 g
+252.241 408.06 19.0684 0.2006 re
+f*
+1 g
+271.31 408.06 7.6273 0.2006 re
+f*
+0 g
+278.937 408.06 31.1115 0.2006 re
+f*
+1 g
+310.048 408.06 12.6454 0.2006 re
+f*
+0 g
+322.694 408.06 24.0863 0.2006 re
+f*
+1 g
+346.78 408.06 3.2114 0.2006 re
+f*
+0.498 0 0.482 rg
+349.991 408.06 65.6353 0.2006 re
+f*
+0 g
+252.241 408.26 19.0684 0.2005 re
+f*
+1 g
+271.31 408.26 7.6273 0.2005 re
+f*
+0 g
+278.937 408.26 31.1115 0.2005 re
+f*
+1 g
+310.048 408.26 12.2439 0.2005 re
+f*
+0 g
+322.292 408.26 24.8892 0.2005 re
+f*
+1 g
+347.181 408.26 3.2115 0.2005 re
+f*
+0.498 0 0.482 rg
+350.393 408.26 65.2338 0.2005 re
+f*
+0 g
+252.04 408.461 19.2691 0.2006 re
+f*
+1 g
+271.31 408.461 7.6273 0.2006 re
+f*
+0 g
+278.937 408.461 31.1115 0.2006 re
+f*
+1 g
+310.048 408.461 12.0432 0.2006 re
+f*
+0 g
+322.092 408.461 25.2906 0.2006 re
+f*
+1 g
+347.382 408.461 3.2115 0.2006 re
+f*
+0.498 0 0.482 rg
+350.594 408.461 65.2338 0.2006 re
+f*
+0 g
+252.04 408.661 19.2691 0.2006 re
+f*
+1 g
+271.31 408.661 7.6273 0.2006 re
+f*
+0 g
+278.937 408.661 30.9108 0.2006 re
+f*
+1 g
+309.848 408.661 11.8425 0.2006 re
+f*
+0 g
+321.69 408.661 25.8927 0.2006 re
+f*
+1 g
+347.583 408.661 3.2116 0.2006 re
+f*
+0.498 0 0.482 rg
+350.794 408.661 65.033 0.2006 re
+f*
+0 g
+252.04 408.862 19.2691 0.2005 re
+f*
+1 g
+271.31 408.862 7.6273 0.2005 re
+f*
+0 g
+278.937 408.862 30.9108 0.2005 re
+f*
+1 g
+309.848 408.862 11.6417 0.2005 re
+f*
+0 g
+321.489 408.862 26.2943 0.2005 re
+f*
+1 g
+347.784 408.862 3.4122 0.2005 re
+f*
+0.498 0 0.482 rg
+351.196 408.862 64.6316 0.2005 re
+f*
+0 g
+251.84 409.062 19.4698 0.2006 re
+f*
+1 g
+271.31 409.062 7.6273 0.2006 re
+f*
+0 g
+278.937 409.062 30.9108 0.2006 re
+f*
+1 g
+309.848 409.062 11.2403 0.2006 re
+f*
+0 g
+321.088 409.062 26.8963 0.2006 re
+f*
+1 g
+347.984 409.062 3.4123 0.2006 re
+f*
+0.498 0 0.482 rg
+351.397 409.062 64.6317 0.2006 re
+f*
+0 g
+251.84 409.263 19.4698 0.2005 re
+f*
+1 g
+271.31 409.263 7.6273 0.2005 re
+f*
+0 g
+278.937 409.263 30.9108 0.2005 re
+f*
+1 g
+309.848 409.263 11.0395 0.2005 re
+f*
+0 g
+320.887 409.263 27.4986 0.2005 re
+f*
+1 g
+348.386 409.263 3.2115 0.2005 re
+f*
+0.498 0 0.482 rg
+351.597 409.263 64.431 0.2005 re
+f*
+0 g
+251.84 409.463 19.4698 0.2006 re
+f*
+1 g
+271.31 409.463 7.6273 0.2006 re
+f*
+0 g
+278.937 409.463 30.9108 0.2006 re
+f*
+1 g
+309.848 409.463 10.8389 0.2006 re
+f*
+0 g
+320.687 409.463 27.6992 0.2006 re
+f*
+1 g
+348.386 409.463 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+351.999 409.463 64.0296 0.2006 re
+f*
+0 g
+251.639 409.664 19.6705 0.2006 re
+f*
+1 g
+271.31 409.664 7.6273 0.2006 re
+f*
+0 g
+278.937 409.664 30.9108 0.2006 re
+f*
+1 g
+309.848 409.664 10.4374 0.2006 re
+f*
+0 g
+320.285 409.664 28.3014 0.2006 re
+f*
+1 g
+348.586 409.664 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+352.2 409.664 64.0294 0.2006 re
+f*
+0 g
+251.639 409.865 19.6705 0.2005 re
+f*
+1 g
+271.31 409.865 7.6273 0.2005 re
+f*
+0 g
+278.937 409.865 30.9108 0.2005 re
+f*
+1 g
+309.848 409.865 10.2367 0.2005 re
+f*
+0 g
+320.084 409.865 28.7029 0.2005 re
+f*
+1 g
+348.787 409.865 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+352.4 409.865 63.8287 0.2005 re
+f*
+0 g
+251.639 410.065 19.6705 0.2006 re
+f*
+1 g
+271.31 410.065 7.6273 0.2006 re
+f*
+0 g
+278.937 410.065 30.7101 0.2006 re
+f*
+1 g
+309.647 410.065 10.2366 0.2006 re
+f*
+0 g
+319.884 410.065 29.1043 0.2006 re
+f*
+1 g
+348.988 410.065 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+352.601 410.065 63.628 0.2006 re
+f*
+0 g
+251.438 410.266 19.8713 0.2005 re
+f*
+1 g
+271.31 410.266 7.6273 0.2005 re
+f*
+0 g
+278.937 410.266 30.7101 0.2005 re
+f*
+1 g
+309.647 410.266 10.036 0.2005 re
+f*
+0 g
+319.683 410.266 29.5057 0.2005 re
+f*
+1 g
+349.189 410.266 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+352.802 410.266 63.4272 0.2005 re
+f*
+0 g
+251.438 410.466 19.8713 0.2006 re
+f*
+1 g
+271.31 410.466 7.6273 0.2006 re
+f*
+0 g
+278.937 410.466 30.7101 0.2006 re
+f*
+1 g
+309.647 410.466 9.8352 0.2006 re
+f*
+0 g
+319.482 410.466 29.9072 0.2006 re
+f*
+1 g
+349.389 410.466 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+353.002 410.466 63.4274 0.2006 re
+f*
+0 g
+251.438 410.667 19.8713 0.2005 re
+f*
+1 g
+271.31 410.667 7.6273 0.2005 re
+f*
+0 g
+278.937 410.667 30.7101 0.2005 re
+f*
+1 g
+309.647 410.667 9.6345 0.2005 re
+f*
+0 g
+319.281 410.667 30.3086 0.2005 re
+f*
+1 g
+349.59 410.667 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 410.667 63.2266 0.2005 re
+f*
+0 g
+251.438 410.867 19.8713 0.2006 re
+f*
+1 g
+271.31 410.867 7.6273 0.2006 re
+f*
+0 g
+278.937 410.867 30.7101 0.2006 re
+f*
+1 g
+309.647 410.867 9.4337 0.2006 re
+f*
+0 g
+319.081 410.867 30.5094 0.2006 re
+f*
+1 g
+349.59 410.867 3.8137 0.2006 re
+f*
+0.498 0 0.482 rg
+353.404 410.867 63.0259 0.2006 re
+f*
+0 g
+251.238 411.068 20.072 0.2006 re
+f*
+1 g
+271.31 411.068 7.6273 0.2006 re
+f*
+0 g
+278.937 411.068 30.7101 0.2006 re
+f*
+1 g
+309.647 411.068 9.233 0.2006 re
+f*
+0 g
+318.88 411.068 30.9109 0.2006 re
+f*
+1 g
+349.791 411.068 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+353.605 411.068 62.8252 0.2006 re
+f*
+0 g
+251.238 411.268 20.072 0.2005 re
+f*
+1 g
+271.31 411.268 7.6273 0.2005 re
+f*
+0 g
+278.937 411.268 30.7101 0.2005 re
+f*
+1 g
+309.647 411.268 9.0324 0.2005 re
+f*
+0 g
+318.679 411.268 31.3121 0.2005 re
+f*
+1 g
+349.991 411.268 3.8138 0.2005 re
+f*
+0.498 0 0.482 rg
+353.805 411.268 28.7028 0.2005 re
+f*
+1 g
+382.508 411.268 1.2043 0.2005 re
+f*
+0.498 0 0.482 rg
+383.712 411.268 23.2835 0.2005 re
+f*
+1 g
+406.996 411.268 1.6057 0.2005 re
+f*
+0.498 0 0.482 rg
+408.602 411.268 8.0288 0.2005 re
+f*
+0 g
+251.238 411.469 20.072 0.2006 re
+f*
+1 g
+271.31 411.469 7.6273 0.2006 re
+f*
+0 g
+278.937 411.469 30.7101 0.2006 re
+f*
+1 g
+309.647 411.469 8.8316 0.2006 re
+f*
+0 g
+318.479 411.469 31.5129 0.2006 re
+f*
+1 g
+349.991 411.469 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+354.006 411.469 27.0972 0.2006 re
+f*
+1 g
+381.103 411.469 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+384.917 411.469 20.4734 0.2006 re
+f*
+1 g
+405.39 411.469 4.6166 0.2006 re
+f*
+0.498 0 0.482 rg
+410.007 411.469 6.6237 0.2006 re
+f*
+0 g
+251.238 411.67 20.072 0.2005 re
+f*
+1 g
+271.31 411.67 7.6273 0.2005 re
+f*
+0 g
+278.937 411.67 30.5094 0.2005 re
+f*
+1 g
+309.446 411.67 8.8316 0.2005 re
+f*
+0 g
+318.278 411.67 31.9144 0.2005 re
+f*
+1 g
+350.192 411.67 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+354.207 411.67 26.2942 0.2005 re
+f*
+1 g
+380.501 411.67 4.8173 0.2005 re
+f*
+0.498 0 0.482 rg
+385.318 411.67 19.269 0.2005 re
+f*
+1 g
+404.587 411.67 6.0216 0.2005 re
+f*
+0.498 0 0.482 rg
+410.609 411.67 6.0216 0.2005 re
+f*
+0 g
+251.037 411.87 20.2727 0.2006 re
+f*
+1 g
+271.31 411.87 7.6273 0.2006 re
+f*
+0 g
+278.937 411.87 30.5094 0.2006 re
+f*
+1 g
+309.446 411.87 8.6308 0.2006 re
+f*
+0 g
+318.077 411.87 32.3159 0.2006 re
+f*
+1 g
+350.393 411.87 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+354.407 411.87 6.2223 0.2006 re
+f*
+1 g
+360.63 411.87 9.6345 0.2006 re
+f*
+0.498 0 0.482 rg
+370.264 411.87 9.6346 0.2006 re
+f*
+1 g
+379.899 411.87 5.8208 0.2006 re
+f*
+0.498 0 0.482 rg
+385.72 411.87 2.6093 0.2006 re
+f*
+1 g
+388.329 411.87 0.2008 0.2006 re
+f*
+0.498 0 0.482 rg
+388.53 411.87 6.2223 0.2006 re
+f*
+1 g
+394.752 411.87 0.2007 0.2006 re
+f*
+0.498 0 0.482 rg
+394.953 411.87 9.0324 0.2006 re
+f*
+1 g
+403.985 411.87 7.2259 0.2006 re
+f*
+0.498 0 0.482 rg
+411.211 411.87 5.4194 0.2006 re
+f*
+0 g
+251.037 412.071 20.2727 0.2006 re
+f*
+1 g
+271.31 412.071 7.6273 0.2006 re
+f*
+0 g
+278.937 412.071 30.5094 0.2006 re
+f*
+1 g
+309.446 412.071 8.4301 0.2006 re
+f*
+0 g
+317.876 412.071 32.5166 0.2006 re
+f*
+1 g
+350.393 412.071 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+354.407 412.071 6.2223 0.2006 re
+f*
+1 g
+360.63 412.071 9.6345 0.2006 re
+f*
+0.498 0 0.482 rg
+370.264 412.071 9.2331 0.2006 re
+f*
+1 g
+379.497 412.071 2.8101 0.2006 re
+f*
+0.498 0 0.482 rg
+382.307 412.071 1.6058 0.2006 re
+f*
+1 g
+383.913 412.071 2.2078 0.2006 re
+f*
+0.498 0 0.482 rg
+386.121 412.071 2.2079 0.2006 re
+f*
+1 g
+388.329 412.071 6.6238 0.2006 re
+f*
+0.498 0 0.482 rg
+394.953 412.071 8.6309 0.2006 re
+f*
+1 g
+403.584 412.071 3.4123 0.2006 re
+f*
+0.498 0 0.482 rg
+406.996 412.071 1.8065 0.2006 re
+f*
+1 g
+408.802 412.071 2.6093 0.2006 re
+f*
+0.498 0 0.482 rg
+411.412 412.071 5.4194 0.2006 re
+f*
+0 g
+251.037 412.271 20.2727 0.2005 re
+f*
+1 g
+271.31 412.271 7.6273 0.2005 re
+f*
+0 g
+278.937 412.271 30.5094 0.2005 re
+f*
+1 g
+309.446 412.271 8.2295 0.2005 re
+f*
+0 g
+317.676 412.271 32.9179 0.2005 re
+f*
+1 g
+350.594 412.271 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+354.608 412.271 6.0216 0.2005 re
+f*
+1 g
+360.63 412.271 9.6345 0.2005 re
+f*
+0.498 0 0.482 rg
+370.264 412.271 8.8317 0.2005 re
+f*
+1 g
+379.096 412.271 2.2079 0.2005 re
+f*
+0.498 0 0.482 rg
+381.304 412.271 3.4122 0.2005 re
+f*
+1 g
+384.716 412.271 1.6057 0.2005 re
+f*
+0.498 0 0.482 rg
+386.322 412.271 2.0072 0.2005 re
+f*
+1 g
+388.329 412.271 6.6238 0.2005 re
+f*
+0.498 0 0.482 rg
+394.953 412.271 8.2295 0.2005 re
+f*
+1 g
+403.182 412.271 3.0108 0.2005 re
+f*
+0.498 0 0.482 rg
+406.193 412.271 3.613 0.2005 re
+f*
+1 g
+409.806 412.271 2.0071 0.2005 re
+f*
+0.498 0 0.482 rg
+411.813 412.271 5.018 0.2005 re
+f*
+0 g
+251.037 412.472 20.2727 0.2006 re
+f*
+1 g
+271.31 412.472 7.6273 0.2006 re
+f*
+0 g
+278.937 412.472 30.5094 0.2006 re
+f*
+1 g
+309.446 412.472 8.0287 0.2006 re
+f*
+0 g
+317.475 412.472 21.0756 0.2006 re
+f*
+1 g
+338.551 412.472 2.81 0.2006 re
+f*
+0 g
+341.361 412.472 9.2331 0.2006 re
+f*
+1 g
+350.594 412.472 4.2151 0.2006 re
+f*
+0.498 0 0.482 rg
+354.809 412.472 5.8209 0.2006 re
+f*
+1 g
+360.63 412.472 9.6345 0.2006 re
+f*
+0.498 0 0.482 rg
+370.264 412.472 8.4303 0.2006 re
+f*
+1 g
+378.695 412.472 2.2079 0.2006 re
+f*
+0.498 0 0.482 rg
+380.902 412.472 4.4158 0.2006 re
+f*
+1 g
+385.318 412.472 1.405 0.2006 re
+f*
+0.498 0 0.482 rg
+386.723 412.472 1.6057 0.2006 re
+f*
+1 g
+388.329 412.472 6.6238 0.2006 re
+f*
+0.498 0 0.482 rg
+394.953 412.472 7.8281 0.2006 re
+f*
+1 g
+402.781 412.472 2.8101 0.2006 re
+f*
+0.498 0 0.482 rg
+405.591 412.472 4.8172 0.2006 re
+f*
+1 g
+410.408 412.472 1.8065 0.2006 re
+f*
+0.498 0 0.482 rg
+412.215 412.472 4.6165 0.2006 re
+f*
+0 g
+250.836 412.672 20.4734 0.2005 re
+f*
+1 g
+271.31 412.672 7.6273 0.2005 re
+f*
+0 g
+278.937 412.672 30.5094 0.2005 re
+f*
+1 g
+309.446 412.672 8.0287 0.2005 re
+f*
+0 g
+317.475 412.672 19.8713 0.2005 re
+f*
+1 g
+337.346 412.672 5.0179 0.2005 re
+f*
+0 g
+342.364 412.672 8.4303 0.2005 re
+f*
+1 g
+350.794 412.672 4.215 0.2005 re
+f*
+0.498 0 0.482 rg
+355.01 412.672 8.631 0.2005 re
+f*
+1 g
+363.641 412.672 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 412.672 11.2403 0.2005 re
+f*
+1 g
+378.494 412.672 2.0072 0.2005 re
+f*
+0.498 0 0.482 rg
+380.501 412.672 5.018 0.2005 re
+f*
+1 g
+385.519 412.672 1.4051 0.2005 re
+f*
+0.498 0 0.482 rg
+386.924 412.672 1.4049 0.2005 re
+f*
+1 g
+388.329 412.672 3.4123 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 412.672 10.6381 0.2005 re
+f*
+1 g
+402.379 412.672 2.8101 0.2005 re
+f*
+0.498 0 0.482 rg
+405.189 412.672 5.6201 0.2005 re
+f*
+1 g
+410.81 412.672 1.6058 0.2005 re
+f*
+0.498 0 0.482 rg
+412.415 412.672 4.4158 0.2005 re
+f*
+0 g
+250.836 412.873 20.4734 0.2006 re
+f*
+1 g
+271.31 412.873 7.6273 0.2006 re
+f*
+0 g
+278.937 412.873 30.5094 0.2006 re
+f*
+1 g
+309.446 412.873 7.828 0.2006 re
+f*
+0 g
+317.274 412.873 19.4698 0.2006 re
+f*
+1 g
+336.744 412.873 6.2223 0.2006 re
+f*
+0 g
+342.966 412.873 8.0287 0.2006 re
+f*
+1 g
+350.995 412.873 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+355.21 412.873 8.4302 0.2006 re
+f*
+1 g
+363.641 412.873 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 412.873 10.8389 0.2006 re
+f*
+1 g
+378.092 412.873 2.2079 0.2006 re
+f*
+0.498 0 0.482 rg
+380.3 412.873 5.6201 0.2006 re
+f*
+1 g
+385.92 412.873 1.2043 0.2006 re
+f*
+0.498 0 0.482 rg
+387.125 412.873 1.2043 0.2006 re
+f*
+1 g
+388.329 412.873 3.4123 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 412.873 10.4374 0.2006 re
+f*
+1 g
+402.179 412.873 2.8101 0.2006 re
+f*
+0.498 0 0.482 rg
+404.989 412.873 6.2223 0.2006 re
+f*
+1 g
+411.211 412.873 1.405 0.2006 re
+f*
+0.498 0 0.482 rg
+412.616 412.873 4.4159 0.2006 re
+f*
+0 g
+250.836 413.073 20.4734 0.2006 re
+f*
+1 g
+271.31 413.073 7.6273 0.2006 re
+f*
+0 g
+278.937 413.073 13.0467 0.2006 re
+f*
+1 g
+291.984 413.073 10.036 0.2006 re
+f*
+0 g
+302.02 413.073 7.4267 0.2006 re
+f*
+1 g
+309.446 413.073 7.6273 0.2006 re
+f*
+0 g
+317.074 413.073 19.0683 0.2006 re
+f*
+1 g
+336.142 413.073 7.2259 0.2006 re
+f*
+0 g
+343.368 413.073 7.6273 0.2006 re
+f*
+1 g
+350.995 413.073 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+355.21 413.073 8.4302 0.2006 re
+f*
+1 g
+363.641 413.073 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 413.073 10.6382 0.2006 re
+f*
+1 g
+377.892 413.073 2.2079 0.2006 re
+f*
+0.498 0 0.482 rg
+380.099 413.073 6.0215 0.2006 re
+f*
+1 g
+386.121 413.073 1.2043 0.2006 re
+f*
+0.498 0 0.482 rg
+387.325 413.073 1.0036 0.2006 re
+f*
+1 g
+388.329 413.073 3.4123 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 413.073 10.036 0.2006 re
+f*
+1 g
+401.777 413.073 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+404.788 413.073 6.8244 0.2006 re
+f*
+1 g
+411.612 413.073 1.2043 0.2006 re
+f*
+0.498 0 0.482 rg
+412.817 413.073 4.2152 0.2006 re
+f*
+0 g
+250.836 413.274 20.4734 0.2005 re
+f*
+1 g
+271.31 413.274 7.6273 0.2005 re
+f*
+0 g
+278.937 413.274 13.0467 0.2005 re
+f*
+1 g
+291.984 413.274 10.036 0.2005 re
+f*
+0 g
+302.02 413.274 7.4267 0.2005 re
+f*
+1 g
+309.446 413.274 7.4265 0.2005 re
+f*
+0 g
+316.873 413.274 18.667 0.2005 re
+f*
+1 g
+335.54 413.274 3.2115 0.2005 re
+f*
+0 g
+338.751 413.274 2.8101 0.2005 re
+f*
+1 g
+341.561 413.274 2.2079 0.2005 re
+f*
+0 g
+343.769 413.274 7.4266 0.2005 re
+f*
+1 g
+351.196 413.274 4.2151 0.2005 re
+f*
+0.498 0 0.482 rg
+355.411 413.274 8.2295 0.2005 re
+f*
+1 g
+363.641 413.274 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 413.274 10.4375 0.2005 re
+f*
+1 g
+377.691 413.274 2.2079 0.2005 re
+f*
+0.498 0 0.482 rg
+379.899 413.274 6.4229 0.2005 re
+f*
+1 g
+386.322 413.274 1.0036 0.2005 re
+f*
+0.498 0 0.482 rg
+387.325 413.274 1.0036 0.2005 re
+f*
+1 g
+388.329 413.274 3.4123 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 413.274 9.8352 0.2005 re
+f*
+1 g
+401.576 413.274 3.0108 0.2005 re
+f*
+0.498 0 0.482 rg
+404.587 413.274 7.2259 0.2005 re
+f*
+1 g
+411.813 413.274 1.2044 0.2005 re
+f*
+0.498 0 0.482 rg
+413.017 413.274 4.0144 0.2005 re
+f*
+0 g
+250.836 413.475 20.4734 0.2006 re
+f*
+1 g
+271.31 413.475 7.6273 0.2006 re
+f*
+0 g
+278.937 413.475 13.0467 0.2006 re
+f*
+1 g
+291.984 413.475 10.036 0.2006 re
+f*
+0 g
+302.02 413.475 7.4267 0.2006 re
+f*
+1 g
+309.446 413.475 7.4265 0.2006 re
+f*
+0 g
+316.873 413.475 18.2655 0.2006 re
+f*
+1 g
+335.138 413.475 3.0108 0.2006 re
+f*
+0 g
+338.149 413.475 4.2151 0.2006 re
+f*
+1 g
+342.364 413.475 1.8065 0.2006 re
+f*
+0 g
+344.171 413.475 7.0252 0.2006 re
+f*
+1 g
+351.196 413.475 4.4158 0.2006 re
+f*
+0.498 0 0.482 rg
+355.612 413.475 8.0288 0.2006 re
+f*
+1 g
+363.641 413.475 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 413.475 10.2367 0.2006 re
+f*
+1 g
+377.49 413.475 2.208 0.2006 re
+f*
+0.498 0 0.482 rg
+379.698 413.475 6.8244 0.2006 re
+f*
+1 g
+386.522 413.475 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+387.526 413.475 0.8028 0.2006 re
+f*
+1 g
+388.329 413.475 3.4123 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 413.475 9.6345 0.2006 re
+f*
+1 g
+401.376 413.475 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+404.386 413.475 7.6274 0.2006 re
+f*
+1 g
+412.014 413.475 1.2042 0.2006 re
+f*
+0.498 0 0.482 rg
+413.218 413.475 3.8138 0.2006 re
+f*
+0 g
+250.836 413.675 20.4734 0.2005 re
+f*
+1 g
+271.31 413.675 7.6273 0.2005 re
+f*
+0 g
+278.937 413.675 13.0467 0.2005 re
+f*
+1 g
+291.984 413.675 10.036 0.2005 re
+f*
+0 g
+302.02 413.675 7.4267 0.2005 re
+f*
+1 g
+309.446 413.675 7.2258 0.2005 re
+f*
+0 g
+316.672 413.675 18.2655 0.2005 re
+f*
+1 g
+334.938 413.675 2.8101 0.2005 re
+f*
+0 g
+337.748 413.675 5.018 0.2005 re
+f*
+1 g
+342.766 413.675 1.6057 0.2005 re
+f*
+0 g
+344.371 413.675 6.8245 0.2005 re
+f*
+1 g
+351.196 413.675 4.6165 0.2005 re
+f*
+0.498 0 0.482 rg
+355.812 413.675 7.8281 0.2005 re
+f*
+1 g
+363.641 413.675 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 413.675 10.036 0.2005 re
+f*
+1 g
+377.289 413.675 2.2079 0.2005 re
+f*
+0.498 0 0.482 rg
+379.497 413.675 7.2259 0.2005 re
+f*
+1 g
+386.723 413.675 1.0036 0.2005 re
+f*
+0.498 0 0.482 rg
+387.727 413.675 0.6021 0.2005 re
+f*
+1 g
+388.329 413.675 3.4123 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 413.675 9.4338 0.2005 re
+f*
+1 g
+401.175 413.675 3.0108 0.2005 re
+f*
+0.498 0 0.482 rg
+404.186 413.675 8.0288 0.2005 re
+f*
+1 g
+412.215 413.675 1.2043 0.2005 re
+f*
+0.498 0 0.482 rg
+413.419 413.675 3.613 0.2005 re
+f*
+0 g
+250.635 413.876 20.6741 0.2006 re
+f*
+1 g
+271.31 413.876 7.6273 0.2006 re
+f*
+0 g
+278.937 413.876 16.0575 0.2006 re
+f*
+1 g
+294.994 413.876 3.613 0.2006 re
+f*
+0 g
+298.607 413.876 10.8389 0.2006 re
+f*
+1 g
+309.446 413.876 7.0251 0.2006 re
+f*
+0 g
+316.471 413.876 18.0648 0.2006 re
+f*
+1 g
+334.536 413.876 2.8101 0.2006 re
+f*
+0 g
+337.346 413.876 5.8208 0.2006 re
+f*
+1 g
+343.167 413.876 1.6058 0.2006 re
+f*
+0 g
+344.773 413.876 6.6237 0.2006 re
+f*
+1 g
+351.397 413.876 4.4158 0.2006 re
+f*
+0.498 0 0.482 rg
+355.812 413.876 7.8281 0.2006 re
+f*
+1 g
+363.641 413.876 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 413.876 9.8353 0.2006 re
+f*
+1 g
+377.089 413.876 2.4086 0.2006 re
+f*
+0.498 0 0.482 rg
+379.497 413.876 7.4267 0.2006 re
+f*
+1 g
+386.924 413.876 0.8028 0.2006 re
+f*
+0.498 0 0.482 rg
+387.727 413.876 0.6021 0.2006 re
+f*
+1 g
+388.329 413.876 3.4123 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 413.876 9.2331 0.2006 re
+f*
+1 g
+400.974 413.876 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+403.985 413.876 8.4302 0.2006 re
+f*
+1 g
+412.415 413.876 1.2043 0.2006 re
+f*
+0.498 0 0.482 rg
+413.62 413.876 3.4123 0.2006 re
+f*
+0 g
+250.635 414.076 20.6741 0.2006 re
+f*
+1 g
+271.31 414.076 7.6273 0.2006 re
+f*
+0 g
+278.937 414.076 16.0575 0.2006 re
+f*
+1 g
+294.994 414.076 3.613 0.2006 re
+f*
+0 g
+298.607 414.076 10.6381 0.2006 re
+f*
+1 g
+309.245 414.076 7.2259 0.2006 re
+f*
+0 g
+316.471 414.076 17.6633 0.2006 re
+f*
+1 g
+334.135 414.076 3.0108 0.2006 re
+f*
+0 g
+337.146 414.076 6.423 0.2006 re
+f*
+1 g
+343.568 414.076 1.405 0.2006 re
+f*
+0 g
+344.973 414.076 6.4231 0.2006 re
+f*
+1 g
+351.397 414.076 4.6165 0.2006 re
+f*
+0.498 0 0.482 rg
+356.013 414.076 7.6274 0.2006 re
+f*
+1 g
+363.641 414.076 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 414.076 9.6346 0.2006 re
+f*
+1 g
+376.888 414.076 2.4086 0.2006 re
+f*
+0.498 0 0.482 rg
+379.297 414.076 7.6274 0.2006 re
+f*
+1 g
+386.924 414.076 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+387.928 414.076 0.4013 0.2006 re
+f*
+1 g
+388.329 414.076 3.4123 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 414.076 9.0324 0.2006 re
+f*
+1 g
+400.774 414.076 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+403.784 414.076 8.8316 0.2006 re
+f*
+1 g
+412.616 414.076 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+413.62 414.076 3.6129 0.2006 re
+f*
+0 g
+250.635 414.277 20.6741 0.2005 re
+f*
+1 g
+271.31 414.277 7.6273 0.2005 re
+f*
+0 g
+278.937 414.277 16.0575 0.2005 re
+f*
+1 g
+294.994 414.277 3.613 0.2005 re
+f*
+0 g
+298.607 414.277 10.6381 0.2005 re
+f*
+1 g
+309.245 414.277 7.0252 0.2005 re
+f*
+0 g
+316.271 414.277 17.6633 0.2005 re
+f*
+1 g
+333.934 414.277 3.0108 0.2005 re
+f*
+0 g
+336.945 414.277 6.8245 0.2005 re
+f*
+1 g
+343.769 414.277 1.405 0.2005 re
+f*
+0 g
+345.174 414.277 6.423 0.2005 re
+f*
+1 g
+351.597 414.277 4.6165 0.2005 re
+f*
+0.498 0 0.482 rg
+356.214 414.277 7.4267 0.2005 re
+f*
+1 g
+363.641 414.277 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 414.277 9.4339 0.2005 re
+f*
+1 g
+376.687 414.277 2.6093 0.2005 re
+f*
+0.498 0 0.482 rg
+379.297 414.277 7.828 0.2005 re
+f*
+1 g
+387.125 414.277 0.803 0.2005 re
+f*
+0.498 0 0.482 rg
+387.928 414.277 0.4013 0.2005 re
+f*
+1 g
+388.329 414.277 3.4123 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 414.277 8.8316 0.2005 re
+f*
+1 g
+400.573 414.277 3.2116 0.2005 re
+f*
+0.498 0 0.482 rg
+403.784 414.277 9.0323 0.2005 re
+f*
+1 g
+412.817 414.277 1.0036 0.2005 re
+f*
+0.498 0 0.482 rg
+413.82 414.277 3.4122 0.2005 re
+f*
+0 g
+250.635 414.477 20.6741 0.2005 re
+f*
+1 g
+271.31 414.477 7.6273 0.2005 re
+f*
+0 g
+278.937 414.477 16.0575 0.2005 re
+f*
+1 g
+294.994 414.477 3.613 0.2005 re
+f*
+0 g
+298.607 414.477 10.6381 0.2005 re
+f*
+1 g
+309.245 414.477 6.8245 0.2005 re
+f*
+0 g
+316.07 414.477 17.6633 0.2005 re
+f*
+1 g
+333.733 414.477 3.0108 0.2005 re
+f*
+0 g
+336.744 414.477 7.4266 0.2005 re
+f*
+1 g
+344.171 414.477 1.2043 0.2005 re
+f*
+0 g
+345.375 414.477 6.2223 0.2005 re
+f*
+1 g
+351.597 414.477 4.6165 0.2005 re
+f*
+0.498 0 0.482 rg
+356.214 414.477 7.4267 0.2005 re
+f*
+1 g
+363.641 414.477 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 414.477 9.2331 0.2005 re
+f*
+1 g
+376.486 414.477 2.6094 0.2005 re
+f*
+0.498 0 0.482 rg
+379.096 414.477 8.0287 0.2005 re
+f*
+1 g
+387.125 414.477 1.0036 0.2005 re
+f*
+0.498 0 0.482 rg
+388.128 414.477 0.2007 0.2005 re
+f*
+1 g
+388.329 414.477 3.4123 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 414.477 8.6309 0.2005 re
+f*
+1 g
+400.372 414.477 3.2115 0.2005 re
+f*
+0.498 0 0.482 rg
+403.584 414.477 9.4339 0.2005 re
+f*
+1 g
+413.017 414.477 1.0036 0.2005 re
+f*
+0.498 0 0.482 rg
+414.021 414.477 3.2114 0.2005 re
+f*
+0 g
+250.635 414.678 20.6741 0.2006 re
+f*
+1 g
+271.31 414.678 7.6273 0.2006 re
+f*
+0 g
+278.937 414.678 16.0575 0.2006 re
+f*
+1 g
+294.994 414.678 3.613 0.2006 re
+f*
+0 g
+298.607 414.678 10.6381 0.2006 re
+f*
+1 g
+309.245 414.678 6.8245 0.2006 re
+f*
+0 g
+316.07 414.678 17.4626 0.2006 re
+f*
+1 g
+333.533 414.678 3.0108 0.2006 re
+f*
+0 g
+336.543 414.678 7.828 0.2006 re
+f*
+1 g
+344.371 414.678 1.0036 0.2006 re
+f*
+0 g
+345.375 414.678 6.2223 0.2006 re
+f*
+1 g
+351.597 414.678 4.8173 0.2006 re
+f*
+0.498 0 0.482 rg
+356.415 414.678 7.2259 0.2006 re
+f*
+1 g
+363.641 414.678 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 414.678 9.0324 0.2006 re
+f*
+1 g
+376.286 414.678 2.8101 0.2006 re
+f*
+0.498 0 0.482 rg
+379.096 414.678 8.2294 0.2006 re
+f*
+1 g
+387.325 414.678 0.8029 0.2006 re
+f*
+0.498 0 0.482 rg
+388.128 414.678 0.2007 0.2006 re
+f*
+1 g
+388.329 414.678 3.4123 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 414.678 8.4302 0.2006 re
+f*
+1 g
+400.171 414.678 3.4122 0.2006 re
+f*
+0.498 0 0.482 rg
+403.584 414.678 9.4339 0.2006 re
+f*
+1 g
+413.017 414.678 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+414.021 414.678 3.2114 0.2006 re
+f*
+0 g
+250.635 414.878 20.6741 0.2006 re
+f*
+1 g
+271.31 414.878 7.6273 0.2006 re
+f*
+0 g
+278.937 414.878 16.0575 0.2006 re
+f*
+1 g
+294.994 414.878 3.613 0.2006 re
+f*
+0 g
+298.607 414.878 10.6381 0.2006 re
+f*
+1 g
+309.245 414.878 6.6237 0.2006 re
+f*
+0 g
+315.869 414.878 17.4626 0.2006 re
+f*
+1 g
+333.332 414.878 3.0109 0.2006 re
+f*
+0 g
+336.343 414.878 8.2294 0.2006 re
+f*
+1 g
+344.572 414.878 1.0036 0.2006 re
+f*
+0 g
+345.576 414.878 6.2224 0.2006 re
+f*
+1 g
+351.798 414.878 4.6165 0.2006 re
+f*
+0.498 0 0.482 rg
+356.415 414.878 7.2259 0.2006 re
+f*
+1 g
+363.641 414.878 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 414.878 8.8317 0.2006 re
+f*
+1 g
+376.085 414.878 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+379.096 414.878 8.2294 0.2006 re
+f*
+1 g
+387.325 414.878 4.4159 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 414.878 8.4302 0.2006 re
+f*
+1 g
+400.171 414.878 3.2115 0.2006 re
+f*
+0.498 0 0.482 rg
+403.383 414.878 9.8352 0.2006 re
+f*
+1 g
+413.218 414.878 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+414.222 414.878 3.0108 0.2006 re
+f*
+0 g
+250.435 415.079 20.8749 0.2006 re
+f*
+1 g
+271.31 415.079 7.6273 0.2006 re
+f*
+0 g
+278.937 415.079 16.0575 0.2006 re
+f*
+1 g
+294.994 415.079 3.613 0.2006 re
+f*
+0 g
+298.607 415.079 10.6381 0.2006 re
+f*
+1 g
+309.245 415.079 6.4231 0.2006 re
+f*
+0 g
+315.669 415.079 17.4625 0.2006 re
+f*
+1 g
+333.131 415.079 3.0108 0.2006 re
+f*
+0 g
+336.142 415.079 8.631 0.2006 re
+f*
+1 g
+344.773 415.079 0.8028 0.2006 re
+f*
+0 g
+345.576 415.079 6.2224 0.2006 re
+f*
+1 g
+351.798 415.079 4.8172 0.2006 re
+f*
+0.498 0 0.482 rg
+356.615 415.079 7.0252 0.2006 re
+f*
+1 g
+363.641 415.079 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 415.079 8.8317 0.2006 re
+f*
+1 g
+376.085 415.079 2.8101 0.2006 re
+f*
+0.498 0 0.482 rg
+378.895 415.079 8.6309 0.2006 re
+f*
+1 g
+387.526 415.079 4.2151 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 415.079 8.2295 0.2006 re
+f*
+1 g
+399.971 415.079 3.4122 0.2006 re
+f*
+0.498 0 0.482 rg
+403.383 415.079 9.8352 0.2006 re
+f*
+1 g
+413.218 415.079 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+414.222 415.079 3.0108 0.2006 re
+f*
+0 g
+250.435 415.28 20.8749 0.2005 re
+f*
+1 g
+271.31 415.28 7.6273 0.2005 re
+f*
+0 g
+278.937 415.28 16.0575 0.2005 re
+f*
+1 g
+294.994 415.28 3.613 0.2005 re
+f*
+0 g
+298.607 415.28 10.6381 0.2005 re
+f*
+1 g
+309.245 415.28 6.4231 0.2005 re
+f*
+0 g
+315.669 415.28 17.2618 0.2005 re
+f*
+1 g
+332.93 415.28 3.0108 0.2005 re
+f*
+0 g
+335.941 415.28 15.8569 0.2005 re
+f*
+1 g
+351.798 415.28 5.0179 0.2005 re
+f*
+0.498 0 0.482 rg
+356.816 415.28 6.8245 0.2005 re
+f*
+1 g
+363.641 415.28 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 415.28 8.631 0.2005 re
+f*
+1 g
+375.884 415.28 3.0108 0.2005 re
+f*
+0.498 0 0.482 rg
+378.895 415.28 8.6309 0.2005 re
+f*
+1 g
+387.526 415.28 4.2151 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 415.28 8.0288 0.2005 re
+f*
+1 g
+399.77 415.28 3.4122 0.2005 re
+f*
+0.498 0 0.482 rg
+403.182 415.28 10.2367 0.2005 re
+f*
+1 g
+413.419 415.28 0.8028 0.2005 re
+f*
+0.498 0 0.482 rg
+414.222 415.28 3.2116 0.2005 re
+f*
+0 g
+250.435 415.48 20.8749 0.2006 re
+f*
+1 g
+271.31 415.48 7.6273 0.2006 re
+f*
+0 g
+278.937 415.48 16.0575 0.2006 re
+f*
+1 g
+294.994 415.48 3.613 0.2006 re
+f*
+0 g
+298.607 415.48 10.6381 0.2006 re
+f*
+1 g
+309.245 415.48 6.2223 0.2006 re
+f*
+0 g
+315.468 415.48 17.2619 0.2006 re
+f*
+1 g
+332.73 415.48 3.2115 0.2006 re
+f*
+0 g
+335.941 415.48 16.0575 0.2006 re
+f*
+1 g
+351.999 415.48 4.8173 0.2006 re
+f*
+0.498 0 0.482 rg
+356.816 415.48 6.8245 0.2006 re
+f*
+1 g
+363.641 415.48 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 415.48 8.4303 0.2006 re
+f*
+1 g
+375.684 415.48 3.2115 0.2006 re
+f*
+0.498 0 0.482 rg
+378.895 415.48 8.8316 0.2006 re
+f*
+1 g
+387.727 415.48 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 415.48 8.0288 0.2006 re
+f*
+1 g
+399.77 415.48 3.4122 0.2006 re
+f*
+0.498 0 0.482 rg
+403.182 415.48 10.2367 0.2006 re
+f*
+1 g
+413.419 415.48 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+414.422 415.48 3.0108 0.2006 re
+f*
+0 g
+250.435 415.681 20.8749 0.2005 re
+f*
+1 g
+271.31 415.681 7.6273 0.2005 re
+f*
+0 g
+278.937 415.681 16.0575 0.2005 re
+f*
+1 g
+294.994 415.681 3.613 0.2005 re
+f*
+0 g
+298.607 415.681 10.6381 0.2005 re
+f*
+1 g
+309.245 415.681 6.2223 0.2005 re
+f*
+0 g
+315.468 415.681 17.0612 0.2005 re
+f*
+1 g
+332.529 415.681 3.2115 0.2005 re
+f*
+0 g
+335.74 415.681 16.2582 0.2005 re
+f*
+1 g
+351.999 415.681 5.018 0.2005 re
+f*
+0.498 0 0.482 rg
+357.017 415.681 6.6238 0.2005 re
+f*
+1 g
+363.641 415.681 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 415.681 8.4303 0.2005 re
+f*
+1 g
+375.684 415.681 3.2115 0.2005 re
+f*
+0.498 0 0.482 rg
+378.895 415.681 8.8316 0.2005 re
+f*
+1 g
+387.727 415.681 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 415.681 7.828 0.2005 re
+f*
+1 g
+399.569 415.681 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+403.182 415.681 10.4374 0.2005 re
+f*
+1 g
+413.62 415.681 0.8029 0.2005 re
+f*
+0.498 0 0.482 rg
+414.422 415.681 3.0108 0.2005 re
+f*
+0 g
+250.435 415.881 20.8749 0.2006 re
+f*
+1 g
+271.31 415.881 7.6273 0.2006 re
+f*
+0 g
+278.937 415.881 16.0575 0.2006 re
+f*
+1 g
+294.994 415.881 3.613 0.2006 re
+f*
+0 g
+298.607 415.881 10.6381 0.2006 re
+f*
+1 g
+309.245 415.881 6.2223 0.2006 re
+f*
+0 g
+315.468 415.881 16.8604 0.2006 re
+f*
+1 g
+332.328 415.881 3.4123 0.2006 re
+f*
+0 g
+335.74 415.881 16.2582 0.2006 re
+f*
+1 g
+351.999 415.881 5.018 0.2006 re
+f*
+0.498 0 0.482 rg
+357.017 415.881 6.6238 0.2006 re
+f*
+1 g
+363.641 415.881 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 415.881 8.2295 0.2006 re
+f*
+1 g
+375.483 415.881 3.2116 0.2006 re
+f*
+0.498 0 0.482 rg
+378.695 415.881 9.0323 0.2006 re
+f*
+1 g
+387.727 415.881 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 415.881 7.828 0.2006 re
+f*
+1 g
+399.569 415.881 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+403.182 415.881 10.4374 0.2006 re
+f*
+1 g
+413.62 415.881 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+414.623 415.881 2.8101 0.2006 re
+f*
+0 g
+250.435 416.082 20.8749 0.2006 re
+f*
+1 g
+271.31 416.082 7.6273 0.2006 re
+f*
+0 g
+278.937 416.082 16.0575 0.2006 re
+f*
+1 g
+294.994 416.082 3.613 0.2006 re
+f*
+0 g
+298.607 416.082 10.6381 0.2006 re
+f*
+1 g
+309.245 416.082 6.2223 0.2006 re
+f*
+0 g
+315.468 416.082 16.8604 0.2006 re
+f*
+1 g
+332.328 416.082 3.2116 0.2006 re
+f*
+0 g
+335.54 416.082 16.4589 0.2006 re
+f*
+1 g
+351.999 416.082 5.2187 0.2006 re
+f*
+0.498 0 0.482 rg
+357.217 416.082 6.4231 0.2006 re
+f*
+1 g
+363.641 416.082 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 416.082 8.2295 0.2006 re
+f*
+1 g
+375.483 416.082 3.2116 0.2006 re
+f*
+0.498 0 0.482 rg
+378.695 416.082 9.0323 0.2006 re
+f*
+1 g
+387.727 416.082 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 416.082 7.6273 0.2006 re
+f*
+1 g
+399.368 416.082 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+402.981 416.082 10.6381 0.2006 re
+f*
+1 g
+413.62 416.082 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+414.623 416.082 2.8101 0.2006 re
+f*
+0 g
+250.435 416.282 20.8749 0.2005 re
+f*
+1 g
+271.31 416.282 7.6273 0.2005 re
+f*
+0 g
+278.937 416.282 16.0575 0.2005 re
+f*
+1 g
+294.994 416.282 3.613 0.2005 re
+f*
+0 g
+298.607 416.282 10.6381 0.2005 re
+f*
+1 g
+309.245 416.282 6.0216 0.2005 re
+f*
+0 g
+315.267 416.282 16.8604 0.2005 re
+f*
+1 g
+332.127 416.282 3.4123 0.2005 re
+f*
+0 g
+335.54 416.282 16.6597 0.2005 re
+f*
+1 g
+352.2 416.282 5.0179 0.2005 re
+f*
+0.498 0 0.482 rg
+357.217 416.282 6.4231 0.2005 re
+f*
+1 g
+363.641 416.282 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 416.282 8.0288 0.2005 re
+f*
+1 g
+375.282 416.282 3.4123 0.2005 re
+f*
+0.498 0 0.482 rg
+378.695 416.282 9.2331 0.2005 re
+f*
+1 g
+387.928 416.282 3.8136 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 416.282 7.6273 0.2005 re
+f*
+1 g
+399.368 416.282 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+402.981 416.282 10.8388 0.2005 re
+f*
+1 g
+413.82 416.282 0.8029 0.2005 re
+f*
+0.498 0 0.482 rg
+414.623 416.282 2.8101 0.2005 re
+f*
+0 g
+250.435 416.483 20.8749 0.2005 re
+f*
+1 g
+271.31 416.483 7.6273 0.2005 re
+f*
+0 g
+278.937 416.483 16.0575 0.2005 re
+f*
+1 g
+294.994 416.483 3.613 0.2005 re
+f*
+0 g
+298.607 416.483 10.6381 0.2005 re
+f*
+1 g
+309.245 416.483 6.0216 0.2005 re
+f*
+0 g
+315.267 416.483 16.6597 0.2005 re
+f*
+1 g
+331.927 416.483 3.613 0.2005 re
+f*
+0 g
+335.54 416.483 16.6597 0.2005 re
+f*
+1 g
+352.2 416.483 5.2187 0.2005 re
+f*
+0.498 0 0.482 rg
+357.418 416.483 6.2223 0.2005 re
+f*
+1 g
+363.641 416.483 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 416.483 8.0288 0.2005 re
+f*
+1 g
+375.282 416.483 3.4123 0.2005 re
+f*
+0.498 0 0.482 rg
+378.695 416.483 9.2331 0.2005 re
+f*
+1 g
+387.928 416.483 3.8136 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 416.483 7.4266 0.2005 re
+f*
+1 g
+399.168 416.483 3.8137 0.2005 re
+f*
+0.498 0 0.482 rg
+402.981 416.483 10.8388 0.2005 re
+f*
+1 g
+413.82 416.483 0.2008 0.2005 re
+f*
+0.498 0 0.482 rg
+414.021 416.483 3.4122 0.2005 re
+f*
+0 g
+250.435 416.683 20.8749 0.2006 re
+f*
+1 g
+271.31 416.683 7.6273 0.2006 re
+f*
+0 g
+278.937 416.683 16.0575 0.2006 re
+f*
+1 g
+294.994 416.683 3.613 0.2006 re
+f*
+0 g
+298.607 416.683 10.6381 0.2006 re
+f*
+1 g
+309.245 416.683 6.0216 0.2006 re
+f*
+0 g
+315.267 416.683 16.6597 0.2006 re
+f*
+1 g
+331.927 416.683 3.4123 0.2006 re
+f*
+0 g
+335.339 416.683 16.8604 0.2006 re
+f*
+1 g
+352.2 416.683 5.2187 0.2006 re
+f*
+0.498 0 0.482 rg
+357.418 416.683 6.2223 0.2006 re
+f*
+1 g
+363.641 416.683 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 416.683 7.8281 0.2006 re
+f*
+1 g
+375.081 416.683 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+378.695 416.683 9.2331 0.2006 re
+f*
+1 g
+387.928 416.683 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 416.683 7.4266 0.2006 re
+f*
+1 g
+399.168 416.683 3.8137 0.2006 re
+f*
+0.498 0 0.482 rg
+402.981 416.683 14.4518 0.2006 re
+f*
+0 g
+250.234 416.884 21.0756 0.2006 re
+f*
+1 g
+271.31 416.884 7.6273 0.2006 re
+f*
+0 g
+278.937 416.884 16.0575 0.2006 re
+f*
+1 g
+294.994 416.884 3.613 0.2006 re
+f*
+0 g
+298.607 416.884 10.6381 0.2006 re
+f*
+1 g
+309.245 416.884 6.0216 0.2006 re
+f*
+0 g
+315.267 416.884 16.459 0.2006 re
+f*
+1 g
+331.726 416.884 3.613 0.2006 re
+f*
+0 g
+335.339 416.884 16.8604 0.2006 re
+f*
+1 g
+352.2 416.884 5.4194 0.2006 re
+f*
+0.498 0 0.482 rg
+357.619 416.884 6.0216 0.2006 re
+f*
+1 g
+363.641 416.884 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 416.884 7.8281 0.2006 re
+f*
+1 g
+375.081 416.884 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+378.695 416.884 9.2331 0.2006 re
+f*
+1 g
+387.928 416.884 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 416.884 7.4266 0.2006 re
+f*
+1 g
+399.168 416.884 3.8137 0.2006 re
+f*
+0.498 0 0.482 rg
+402.981 416.884 14.4518 0.2006 re
+f*
+0 g
+250.234 417.085 14.2511 0.2005 re
+f*
+1 g
+264.485 417.085 25.8928 0.2005 re
+f*
+0 g
+290.378 417.085 4.6165 0.2005 re
+f*
+1 g
+294.994 417.085 3.613 0.2005 re
+f*
+0 g
+298.607 417.085 10.6381 0.2005 re
+f*
+1 g
+309.245 417.085 5.8209 0.2005 re
+f*
+0 g
+315.066 417.085 16.6597 0.2005 re
+f*
+1 g
+331.726 417.085 3.613 0.2005 re
+f*
+0 g
+335.339 417.085 17.0611 0.2005 re
+f*
+1 g
+352.4 417.085 5.2187 0.2005 re
+f*
+0.498 0 0.482 rg
+357.619 417.085 6.0216 0.2005 re
+f*
+1 g
+363.641 417.085 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 417.085 7.6274 0.2005 re
+f*
+1 g
+374.881 417.085 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+378.494 417.085 9.4339 0.2005 re
+f*
+1 g
+387.928 417.085 3.8136 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 417.085 7.2259 0.2005 re
+f*
+1 g
+398.967 417.085 3.8137 0.2005 re
+f*
+0.498 0 0.482 rg
+402.781 417.085 14.6525 0.2005 re
+f*
+0 g
+250.234 417.285 14.2511 0.2005 re
+f*
+1 g
+264.485 417.285 25.8928 0.2005 re
+f*
+0 g
+290.378 417.285 4.6165 0.2005 re
+f*
+1 g
+294.994 417.285 3.613 0.2005 re
+f*
+0 g
+298.607 417.285 10.6381 0.2005 re
+f*
+1 g
+309.245 417.285 5.8209 0.2005 re
+f*
+0 g
+315.066 417.285 16.459 0.2005 re
+f*
+1 g
+331.525 417.285 3.6129 0.2005 re
+f*
+0 g
+335.138 417.285 17.2619 0.2005 re
+f*
+1 g
+352.4 417.285 5.4194 0.2005 re
+f*
+0.498 0 0.482 rg
+357.82 417.285 5.8209 0.2005 re
+f*
+1 g
+363.641 417.285 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 417.285 7.6274 0.2005 re
+f*
+1 g
+374.881 417.285 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+378.494 417.285 9.6345 0.2005 re
+f*
+1 g
+388.128 417.285 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 417.285 7.2259 0.2005 re
+f*
+1 g
+398.967 417.285 3.8137 0.2005 re
+f*
+0.498 0 0.482 rg
+402.781 417.285 14.8532 0.2005 re
+f*
+0 g
+250.234 417.486 14.2511 0.2006 re
+f*
+1 g
+264.485 417.486 25.8928 0.2006 re
+f*
+0 g
+290.378 417.486 4.6165 0.2006 re
+f*
+1 g
+294.994 417.486 3.613 0.2006 re
+f*
+0 g
+298.607 417.486 10.6381 0.2006 re
+f*
+1 g
+309.245 417.486 5.8209 0.2006 re
+f*
+0 g
+315.066 417.486 16.459 0.2006 re
+f*
+1 g
+331.525 417.486 3.6129 0.2006 re
+f*
+0 g
+335.138 417.486 17.2619 0.2006 re
+f*
+1 g
+352.4 417.486 5.4194 0.2006 re
+f*
+0.498 0 0.482 rg
+357.82 417.486 5.8209 0.2006 re
+f*
+1 g
+363.641 417.486 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 417.486 7.6274 0.2006 re
+f*
+1 g
+374.881 417.486 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 417.486 9.6345 0.2006 re
+f*
+1 g
+388.128 417.486 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 417.486 7.2259 0.2006 re
+f*
+1 g
+398.967 417.486 3.8137 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 417.486 14.8532 0.2006 re
+f*
+0 g
+250.234 417.686 14.2511 0.2006 re
+f*
+1 g
+264.485 417.686 25.8928 0.2006 re
+f*
+0 g
+290.378 417.686 4.6165 0.2006 re
+f*
+1 g
+294.994 417.686 3.613 0.2006 re
+f*
+0 g
+298.607 417.686 10.6381 0.2006 re
+f*
+1 g
+309.245 417.686 5.8209 0.2006 re
+f*
+0 g
+315.066 417.686 16.2582 0.2006 re
+f*
+1 g
+331.325 417.686 3.8137 0.2006 re
+f*
+0 g
+335.138 417.686 17.2619 0.2006 re
+f*
+1 g
+352.4 417.686 5.6201 0.2006 re
+f*
+0.498 0 0.482 rg
+358.02 417.686 5.6202 0.2006 re
+f*
+1 g
+363.641 417.686 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 417.686 7.4267 0.2006 re
+f*
+1 g
+374.68 417.686 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 417.686 9.6345 0.2006 re
+f*
+1 g
+388.128 417.686 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 417.686 7.0252 0.2006 re
+f*
+1 g
+398.766 417.686 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 417.686 14.8532 0.2006 re
+f*
+0 g
+250.234 417.887 14.2511 0.2006 re
+f*
+1 g
+264.485 417.887 25.8928 0.2006 re
+f*
+0 g
+290.378 417.887 4.6165 0.2006 re
+f*
+1 g
+294.994 417.887 3.613 0.2006 re
+f*
+0 g
+298.607 417.887 10.6381 0.2006 re
+f*
+1 g
+309.245 417.887 5.6201 0.2006 re
+f*
+0 g
+314.866 417.887 16.459 0.2006 re
+f*
+1 g
+331.325 417.887 3.8137 0.2006 re
+f*
+0 g
+335.138 417.887 17.2619 0.2006 re
+f*
+1 g
+352.4 417.887 5.6201 0.2006 re
+f*
+0.498 0 0.482 rg
+358.02 417.887 5.6202 0.2006 re
+f*
+1 g
+363.641 417.887 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 417.887 7.4267 0.2006 re
+f*
+1 g
+374.68 417.887 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 417.887 9.6345 0.2006 re
+f*
+1 g
+388.128 417.887 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 417.887 7.0252 0.2006 re
+f*
+1 g
+398.766 417.887 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 417.887 14.8532 0.2006 re
+f*
+0 g
+250.234 418.087 14.2511 0.2006 re
+f*
+1 g
+264.485 418.087 25.8928 0.2006 re
+f*
+0 g
+290.378 418.087 4.6165 0.2006 re
+f*
+1 g
+294.994 418.087 3.613 0.2006 re
+f*
+0 g
+298.607 418.087 10.6381 0.2006 re
+f*
+1 g
+309.245 418.087 5.6201 0.2006 re
+f*
+0 g
+314.866 418.087 16.459 0.2006 re
+f*
+1 g
+331.325 418.087 3.8137 0.2006 re
+f*
+0 g
+335.138 418.087 17.4626 0.2006 re
+f*
+1 g
+352.601 418.087 5.6201 0.2006 re
+f*
+0.498 0 0.482 rg
+358.221 418.087 5.4195 0.2006 re
+f*
+1 g
+363.641 418.087 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 418.087 7.4267 0.2006 re
+f*
+1 g
+374.68 418.087 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 418.087 9.6345 0.2006 re
+f*
+1 g
+388.128 418.087 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 418.087 7.0252 0.2006 re
+f*
+1 g
+398.766 418.087 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 418.087 14.8532 0.2006 re
+f*
+0 g
+250.234 418.288 14.2511 0.2005 re
+f*
+1 g
+264.485 418.288 25.8928 0.2005 re
+f*
+0 g
+290.378 418.288 4.6165 0.2005 re
+f*
+1 g
+294.994 418.288 3.613 0.2005 re
+f*
+0 g
+298.607 418.288 10.6381 0.2005 re
+f*
+1 g
+309.245 418.288 5.6201 0.2005 re
+f*
+0 g
+314.866 418.288 16.2583 0.2005 re
+f*
+1 g
+331.124 418.288 4.0144 0.2005 re
+f*
+0 g
+335.138 418.288 17.4626 0.2005 re
+f*
+1 g
+352.601 418.288 5.6201 0.2005 re
+f*
+0.498 0 0.482 rg
+358.221 418.288 5.4195 0.2005 re
+f*
+1 g
+363.641 418.288 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 418.288 7.2259 0.2005 re
+f*
+1 g
+374.479 418.288 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+378.494 418.288 9.6345 0.2005 re
+f*
+1 g
+388.128 418.288 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 418.288 7.0252 0.2005 re
+f*
+1 g
+398.766 418.288 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+402.781 418.288 14.8532 0.2005 re
+f*
+0 g
+250.234 418.489 14.2511 0.2005 re
+f*
+1 g
+264.485 418.489 25.8928 0.2005 re
+f*
+0 g
+290.378 418.489 4.6165 0.2005 re
+f*
+1 g
+294.994 418.489 3.613 0.2005 re
+f*
+0 g
+298.607 418.489 10.8389 0.2005 re
+f*
+1 g
+309.446 418.489 5.4193 0.2005 re
+f*
+0 g
+314.866 418.489 16.2583 0.2005 re
+f*
+1 g
+331.124 418.489 3.8137 0.2005 re
+f*
+0 g
+334.938 418.489 17.6633 0.2005 re
+f*
+1 g
+352.601 418.489 5.6201 0.2005 re
+f*
+0.498 0 0.482 rg
+358.221 418.489 5.4195 0.2005 re
+f*
+1 g
+363.641 418.489 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 418.489 7.2259 0.2005 re
+f*
+1 g
+374.479 418.489 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+378.494 418.489 9.6345 0.2005 re
+f*
+1 g
+388.128 418.489 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 418.489 7.0252 0.2005 re
+f*
+1 g
+398.766 418.489 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+402.781 418.489 14.8532 0.2005 re
+f*
+0 g
+250.234 418.689 14.2511 0.2006 re
+f*
+1 g
+264.485 418.689 25.8928 0.2006 re
+f*
+0 g
+290.378 418.689 4.6165 0.2006 re
+f*
+1 g
+294.994 418.689 3.613 0.2006 re
+f*
+0 g
+298.607 418.689 10.8389 0.2006 re
+f*
+1 g
+309.446 418.689 5.4193 0.2006 re
+f*
+0 g
+314.866 418.689 16.2583 0.2006 re
+f*
+1 g
+331.124 418.689 3.8137 0.2006 re
+f*
+0 g
+334.938 418.689 17.6633 0.2006 re
+f*
+1 g
+352.601 418.689 5.8209 0.2006 re
+f*
+0.498 0 0.482 rg
+358.422 418.689 5.2187 0.2006 re
+f*
+1 g
+363.641 418.689 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 418.689 7.2259 0.2006 re
+f*
+1 g
+374.479 418.689 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 418.689 9.6345 0.2006 re
+f*
+1 g
+388.128 418.689 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 418.689 6.8244 0.2006 re
+f*
+1 g
+398.566 418.689 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 418.689 14.8532 0.2006 re
+f*
+0 g
+250.234 418.89 14.2511 0.2006 re
+f*
+1 g
+264.485 418.89 25.8928 0.2006 re
+f*
+0 g
+290.378 418.89 4.6165 0.2006 re
+f*
+1 g
+294.994 418.89 3.613 0.2006 re
+f*
+0 g
+298.607 418.89 10.8389 0.2006 re
+f*
+1 g
+309.446 418.89 5.4193 0.2006 re
+f*
+0 g
+314.866 418.89 16.0576 0.2006 re
+f*
+1 g
+330.923 418.89 4.0144 0.2006 re
+f*
+0 g
+334.938 418.89 17.6633 0.2006 re
+f*
+1 g
+352.601 418.89 5.8209 0.2006 re
+f*
+0.498 0 0.482 rg
+358.422 418.89 5.2187 0.2006 re
+f*
+1 g
+363.641 418.89 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 418.89 7.2259 0.2006 re
+f*
+1 g
+374.479 418.89 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 418.89 9.6345 0.2006 re
+f*
+1 g
+388.128 418.89 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 418.89 6.8244 0.2006 re
+f*
+1 g
+398.566 418.89 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 418.89 14.8532 0.2006 re
+f*
+0 g
+250.234 419.09 14.2511 0.2005 re
+f*
+1 g
+264.485 419.09 25.8928 0.2005 re
+f*
+0 g
+290.378 419.09 4.6165 0.2005 re
+f*
+1 g
+294.994 419.09 3.613 0.2005 re
+f*
+0 g
+298.607 419.09 10.8389 0.2005 re
+f*
+1 g
+309.446 419.09 5.4193 0.2005 re
+f*
+0 g
+314.866 419.09 16.0576 0.2005 re
+f*
+1 g
+330.923 419.09 4.0144 0.2005 re
+f*
+0 g
+334.938 419.09 17.6633 0.2005 re
+f*
+1 g
+352.601 419.09 5.8209 0.2005 re
+f*
+0.498 0 0.482 rg
+358.422 419.09 5.2187 0.2005 re
+f*
+1 g
+363.641 419.09 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 419.09 7.2259 0.2005 re
+f*
+1 g
+374.479 419.09 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+378.494 419.09 9.6345 0.2005 re
+f*
+1 g
+388.128 419.09 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 419.09 6.8244 0.2005 re
+f*
+1 g
+398.566 419.09 4.2152 0.2005 re
+f*
+0.498 0 0.482 rg
+402.781 419.09 14.8532 0.2005 re
+f*
+0 g
+250.234 419.291 14.2511 0.2006 re
+f*
+1 g
+264.485 419.291 25.8928 0.2006 re
+f*
+0 g
+290.378 419.291 4.6165 0.2006 re
+f*
+1 g
+294.994 419.291 3.613 0.2006 re
+f*
+0 g
+298.607 419.291 10.8389 0.2006 re
+f*
+1 g
+309.446 419.291 5.4193 0.2006 re
+f*
+0 g
+314.866 419.291 16.0576 0.2006 re
+f*
+1 g
+330.923 419.291 4.0144 0.2006 re
+f*
+0 g
+334.938 419.291 17.6633 0.2006 re
+f*
+1 g
+352.601 419.291 6.0216 0.2006 re
+f*
+0.498 0 0.482 rg
+358.623 419.291 5.018 0.2006 re
+f*
+1 g
+363.641 419.291 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 419.291 7.0252 0.2006 re
+f*
+1 g
+374.279 419.291 4.2151 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 419.291 9.6345 0.2006 re
+f*
+1 g
+388.128 419.291 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 419.291 6.8244 0.2006 re
+f*
+1 g
+398.566 419.291 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 419.291 14.8532 0.2006 re
+f*
+0 g
+250.234 419.491 14.2511 0.2005 re
+f*
+1 g
+264.485 419.491 25.8928 0.2005 re
+f*
+0 g
+290.378 419.491 4.6165 0.2005 re
+f*
+1 g
+294.994 419.491 3.613 0.2005 re
+f*
+0 g
+298.607 419.491 10.8389 0.2005 re
+f*
+1 g
+309.446 419.491 5.2187 0.2005 re
+f*
+0 g
+314.665 419.491 16.2582 0.2005 re
+f*
+1 g
+330.923 419.491 4.0144 0.2005 re
+f*
+0 g
+334.938 419.491 17.6633 0.2005 re
+f*
+1 g
+352.601 419.491 6.0216 0.2005 re
+f*
+0.498 0 0.482 rg
+358.623 419.491 5.018 0.2005 re
+f*
+1 g
+363.641 419.491 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 419.491 7.0252 0.2005 re
+f*
+1 g
+374.279 419.491 4.2151 0.2005 re
+f*
+0.498 0 0.482 rg
+378.494 419.491 9.6345 0.2005 re
+f*
+1 g
+388.128 419.491 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 419.491 6.8244 0.2005 re
+f*
+1 g
+398.566 419.491 4.2152 0.2005 re
+f*
+0.498 0 0.482 rg
+402.781 419.491 14.8532 0.2005 re
+f*
+0 g
+250.234 419.692 14.2511 0.2006 re
+f*
+1 g
+264.485 419.692 25.8928 0.2006 re
+f*
+0 g
+290.378 419.692 4.6165 0.2006 re
+f*
+1 g
+294.994 419.692 3.613 0.2006 re
+f*
+0 g
+298.607 419.692 10.8389 0.2006 re
+f*
+1 g
+309.446 419.692 5.2187 0.2006 re
+f*
+0 g
+314.665 419.692 16.2582 0.2006 re
+f*
+1 g
+330.923 419.692 4.0144 0.2006 re
+f*
+0 g
+334.938 419.692 17.6633 0.2006 re
+f*
+1 g
+352.601 419.692 6.0216 0.2006 re
+f*
+0.498 0 0.482 rg
+358.623 419.692 5.018 0.2006 re
+f*
+1 g
+363.641 419.692 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 419.692 7.0252 0.2006 re
+f*
+1 g
+374.279 419.692 4.2151 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 419.692 9.6345 0.2006 re
+f*
+1 g
+388.128 419.692 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 419.692 6.8244 0.2006 re
+f*
+1 g
+398.566 419.692 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 419.692 14.8532 0.2006 re
+f*
+0 g
+250.234 419.892 14.2511 0.2005 re
+f*
+1 g
+264.485 419.892 6.6237 0.2005 re
+f*
+0 g
+271.109 419.892 0.2008 0.2005 re
+f*
+1 g
+271.31 419.892 7.6273 0.2005 re
+f*
+0 g
+278.937 419.892 0.2007 0.2005 re
+f*
+1 g
+279.138 419.892 11.2403 0.2005 re
+f*
+0 g
+290.378 419.892 4.6165 0.2005 re
+f*
+1 g
+294.994 419.892 3.613 0.2005 re
+f*
+0 g
+298.607 419.892 10.8389 0.2005 re
+f*
+1 g
+309.446 419.892 5.2187 0.2005 re
+f*
+0 g
+314.665 419.892 16.0575 0.2005 re
+f*
+1 g
+330.722 419.892 4.2151 0.2005 re
+f*
+0 g
+334.938 419.892 17.6633 0.2005 re
+f*
+1 g
+352.601 419.892 6.2223 0.2005 re
+f*
+0.498 0 0.482 rg
+358.823 419.892 4.8173 0.2005 re
+f*
+1 g
+363.641 419.892 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 419.892 7.0252 0.2005 re
+f*
+1 g
+374.279 419.892 4.2151 0.2005 re
+f*
+0.498 0 0.482 rg
+378.494 419.892 9.6345 0.2005 re
+f*
+1 g
+388.128 419.892 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 419.892 6.8244 0.2005 re
+f*
+1 g
+398.566 419.892 4.2152 0.2005 re
+f*
+0.498 0 0.482 rg
+402.781 419.892 14.8532 0.2005 re
+f*
+0 g
+250.234 420.093 21.0756 0.2006 re
+f*
+1 g
+271.31 420.093 7.6273 0.2006 re
+f*
+0 g
+278.937 420.093 16.0575 0.2006 re
+f*
+1 g
+294.994 420.093 3.613 0.2006 re
+f*
+0 g
+298.607 420.093 11.0396 0.2006 re
+f*
+1 g
+309.647 420.093 5.018 0.2006 re
+f*
+0 g
+314.665 420.093 16.0575 0.2006 re
+f*
+1 g
+330.722 420.093 4.2151 0.2006 re
+f*
+0 g
+334.938 420.093 17.6633 0.2006 re
+f*
+1 g
+352.601 420.093 6.2223 0.2006 re
+f*
+0.498 0 0.482 rg
+358.823 420.093 4.8173 0.2006 re
+f*
+1 g
+363.641 420.093 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 420.093 7.0252 0.2006 re
+f*
+1 g
+374.279 420.093 4.2151 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 420.093 9.6345 0.2006 re
+f*
+1 g
+388.128 420.093 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 420.093 6.8244 0.2006 re
+f*
+1 g
+398.566 420.093 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 420.093 14.8532 0.2006 re
+f*
+0 g
+250.234 420.294 21.0756 0.2005 re
+f*
+1 g
+271.31 420.294 7.6273 0.2005 re
+f*
+0 g
+278.937 420.294 16.0575 0.2005 re
+f*
+1 g
+294.994 420.294 3.613 0.2005 re
+f*
+0 g
+298.607 420.294 11.0396 0.2005 re
+f*
+1 g
+309.647 420.294 5.018 0.2005 re
+f*
+0 g
+314.665 420.294 16.0575 0.2005 re
+f*
+1 g
+330.722 420.294 4.2151 0.2005 re
+f*
+0 g
+334.938 420.294 17.8641 0.2005 re
+f*
+1 g
+352.802 420.294 6.0215 0.2005 re
+f*
+0.498 0 0.482 rg
+358.823 420.294 4.8173 0.2005 re
+f*
+1 g
+363.641 420.294 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 420.294 7.0252 0.2005 re
+f*
+1 g
+374.279 420.294 4.2151 0.2005 re
+f*
+0.498 0 0.482 rg
+378.494 420.294 9.6345 0.2005 re
+f*
+1 g
+388.128 420.294 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 420.294 6.8244 0.2005 re
+f*
+1 g
+398.566 420.294 4.2152 0.2005 re
+f*
+0.498 0 0.482 rg
+402.781 420.294 14.8532 0.2005 re
+f*
+0 g
+250.234 420.494 21.0756 0.2006 re
+f*
+1 g
+271.31 420.494 7.6273 0.2006 re
+f*
+0 g
+278.937 420.494 16.0575 0.2006 re
+f*
+1 g
+294.994 420.494 3.613 0.2006 re
+f*
+0 g
+298.607 420.494 11.0396 0.2006 re
+f*
+1 g
+309.647 420.494 5.018 0.2006 re
+f*
+0 g
+314.665 420.494 16.0575 0.2006 re
+f*
+1 g
+330.722 420.494 4.2151 0.2006 re
+f*
+0 g
+334.938 420.494 17.8641 0.2006 re
+f*
+1 g
+352.802 420.494 6.0215 0.2006 re
+f*
+0.498 0 0.482 rg
+358.823 420.494 4.8173 0.2006 re
+f*
+1 g
+363.641 420.494 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 420.494 7.0252 0.2006 re
+f*
+1 g
+374.279 420.494 4.2151 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 420.494 9.6345 0.2006 re
+f*
+1 g
+388.128 420.494 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 420.494 6.8244 0.2006 re
+f*
+1 g
+398.566 420.494 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 420.494 14.8532 0.2006 re
+f*
+0 g
+250.234 420.695 21.0756 0.2006 re
+f*
+1 g
+271.31 420.695 7.6273 0.2006 re
+f*
+0 g
+278.937 420.695 16.0575 0.2006 re
+f*
+1 g
+294.994 420.695 3.613 0.2006 re
+f*
+0 g
+298.607 420.695 11.0396 0.2006 re
+f*
+1 g
+309.647 420.695 5.018 0.2006 re
+f*
+0 g
+314.665 420.695 16.0575 0.2006 re
+f*
+1 g
+330.722 420.695 4.2151 0.2006 re
+f*
+0 g
+334.938 420.695 17.8641 0.2006 re
+f*
+1 g
+352.802 420.695 6.2222 0.2006 re
+f*
+0.498 0 0.482 rg
+359.024 420.695 4.6166 0.2006 re
+f*
+1 g
+363.641 420.695 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 420.695 7.0252 0.2006 re
+f*
+1 g
+374.279 420.695 4.2151 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 420.695 9.6345 0.2006 re
+f*
+1 g
+388.128 420.695 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 420.695 6.8244 0.2006 re
+f*
+1 g
+398.566 420.695 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 420.695 14.8532 0.2006 re
+f*
+0 g
+250.234 420.895 21.0756 0.2006 re
+f*
+1 g
+271.31 420.895 7.6273 0.2006 re
+f*
+0 g
+278.937 420.895 16.0575 0.2006 re
+f*
+1 g
+294.994 420.895 3.613 0.2006 re
+f*
+0 g
+298.607 420.895 11.0396 0.2006 re
+f*
+1 g
+309.647 420.895 5.018 0.2006 re
+f*
+0 g
+314.665 420.895 16.0575 0.2006 re
+f*
+1 g
+330.722 420.895 4.2151 0.2006 re
+f*
+0 g
+334.938 420.895 17.8641 0.2006 re
+f*
+1 g
+352.802 420.895 6.2222 0.2006 re
+f*
+0.498 0 0.482 rg
+359.024 420.895 4.6166 0.2006 re
+f*
+1 g
+363.641 420.895 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 420.895 7.0252 0.2006 re
+f*
+1 g
+374.279 420.895 4.2151 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 420.895 9.6345 0.2006 re
+f*
+1 g
+388.128 420.895 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 420.895 6.8244 0.2006 re
+f*
+1 g
+398.566 420.895 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 420.895 14.8532 0.2006 re
+f*
+0 g
+250.234 421.096 21.0756 0.2005 re
+f*
+1 g
+271.31 421.096 7.6273 0.2005 re
+f*
+0 g
+278.937 421.096 16.0575 0.2005 re
+f*
+1 g
+294.994 421.096 3.613 0.2005 re
+f*
+0 g
+298.607 421.096 11.2403 0.2005 re
+f*
+1 g
+309.848 421.096 4.8173 0.2005 re
+f*
+0 g
+314.665 421.096 16.0575 0.2005 re
+f*
+1 g
+330.722 421.096 4.2151 0.2005 re
+f*
+0 g
+334.938 421.096 17.8641 0.2005 re
+f*
+1 g
+352.802 421.096 6.2222 0.2005 re
+f*
+0.498 0 0.482 rg
+359.024 421.096 4.6166 0.2005 re
+f*
+1 g
+363.641 421.096 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 421.096 7.0252 0.2005 re
+f*
+1 g
+374.279 421.096 4.2151 0.2005 re
+f*
+0.498 0 0.482 rg
+378.494 421.096 9.6345 0.2005 re
+f*
+1 g
+388.128 421.096 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 421.096 6.8244 0.2005 re
+f*
+1 g
+398.566 421.096 4.2152 0.2005 re
+f*
+0.498 0 0.482 rg
+402.781 421.096 14.8532 0.2005 re
+f*
+0 g
+250.234 421.296 21.0756 0.2005 re
+f*
+1 g
+271.31 421.296 7.6273 0.2005 re
+f*
+0 g
+278.937 421.296 16.0575 0.2005 re
+f*
+1 g
+294.994 421.296 3.613 0.2005 re
+f*
+0 g
+298.607 421.296 11.2403 0.2005 re
+f*
+1 g
+309.848 421.296 4.8173 0.2005 re
+f*
+0 g
+314.665 421.296 16.0575 0.2005 re
+f*
+1 g
+330.722 421.296 4.2151 0.2005 re
+f*
+0 g
+334.938 421.296 17.6633 0.2005 re
+f*
+1 g
+352.601 421.296 6.423 0.2005 re
+f*
+0.498 0 0.482 rg
+359.024 421.296 4.6166 0.2005 re
+f*
+1 g
+363.641 421.296 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 421.296 7.0252 0.2005 re
+f*
+1 g
+374.279 421.296 4.2151 0.2005 re
+f*
+0.498 0 0.482 rg
+378.494 421.296 9.6345 0.2005 re
+f*
+1 g
+388.128 421.296 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 421.296 6.8244 0.2005 re
+f*
+1 g
+398.566 421.296 4.2152 0.2005 re
+f*
+0.498 0 0.482 rg
+402.781 421.296 14.8532 0.2005 re
+f*
+0 g
+250.234 421.497 21.0756 0.2006 re
+f*
+1 g
+271.31 421.497 7.6273 0.2006 re
+f*
+0 g
+278.937 421.497 16.0575 0.2006 re
+f*
+1 g
+294.994 421.497 3.613 0.2006 re
+f*
+0 g
+298.607 421.497 11.2403 0.2006 re
+f*
+1 g
+309.848 421.497 4.8173 0.2006 re
+f*
+0 g
+314.665 421.497 16.0575 0.2006 re
+f*
+1 g
+330.722 421.497 4.2151 0.2006 re
+f*
+0 g
+334.938 421.497 17.6633 0.2006 re
+f*
+1 g
+352.601 421.497 6.6237 0.2006 re
+f*
+0.498 0 0.482 rg
+359.225 421.497 4.4159 0.2006 re
+f*
+1 g
+363.641 421.497 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 421.497 7.0252 0.2006 re
+f*
+1 g
+374.279 421.497 4.2151 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 421.497 9.6345 0.2006 re
+f*
+1 g
+388.128 421.497 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 421.497 6.8244 0.2006 re
+f*
+1 g
+398.566 421.497 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 421.497 14.8532 0.2006 re
+f*
+0 g
+250.234 421.697 21.0756 0.2006 re
+f*
+1 g
+271.31 421.697 7.6273 0.2006 re
+f*
+0 g
+278.937 421.697 16.0575 0.2006 re
+f*
+1 g
+294.994 421.697 3.613 0.2006 re
+f*
+0 g
+298.607 421.697 11.2403 0.2006 re
+f*
+1 g
+309.848 421.697 4.8173 0.2006 re
+f*
+0 g
+314.665 421.697 16.0575 0.2006 re
+f*
+1 g
+330.722 421.697 4.2151 0.2006 re
+f*
+0 g
+334.938 421.697 17.6633 0.2006 re
+f*
+1 g
+352.601 421.697 6.6237 0.2006 re
+f*
+0.498 0 0.482 rg
+359.225 421.697 4.4159 0.2006 re
+f*
+1 g
+363.641 421.697 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 421.697 7.0252 0.2006 re
+f*
+1 g
+374.279 421.697 4.2151 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 421.697 9.6345 0.2006 re
+f*
+1 g
+388.128 421.697 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 421.697 6.8244 0.2006 re
+f*
+1 g
+398.566 421.697 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 421.697 12.0431 0.2006 re
+f*
+1 g
+414.824 421.697 0.2008 0.2006 re
+f*
+0.498 0 0.482 rg
+415.025 421.697 2.6093 0.2006 re
+f*
+0 g
+250.234 421.898 21.0756 0.2005 re
+f*
+1 g
+271.31 421.898 7.6273 0.2005 re
+f*
+0 g
+278.937 421.898 16.0575 0.2005 re
+f*
+1 g
+294.994 421.898 3.613 0.2005 re
+f*
+0 g
+298.607 421.898 11.441 0.2005 re
+f*
+1 g
+310.048 421.898 4.6166 0.2005 re
+f*
+0 g
+314.665 421.898 16.0575 0.2005 re
+f*
+1 g
+330.722 421.898 4.2151 0.2005 re
+f*
+0 g
+334.938 421.898 17.6633 0.2005 re
+f*
+1 g
+352.601 421.898 6.6237 0.2005 re
+f*
+0.498 0 0.482 rg
+359.225 421.898 4.4159 0.2005 re
+f*
+1 g
+363.641 421.898 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 421.898 7.2259 0.2005 re
+f*
+1 g
+374.479 421.898 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+378.494 421.898 9.6345 0.2005 re
+f*
+1 g
+388.128 421.898 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 421.898 6.8244 0.2005 re
+f*
+1 g
+398.566 421.898 16.4591 0.2005 re
+f*
+0.498 0 0.482 rg
+415.025 421.898 2.6093 0.2005 re
+f*
+0 g
+250.234 422.099 21.0756 0.2006 re
+f*
+1 g
+271.31 422.099 7.6273 0.2006 re
+f*
+0 g
+278.937 422.099 16.0575 0.2006 re
+f*
+1 g
+294.994 422.099 3.613 0.2006 re
+f*
+0 g
+298.607 422.099 11.441 0.2006 re
+f*
+1 g
+310.048 422.099 4.6166 0.2006 re
+f*
+0 g
+314.665 422.099 16.0575 0.2006 re
+f*
+1 g
+330.722 422.099 4.2151 0.2006 re
+f*
+0 g
+334.938 422.099 17.6633 0.2006 re
+f*
+1 g
+352.601 422.099 6.6237 0.2006 re
+f*
+0.498 0 0.482 rg
+359.225 422.099 4.4159 0.2006 re
+f*
+1 g
+363.641 422.099 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 422.099 7.2259 0.2006 re
+f*
+1 g
+374.479 422.099 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 422.099 9.6345 0.2006 re
+f*
+1 g
+388.128 422.099 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 422.099 7.0252 0.2006 re
+f*
+1 g
+398.766 422.099 16.2583 0.2006 re
+f*
+0.498 0 0.482 rg
+415.025 422.099 2.6093 0.2006 re
+f*
+0 g
+250.234 422.299 21.0756 0.2005 re
+f*
+1 g
+271.31 422.299 7.6273 0.2005 re
+f*
+0 g
+278.937 422.299 16.0575 0.2005 re
+f*
+1 g
+294.994 422.299 3.613 0.2005 re
+f*
+0 g
+298.607 422.299 11.441 0.2005 re
+f*
+1 g
+310.048 422.299 4.6166 0.2005 re
+f*
+0 g
+314.665 422.299 16.0575 0.2005 re
+f*
+1 g
+330.722 422.299 4.2151 0.2005 re
+f*
+0 g
+334.938 422.299 17.6633 0.2005 re
+f*
+1 g
+352.601 422.299 6.8245 0.2005 re
+f*
+0.498 0 0.482 rg
+359.425 422.299 4.2151 0.2005 re
+f*
+1 g
+363.641 422.299 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 422.299 7.2259 0.2005 re
+f*
+1 g
+374.479 422.299 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+378.494 422.299 9.6345 0.2005 re
+f*
+1 g
+388.128 422.299 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 422.299 7.0252 0.2005 re
+f*
+1 g
+398.766 422.299 16.2583 0.2005 re
+f*
+0.498 0 0.482 rg
+415.025 422.299 2.4086 0.2005 re
+f*
+0 g
+250.234 422.5 21.0756 0.2006 re
+f*
+1 g
+271.31 422.5 7.6273 0.2006 re
+f*
+0 g
+278.937 422.5 16.0575 0.2006 re
+f*
+1 g
+294.994 422.5 3.613 0.2006 re
+f*
+0 g
+298.607 422.5 11.441 0.2006 re
+f*
+1 g
+310.048 422.5 4.6166 0.2006 re
+f*
+0 g
+314.665 422.5 16.0575 0.2006 re
+f*
+1 g
+330.722 422.5 4.2151 0.2006 re
+f*
+0 g
+334.938 422.5 17.6633 0.2006 re
+f*
+1 g
+352.601 422.5 6.8245 0.2006 re
+f*
+0.498 0 0.482 rg
+359.425 422.5 4.2151 0.2006 re
+f*
+1 g
+363.641 422.5 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 422.5 7.2259 0.2006 re
+f*
+1 g
+374.479 422.5 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 422.5 9.6345 0.2006 re
+f*
+1 g
+388.128 422.5 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 422.5 7.0252 0.2006 re
+f*
+1 g
+398.766 422.5 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 422.5 8.0287 0.2006 re
+f*
+1 g
+410.81 422.5 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+415.025 422.5 2.4086 0.2006 re
+f*
+0 g
+250.234 422.7 21.0756 0.2006 re
+f*
+1 g
+271.31 422.7 7.6273 0.2006 re
+f*
+0 g
+278.937 422.7 16.0575 0.2006 re
+f*
+1 g
+294.994 422.7 3.613 0.2006 re
+f*
+0 g
+298.607 422.7 11.6417 0.2006 re
+f*
+1 g
+310.249 422.7 4.4159 0.2006 re
+f*
+0 g
+314.665 422.7 16.0575 0.2006 re
+f*
+1 g
+330.722 422.7 4.2151 0.2006 re
+f*
+0 g
+334.938 422.7 17.6633 0.2006 re
+f*
+1 g
+352.601 422.7 6.8245 0.2006 re
+f*
+0.498 0 0.482 rg
+359.425 422.7 4.2151 0.2006 re
+f*
+1 g
+363.641 422.7 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 422.7 7.2259 0.2006 re
+f*
+1 g
+374.479 422.7 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 422.7 9.6345 0.2006 re
+f*
+1 g
+388.128 422.7 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 422.7 7.0252 0.2006 re
+f*
+1 g
+398.766 422.7 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 422.7 8.0287 0.2006 re
+f*
+1 g
+410.81 422.7 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+415.025 422.7 2.4086 0.2006 re
+f*
+0 g
+250.435 422.901 20.8749 0.2005 re
+f*
+1 g
+271.31 422.901 7.6273 0.2005 re
+f*
+0 g
+278.937 422.901 16.0575 0.2005 re
+f*
+1 g
+294.994 422.901 3.613 0.2005 re
+f*
+0 g
+298.607 422.901 11.6417 0.2005 re
+f*
+1 g
+310.249 422.901 16.6597 0.2005 re
+f*
+0 g
+326.909 422.901 4.0144 0.2005 re
+f*
+1 g
+330.923 422.901 4.0144 0.2005 re
+f*
+0 g
+334.938 422.901 12.0431 0.2005 re
+f*
+1 g
+346.981 422.901 0.2008 0.2005 re
+f*
+0 g
+347.181 422.901 5.4194 0.2005 re
+f*
+1 g
+352.601 422.901 6.8245 0.2005 re
+f*
+0.498 0 0.482 rg
+359.425 422.901 4.2151 0.2005 re
+f*
+1 g
+363.641 422.901 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 422.901 7.4267 0.2005 re
+f*
+1 g
+374.68 422.901 3.8136 0.2005 re
+f*
+0.498 0 0.482 rg
+378.494 422.901 9.6345 0.2005 re
+f*
+1 g
+388.128 422.901 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 422.901 7.2259 0.2005 re
+f*
+1 g
+398.967 422.901 3.8137 0.2005 re
+f*
+0.498 0 0.482 rg
+402.781 422.901 8.0287 0.2005 re
+f*
+1 g
+410.81 422.901 4.2152 0.2005 re
+f*
+0.498 0 0.482 rg
+415.025 422.901 2.4086 0.2005 re
+f*
+0 g
+250.435 423.101 20.8749 0.2006 re
+f*
+1 g
+271.31 423.101 7.6273 0.2006 re
+f*
+0 g
+278.937 423.101 16.0575 0.2006 re
+f*
+1 g
+294.994 423.101 3.613 0.2006 re
+f*
+0 g
+298.607 423.101 11.6417 0.2006 re
+f*
+1 g
+310.249 423.101 16.6597 0.2006 re
+f*
+0 g
+326.909 423.101 4.0144 0.2006 re
+f*
+1 g
+330.923 423.101 16.2583 0.2006 re
+f*
+0 g
+347.181 423.101 5.4194 0.2006 re
+f*
+1 g
+352.601 423.101 6.8245 0.2006 re
+f*
+0.498 0 0.482 rg
+359.425 423.101 4.2151 0.2006 re
+f*
+1 g
+363.641 423.101 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 423.101 7.4267 0.2006 re
+f*
+1 g
+374.68 423.101 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 423.101 9.6345 0.2006 re
+f*
+1 g
+388.128 423.101 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 423.101 7.2259 0.2006 re
+f*
+1 g
+398.967 423.101 3.8137 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 423.101 8.0287 0.2006 re
+f*
+1 g
+410.81 423.101 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+414.824 423.101 2.6094 0.2006 re
+f*
+0 g
+250.435 423.302 20.8749 0.2005 re
+f*
+1 g
+271.31 423.302 7.6273 0.2005 re
+f*
+0 g
+278.937 423.302 16.0575 0.2005 re
+f*
+1 g
+294.994 423.302 3.613 0.2005 re
+f*
+0 g
+298.607 423.302 11.8425 0.2005 re
+f*
+1 g
+310.45 423.302 4.2151 0.2005 re
+f*
+0 g
+314.665 423.302 8.4302 0.2005 re
+f*
+1 g
+323.095 423.302 3.8136 0.2005 re
+f*
+0 g
+326.909 423.302 4.0144 0.2005 re
+f*
+1 g
+330.923 423.302 16.2583 0.2005 re
+f*
+0 g
+347.181 423.302 5.4194 0.2005 re
+f*
+1 g
+352.601 423.302 6.8245 0.2005 re
+f*
+0.498 0 0.482 rg
+359.425 423.302 4.2151 0.2005 re
+f*
+1 g
+363.641 423.302 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 423.302 7.4267 0.2005 re
+f*
+1 g
+374.68 423.302 3.8136 0.2005 re
+f*
+0.498 0 0.482 rg
+378.494 423.302 9.6345 0.2005 re
+f*
+1 g
+388.128 423.302 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 423.302 7.2259 0.2005 re
+f*
+1 g
+398.967 423.302 3.8137 0.2005 re
+f*
+0.498 0 0.482 rg
+402.781 423.302 8.0287 0.2005 re
+f*
+1 g
+410.81 423.302 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+414.824 423.302 2.6094 0.2005 re
+f*
+0 g
+250.435 423.502 20.8749 0.2006 re
+f*
+1 g
+271.31 423.502 7.6273 0.2006 re
+f*
+0 g
+278.937 423.502 16.0575 0.2006 re
+f*
+1 g
+294.994 423.502 3.613 0.2006 re
+f*
+0 g
+298.607 423.502 11.8425 0.2006 re
+f*
+1 g
+310.45 423.502 4.4157 0.2006 re
+f*
+0 g
+314.866 423.502 8.2296 0.2006 re
+f*
+1 g
+323.095 423.502 3.8136 0.2006 re
+f*
+0 g
+326.909 423.502 4.0144 0.2006 re
+f*
+1 g
+330.923 423.502 16.2583 0.2006 re
+f*
+0 g
+347.181 423.502 5.2187 0.2006 re
+f*
+1 g
+352.4 423.502 7.0252 0.2006 re
+f*
+0.498 0 0.482 rg
+359.425 423.502 4.2151 0.2006 re
+f*
+1 g
+363.641 423.502 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 423.502 7.4267 0.2006 re
+f*
+1 g
+374.68 423.502 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+378.494 423.502 9.6345 0.2006 re
+f*
+1 g
+388.128 423.502 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 423.502 7.4266 0.2006 re
+f*
+1 g
+399.168 423.502 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+402.781 423.502 8.0287 0.2006 re
+f*
+1 g
+410.81 423.502 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+414.824 423.502 2.6094 0.2006 re
+f*
+0 g
+250.435 423.703 20.8749 0.2006 re
+f*
+1 g
+271.31 423.703 7.6273 0.2006 re
+f*
+0 g
+278.937 423.703 16.0575 0.2006 re
+f*
+1 g
+294.994 423.703 3.613 0.2006 re
+f*
+0 g
+298.607 423.703 12.0432 0.2006 re
+f*
+1 g
+310.651 423.703 4.215 0.2006 re
+f*
+0 g
+314.866 423.703 8.2296 0.2006 re
+f*
+1 g
+323.095 423.703 3.8136 0.2006 re
+f*
+0 g
+326.909 423.703 4.0144 0.2006 re
+f*
+1 g
+330.923 423.703 4.0144 0.2006 re
+f*
+0 g
+334.938 423.703 8.0288 0.2006 re
+f*
+1 g
+342.966 423.703 4.2151 0.2006 re
+f*
+0 g
+347.181 423.703 5.2187 0.2006 re
+f*
+1 g
+352.4 423.703 7.2259 0.2006 re
+f*
+0.498 0 0.482 rg
+359.626 423.703 4.0144 0.2006 re
+f*
+1 g
+363.641 423.703 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 423.703 7.6274 0.2006 re
+f*
+1 g
+374.881 423.703 3.8137 0.2006 re
+f*
+0.498 0 0.482 rg
+378.695 423.703 9.2331 0.2006 re
+f*
+1 g
+387.928 423.703 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 423.703 7.4266 0.2006 re
+f*
+1 g
+399.168 423.703 3.8137 0.2006 re
+f*
+0.498 0 0.482 rg
+402.981 423.703 7.828 0.2006 re
+f*
+1 g
+410.81 423.703 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+414.824 423.703 2.6094 0.2006 re
+f*
+0 g
+250.435 423.904 20.8749 0.2005 re
+f*
+1 g
+271.31 423.904 7.6273 0.2005 re
+f*
+0 g
+278.937 423.904 16.0575 0.2005 re
+f*
+1 g
+294.994 423.904 3.8137 0.2005 re
+f*
+0 g
+298.808 423.904 11.8425 0.2005 re
+f*
+1 g
+310.651 423.904 4.215 0.2005 re
+f*
+0 g
+314.866 423.904 8.2296 0.2005 re
+f*
+1 g
+323.095 423.904 3.8136 0.2005 re
+f*
+0 g
+326.909 423.904 4.2151 0.2005 re
+f*
+1 g
+331.124 423.904 3.8137 0.2005 re
+f*
+0 g
+334.938 423.904 8.0288 0.2005 re
+f*
+1 g
+342.966 423.904 4.2151 0.2005 re
+f*
+0 g
+347.181 423.904 5.2187 0.2005 re
+f*
+1 g
+352.4 423.904 7.2259 0.2005 re
+f*
+0.498 0 0.482 rg
+359.626 423.904 4.0144 0.2005 re
+f*
+1 g
+363.641 423.904 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 423.904 7.6274 0.2005 re
+f*
+1 g
+374.881 423.904 3.8137 0.2005 re
+f*
+0.498 0 0.482 rg
+378.695 423.904 9.2331 0.2005 re
+f*
+1 g
+387.928 423.904 3.8136 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 423.904 7.4266 0.2005 re
+f*
+1 g
+399.168 423.904 3.8137 0.2005 re
+f*
+0.498 0 0.482 rg
+402.981 423.904 7.828 0.2005 re
+f*
+1 g
+410.81 423.904 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+414.824 423.904 2.6094 0.2005 re
+f*
+0 g
+250.435 424.104 20.8749 0.2006 re
+f*
+1 g
+271.31 424.104 7.6273 0.2006 re
+f*
+0 g
+278.937 424.104 16.0575 0.2006 re
+f*
+1 g
+294.994 424.104 3.8137 0.2006 re
+f*
+0 g
+298.808 424.104 11.8425 0.2006 re
+f*
+1 g
+310.651 424.104 4.215 0.2006 re
+f*
+0 g
+314.866 424.104 8.4303 0.2006 re
+f*
+1 g
+323.296 424.104 3.6129 0.2006 re
+f*
+0 g
+326.909 424.104 4.2151 0.2006 re
+f*
+1 g
+331.124 424.104 3.8137 0.2006 re
+f*
+0 g
+334.938 424.104 8.0288 0.2006 re
+f*
+1 g
+342.966 424.104 4.2151 0.2006 re
+f*
+0 g
+347.181 424.104 5.2187 0.2006 re
+f*
+1 g
+352.4 424.104 7.2259 0.2006 re
+f*
+0.498 0 0.482 rg
+359.626 424.104 4.0144 0.2006 re
+f*
+1 g
+363.641 424.104 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 424.104 7.8281 0.2006 re
+f*
+1 g
+375.081 424.104 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+378.695 424.104 9.2331 0.2006 re
+f*
+1 g
+387.928 424.104 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 424.104 7.6273 0.2006 re
+f*
+1 g
+399.368 424.104 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+402.981 424.104 7.828 0.2006 re
+f*
+1 g
+410.81 424.104 3.8137 0.2006 re
+f*
+0.498 0 0.482 rg
+414.623 424.104 2.8101 0.2006 re
+f*
+0 g
+250.435 424.305 20.8749 0.2005 re
+f*
+1 g
+271.31 424.305 7.6273 0.2005 re
+f*
+0 g
+278.937 424.305 16.0575 0.2005 re
+f*
+1 g
+294.994 424.305 3.8137 0.2005 re
+f*
+0 g
+298.808 424.305 12.0432 0.2005 re
+f*
+1 g
+310.851 424.305 4.0143 0.2005 re
+f*
+0 g
+314.866 424.305 8.4303 0.2005 re
+f*
+1 g
+323.296 424.305 3.6129 0.2005 re
+f*
+0 g
+326.909 424.305 4.2151 0.2005 re
+f*
+1 g
+331.124 424.305 4.0144 0.2005 re
+f*
+0 g
+335.138 424.305 7.8281 0.2005 re
+f*
+1 g
+342.966 424.305 4.2151 0.2005 re
+f*
+0 g
+347.181 424.305 5.2187 0.2005 re
+f*
+1 g
+352.4 424.305 7.2259 0.2005 re
+f*
+0.498 0 0.482 rg
+359.626 424.305 4.0144 0.2005 re
+f*
+1 g
+363.641 424.305 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 424.305 7.8281 0.2005 re
+f*
+1 g
+375.081 424.305 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+378.695 424.305 9.2331 0.2005 re
+f*
+1 g
+387.928 424.305 3.8136 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 424.305 7.6273 0.2005 re
+f*
+1 g
+399.368 424.305 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+402.981 424.305 7.828 0.2005 re
+f*
+1 g
+410.81 424.305 3.8137 0.2005 re
+f*
+0.498 0 0.482 rg
+414.623 424.305 2.6093 0.2005 re
+f*
+0 g
+250.435 424.505 20.8749 0.2006 re
+f*
+1 g
+271.31 424.505 7.6273 0.2006 re
+f*
+0 g
+278.937 424.505 16.0575 0.2006 re
+f*
+1 g
+294.994 424.505 3.8137 0.2006 re
+f*
+0 g
+298.808 424.505 12.0432 0.2006 re
+f*
+1 g
+310.851 424.505 4.0143 0.2006 re
+f*
+0 g
+314.866 424.505 8.4303 0.2006 re
+f*
+1 g
+323.296 424.505 3.6129 0.2006 re
+f*
+0 g
+326.909 424.505 4.4158 0.2006 re
+f*
+1 g
+331.325 424.505 3.8137 0.2006 re
+f*
+0 g
+335.138 424.505 7.8281 0.2006 re
+f*
+1 g
+342.966 424.505 4.0143 0.2006 re
+f*
+0 g
+346.981 424.505 5.2188 0.2006 re
+f*
+1 g
+352.2 424.505 7.4266 0.2006 re
+f*
+0.498 0 0.482 rg
+359.626 424.505 4.0144 0.2006 re
+f*
+1 g
+363.641 424.505 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 424.505 8.0288 0.2006 re
+f*
+1 g
+375.282 424.505 3.4123 0.2006 re
+f*
+0.498 0 0.482 rg
+378.695 424.505 9.2331 0.2006 re
+f*
+1 g
+387.928 424.505 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 424.505 7.828 0.2006 re
+f*
+1 g
+399.569 424.505 3.4123 0.2006 re
+f*
+0.498 0 0.482 rg
+402.981 424.505 7.828 0.2006 re
+f*
+1 g
+410.81 424.505 3.8137 0.2006 re
+f*
+0.498 0 0.482 rg
+414.623 424.505 2.6093 0.2006 re
+f*
+0 g
+250.635 424.706 20.6741 0.2006 re
+f*
+1 g
+271.31 424.706 7.6273 0.2006 re
+f*
+0 g
+278.937 424.706 16.0575 0.2006 re
+f*
+1 g
+294.994 424.706 3.8137 0.2006 re
+f*
+0 g
+298.808 424.706 12.2439 0.2006 re
+f*
+1 g
+311.052 424.706 3.8136 0.2006 re
+f*
+0 g
+314.866 424.706 8.4303 0.2006 re
+f*
+1 g
+323.296 424.706 3.4122 0.2006 re
+f*
+0 g
+326.708 424.706 4.6165 0.2006 re
+f*
+1 g
+331.325 424.706 3.8137 0.2006 re
+f*
+0 g
+335.138 424.706 7.8281 0.2006 re
+f*
+1 g
+342.966 424.706 4.0143 0.2006 re
+f*
+0 g
+346.981 424.706 5.2188 0.2006 re
+f*
+1 g
+352.2 424.706 7.4266 0.2006 re
+f*
+0.498 0 0.482 rg
+359.626 424.706 4.0144 0.2006 re
+f*
+1 g
+363.641 424.706 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 424.706 8.0288 0.2006 re
+f*
+1 g
+375.282 424.706 3.4123 0.2006 re
+f*
+0.498 0 0.482 rg
+378.695 424.706 9.2331 0.2006 re
+f*
+1 g
+387.928 424.706 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 424.706 7.828 0.2006 re
+f*
+1 g
+399.569 424.706 3.4123 0.2006 re
+f*
+0.498 0 0.482 rg
+402.981 424.706 7.828 0.2006 re
+f*
+1 g
+410.81 424.706 3.8137 0.2006 re
+f*
+0.498 0 0.482 rg
+414.623 424.706 2.6093 0.2006 re
+f*
+0 g
+250.635 424.906 20.6741 0.2005 re
+f*
+1 g
+271.31 424.906 7.6273 0.2005 re
+f*
+0 g
+278.937 424.906 16.0575 0.2005 re
+f*
+1 g
+294.994 424.906 3.8137 0.2005 re
+f*
+0 g
+298.808 424.906 12.2439 0.2005 re
+f*
+1 g
+311.052 424.906 3.8136 0.2005 re
+f*
+0 g
+314.866 424.906 8.4303 0.2005 re
+f*
+1 g
+323.296 424.906 3.4122 0.2005 re
+f*
+0 g
+326.708 424.906 4.6165 0.2005 re
+f*
+1 g
+331.325 424.906 3.8137 0.2005 re
+f*
+0 g
+335.138 424.906 7.8281 0.2005 re
+f*
+1 g
+342.966 424.906 4.0143 0.2005 re
+f*
+0 g
+346.981 424.906 5.2188 0.2005 re
+f*
+1 g
+352.2 424.906 7.4266 0.2005 re
+f*
+0.498 0 0.482 rg
+359.626 424.906 4.0144 0.2005 re
+f*
+1 g
+363.641 424.906 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 424.906 8.2295 0.2005 re
+f*
+1 g
+375.483 424.906 3.2116 0.2005 re
+f*
+0.498 0 0.482 rg
+378.695 424.906 9.0323 0.2005 re
+f*
+1 g
+387.727 424.906 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 424.906 8.0288 0.2005 re
+f*
+1 g
+399.77 424.906 3.4122 0.2005 re
+f*
+0.498 0 0.482 rg
+403.182 424.906 7.6273 0.2005 re
+f*
+1 g
+410.81 424.906 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+414.422 424.906 2.81 0.2005 re
+f*
+0 g
+250.635 425.107 20.8748 0.2006 re
+f*
+1 g
+271.51 425.107 7.4266 0.2006 re
+f*
+0 g
+278.937 425.107 16.0575 0.2006 re
+f*
+1 g
+294.994 425.107 4.0144 0.2006 re
+f*
+0 g
+299.009 425.107 5.2187 0.2006 re
+f*
+1 g
+304.227 425.107 2.208 0.2006 re
+f*
+0 g
+306.435 425.107 4.8172 0.2006 re
+f*
+1 g
+311.253 425.107 3.6129 0.2006 re
+f*
+0 g
+314.866 425.107 8.4303 0.2006 re
+f*
+1 g
+323.296 425.107 3.4122 0.2006 re
+f*
+0 g
+326.708 425.107 4.8173 0.2006 re
+f*
+1 g
+331.525 425.107 3.6129 0.2006 re
+f*
+0 g
+335.138 425.107 7.8281 0.2006 re
+f*
+1 g
+342.966 425.107 4.0143 0.2006 re
+f*
+0 g
+346.981 425.107 5.018 0.2006 re
+f*
+1 g
+351.999 425.107 7.6274 0.2006 re
+f*
+0.498 0 0.482 rg
+359.626 425.107 4.0144 0.2006 re
+f*
+1 g
+363.641 425.107 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 425.107 8.2295 0.2006 re
+f*
+1 g
+375.483 425.107 3.4123 0.2006 re
+f*
+0.498 0 0.482 rg
+378.895 425.107 8.8316 0.2006 re
+f*
+1 g
+387.727 425.107 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 425.107 8.2295 0.2006 re
+f*
+1 g
+399.971 425.107 3.2115 0.2006 re
+f*
+0.498 0 0.482 rg
+403.182 425.107 7.6273 0.2006 re
+f*
+1 g
+410.81 425.107 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+414.422 425.107 2.81 0.2006 re
+f*
+0 g
+250.635 425.308 20.8748 0.2005 re
+f*
+1 g
+271.51 425.308 7.4266 0.2005 re
+f*
+0 g
+278.937 425.308 16.0575 0.2005 re
+f*
+1 g
+294.994 425.308 4.0144 0.2005 re
+f*
+0 g
+299.009 425.308 4.8173 0.2005 re
+f*
+1 g
+303.826 425.308 3.0108 0.2005 re
+f*
+0 g
+306.837 425.308 4.4158 0.2005 re
+f*
+1 g
+311.253 425.308 3.8137 0.2005 re
+f*
+0 g
+315.066 425.308 8.2295 0.2005 re
+f*
+1 g
+323.296 425.308 3.4122 0.2005 re
+f*
+0 g
+326.708 425.308 4.8173 0.2005 re
+f*
+1 g
+331.525 425.308 3.6129 0.2005 re
+f*
+0 g
+335.138 425.308 7.8281 0.2005 re
+f*
+1 g
+342.966 425.308 4.0143 0.2005 re
+f*
+0 g
+346.981 425.308 5.018 0.2005 re
+f*
+1 g
+351.999 425.308 7.6274 0.2005 re
+f*
+0.498 0 0.482 rg
+359.626 425.308 4.0144 0.2005 re
+f*
+1 g
+363.641 425.308 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 425.308 8.4303 0.2005 re
+f*
+1 g
+375.684 425.308 3.2115 0.2005 re
+f*
+0.498 0 0.482 rg
+378.895 425.308 8.8316 0.2005 re
+f*
+1 g
+387.727 425.308 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 425.308 8.2295 0.2005 re
+f*
+1 g
+399.971 425.308 3.2115 0.2005 re
+f*
+0.498 0 0.482 rg
+403.182 425.308 7.6273 0.2005 re
+f*
+1 g
+410.81 425.308 3.4122 0.2005 re
+f*
+0.498 0 0.482 rg
+414.222 425.308 3.0108 0.2005 re
+f*
+0 g
+250.635 425.508 20.8748 0.2006 re
+f*
+1 g
+271.51 425.508 7.4266 0.2006 re
+f*
+0 g
+278.937 425.508 16.0575 0.2006 re
+f*
+1 g
+294.994 425.508 4.0144 0.2006 re
+f*
+0 g
+299.009 425.508 4.6166 0.2006 re
+f*
+1 g
+303.625 425.508 3.4122 0.2006 re
+f*
+0 g
+307.038 425.508 4.4158 0.2006 re
+f*
+1 g
+311.453 425.508 3.613 0.2006 re
+f*
+0 g
+315.066 425.508 8.2295 0.2006 re
+f*
+1 g
+323.296 425.508 3.2115 0.2006 re
+f*
+0 g
+326.507 425.508 5.2187 0.2006 re
+f*
+1 g
+331.726 425.508 3.4122 0.2006 re
+f*
+0 g
+335.138 425.508 7.8281 0.2006 re
+f*
+1 g
+342.966 425.508 3.8137 0.2006 re
+f*
+0 g
+346.78 425.508 5.2186 0.2006 re
+f*
+1 g
+351.999 425.508 7.6274 0.2006 re
+f*
+0.498 0 0.482 rg
+359.626 425.508 4.0144 0.2006 re
+f*
+1 g
+363.641 425.508 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 425.508 8.4303 0.2006 re
+f*
+1 g
+375.684 425.508 3.2115 0.2006 re
+f*
+0.498 0 0.482 rg
+378.895 425.508 8.6309 0.2006 re
+f*
+1 g
+387.526 425.508 4.2151 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 425.508 8.4302 0.2006 re
+f*
+1 g
+400.171 425.508 3.2115 0.2006 re
+f*
+0.498 0 0.482 rg
+403.383 425.508 7.4266 0.2006 re
+f*
+1 g
+410.81 425.508 3.4122 0.2006 re
+f*
+0.498 0 0.482 rg
+414.222 425.508 2.8102 0.2006 re
+f*
+0 g
+250.635 425.709 20.8748 0.2005 re
+f*
+1 g
+271.51 425.709 7.4266 0.2005 re
+f*
+0 g
+278.937 425.709 16.0575 0.2005 re
+f*
+1 g
+294.994 425.709 4.2151 0.2005 re
+f*
+0 g
+299.209 425.709 4.4159 0.2005 re
+f*
+1 g
+303.625 425.709 3.6129 0.2005 re
+f*
+0 g
+307.238 425.709 4.4159 0.2005 re
+f*
+1 g
+311.654 425.709 3.4122 0.2005 re
+f*
+0 g
+315.066 425.709 8.0288 0.2005 re
+f*
+1 g
+323.095 425.709 3.4122 0.2005 re
+f*
+0 g
+326.507 425.709 5.2187 0.2005 re
+f*
+1 g
+331.726 425.709 3.613 0.2005 re
+f*
+0 g
+335.339 425.709 7.6273 0.2005 re
+f*
+1 g
+342.966 425.709 3.8137 0.2005 re
+f*
+0 g
+346.78 425.709 5.018 0.2005 re
+f*
+1 g
+351.798 425.709 7.828 0.2005 re
+f*
+0.498 0 0.482 rg
+359.626 425.709 4.0144 0.2005 re
+f*
+1 g
+363.641 425.709 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 425.709 8.631 0.2005 re
+f*
+1 g
+375.884 425.709 3.0108 0.2005 re
+f*
+0.498 0 0.482 rg
+378.895 425.709 8.6309 0.2005 re
+f*
+1 g
+387.526 425.709 4.2151 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 425.709 8.6309 0.2005 re
+f*
+1 g
+400.372 425.709 3.0108 0.2005 re
+f*
+0.498 0 0.482 rg
+403.383 425.709 7.4266 0.2005 re
+f*
+1 g
+410.81 425.709 3.4122 0.2005 re
+f*
+0.498 0 0.482 rg
+414.222 425.709 2.8102 0.2005 re
+f*
+0 g
+250.836 425.909 20.6741 0.2006 re
+f*
+1 g
+271.51 425.909 7.4266 0.2006 re
+f*
+0 g
+278.937 425.909 16.0575 0.2006 re
+f*
+1 g
+294.994 425.909 4.2151 0.2006 re
+f*
+0 g
+299.209 425.909 4.4159 0.2006 re
+f*
+1 g
+303.625 425.909 3.6129 0.2006 re
+f*
+0 g
+307.238 425.909 4.4159 0.2006 re
+f*
+1 g
+311.654 425.909 3.4122 0.2006 re
+f*
+0 g
+315.066 425.909 8.0288 0.2006 re
+f*
+1 g
+323.095 425.909 3.2115 0.2006 re
+f*
+0 g
+326.307 425.909 5.6201 0.2006 re
+f*
+1 g
+331.927 425.909 3.4123 0.2006 re
+f*
+0 g
+335.339 425.909 7.6273 0.2006 re
+f*
+1 g
+342.966 425.909 3.8137 0.2006 re
+f*
+0 g
+346.78 425.909 5.018 0.2006 re
+f*
+1 g
+351.798 425.909 7.828 0.2006 re
+f*
+0.498 0 0.482 rg
+359.626 425.909 4.0144 0.2006 re
+f*
+1 g
+363.641 425.909 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 425.909 8.8317 0.2006 re
+f*
+1 g
+376.085 425.909 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+379.096 425.909 8.4302 0.2006 re
+f*
+1 g
+387.526 425.909 4.2151 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 425.909 8.6309 0.2006 re
+f*
+1 g
+400.372 425.909 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+403.383 425.909 7.2259 0.2006 re
+f*
+1 g
+410.609 425.909 3.4123 0.2006 re
+f*
+0.498 0 0.482 rg
+414.021 425.909 3.0108 0.2006 re
+f*
+0 g
+250.836 426.11 20.6741 0.2006 re
+f*
+1 g
+271.51 426.11 7.4266 0.2006 re
+f*
+0 g
+278.937 426.11 16.0575 0.2006 re
+f*
+1 g
+294.994 426.11 4.2151 0.2006 re
+f*
+0 g
+299.209 426.11 4.4159 0.2006 re
+f*
+1 g
+303.625 426.11 3.6129 0.2006 re
+f*
+0 g
+307.238 426.11 4.6166 0.2006 re
+f*
+1 g
+311.855 426.11 3.2115 0.2006 re
+f*
+0 g
+315.066 426.11 8.0288 0.2006 re
+f*
+1 g
+323.095 426.11 3.2115 0.2006 re
+f*
+0 g
+326.307 426.11 5.6201 0.2006 re
+f*
+1 g
+331.927 426.11 3.4123 0.2006 re
+f*
+0 g
+335.339 426.11 7.6273 0.2006 re
+f*
+1 g
+342.966 426.11 3.6129 0.2006 re
+f*
+0 g
+346.579 426.11 5.2188 0.2006 re
+f*
+1 g
+351.798 426.11 8.0287 0.2006 re
+f*
+0.498 0 0.482 rg
+359.827 426.11 3.8137 0.2006 re
+f*
+1 g
+363.641 426.11 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 426.11 8.8317 0.2006 re
+f*
+1 g
+376.085 426.11 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+379.096 426.11 8.2294 0.2006 re
+f*
+1 g
+387.325 426.11 4.4159 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 426.11 8.8316 0.2006 re
+f*
+1 g
+400.573 426.11 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+403.584 426.11 7.0252 0.2006 re
+f*
+1 g
+410.609 426.11 3.2115 0.2006 re
+f*
+0.498 0 0.482 rg
+413.82 426.11 3.2116 0.2006 re
+f*
+0 g
+250.836 426.31 20.6741 0.2005 re
+f*
+1 g
+271.51 426.31 7.4266 0.2005 re
+f*
+0 g
+278.937 426.31 16.0575 0.2005 re
+f*
+1 g
+294.994 426.31 4.4159 0.2005 re
+f*
+0 g
+299.41 426.31 4.2151 0.2005 re
+f*
+1 g
+303.625 426.31 3.8137 0.2005 re
+f*
+0 g
+307.439 426.31 4.4158 0.2005 re
+f*
+1 g
+311.855 426.31 3.4122 0.2005 re
+f*
+0 g
+315.267 426.31 7.8281 0.2005 re
+f*
+1 g
+323.095 426.31 3.2115 0.2005 re
+f*
+0 g
+326.307 426.31 5.8208 0.2005 re
+f*
+1 g
+332.127 426.31 3.2116 0.2005 re
+f*
+0 g
+335.339 426.31 7.6273 0.2005 re
+f*
+1 g
+342.966 426.31 3.6129 0.2005 re
+f*
+0 g
+346.579 426.31 5.018 0.2005 re
+f*
+1 g
+351.597 426.31 8.2295 0.2005 re
+f*
+0.498 0 0.482 rg
+359.827 426.31 3.8137 0.2005 re
+f*
+1 g
+363.641 426.31 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 426.31 9.0324 0.2005 re
+f*
+1 g
+376.286 426.31 3.0108 0.2005 re
+f*
+0.498 0 0.482 rg
+379.297 426.31 8.0287 0.2005 re
+f*
+1 g
+387.325 426.31 4.4159 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 426.31 9.0324 0.2005 re
+f*
+1 g
+400.774 426.31 2.81 0.2005 re
+f*
+0.498 0 0.482 rg
+403.584 426.31 7.0252 0.2005 re
+f*
+1 g
+410.609 426.31 3.2115 0.2005 re
+f*
+0.498 0 0.482 rg
+413.82 426.31 3.2116 0.2005 re
+f*
+0 g
+250.836 426.511 20.6741 0.2006 re
+f*
+1 g
+271.51 426.511 7.4266 0.2006 re
+f*
+0 g
+278.937 426.511 16.0575 0.2006 re
+f*
+1 g
+294.994 426.511 4.4159 0.2006 re
+f*
+0 g
+299.41 426.511 4.2151 0.2006 re
+f*
+1 g
+303.625 426.511 3.8137 0.2006 re
+f*
+0 g
+307.439 426.511 4.6165 0.2006 re
+f*
+1 g
+312.056 426.511 3.2115 0.2006 re
+f*
+0 g
+315.267 426.511 7.8281 0.2006 re
+f*
+1 g
+323.095 426.511 3.0107 0.2006 re
+f*
+0 g
+326.106 426.511 6.2223 0.2006 re
+f*
+1 g
+332.328 426.511 3.2116 0.2006 re
+f*
+0 g
+335.54 426.511 7.4266 0.2006 re
+f*
+1 g
+342.966 426.511 3.4122 0.2006 re
+f*
+0 g
+346.379 426.511 5.2187 0.2006 re
+f*
+1 g
+351.597 426.511 8.2295 0.2006 re
+f*
+0.498 0 0.482 rg
+359.827 426.511 3.8137 0.2006 re
+f*
+1 g
+363.641 426.511 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 426.511 9.2331 0.2006 re
+f*
+1 g
+376.486 426.511 2.8101 0.2006 re
+f*
+0.498 0 0.482 rg
+379.297 426.511 7.828 0.2006 re
+f*
+1 g
+387.125 426.511 4.6166 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 426.511 9.2331 0.2006 re
+f*
+1 g
+400.974 426.511 2.8101 0.2006 re
+f*
+0.498 0 0.482 rg
+403.784 426.511 6.8244 0.2006 re
+f*
+1 g
+410.609 426.511 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+413.62 426.511 3.4123 0.2006 re
+f*
+0 g
+250.836 426.711 20.6741 0.2005 re
+f*
+1 g
+271.51 426.711 7.4266 0.2005 re
+f*
+0 g
+278.937 426.711 16.0575 0.2005 re
+f*
+1 g
+294.994 426.711 4.6166 0.2005 re
+f*
+0 g
+299.611 426.711 4.0144 0.2005 re
+f*
+1 g
+303.625 426.711 3.8137 0.2005 re
+f*
+0 g
+307.439 426.711 4.8172 0.2005 re
+f*
+1 g
+312.256 426.711 3.0108 0.2005 re
+f*
+0 g
+315.267 426.711 7.8281 0.2005 re
+f*
+1 g
+323.095 426.711 3.0107 0.2005 re
+f*
+0 g
+326.106 426.711 6.2223 0.2005 re
+f*
+1 g
+332.328 426.711 3.2116 0.2005 re
+f*
+0 g
+335.54 426.711 7.4266 0.2005 re
+f*
+1 g
+342.966 426.711 3.4122 0.2005 re
+f*
+0 g
+346.379 426.711 5.018 0.2005 re
+f*
+1 g
+351.397 426.711 8.4302 0.2005 re
+f*
+0.498 0 0.482 rg
+359.827 426.711 3.8137 0.2005 re
+f*
+1 g
+363.641 426.711 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 426.711 9.4339 0.2005 re
+f*
+1 g
+376.687 426.711 2.6093 0.2005 re
+f*
+0.498 0 0.482 rg
+379.297 426.711 7.6274 0.2005 re
+f*
+1 g
+386.924 426.711 1.0036 0.2005 re
+f*
+0.498 0 0.482 rg
+387.928 426.711 0.2006 0.2005 re
+f*
+1 g
+388.128 426.711 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 426.711 9.4338 0.2005 re
+f*
+1 g
+401.175 426.711 2.6094 0.2005 re
+f*
+0.498 0 0.482 rg
+403.784 426.711 6.6237 0.2005 re
+f*
+1 g
+410.408 426.711 3.0108 0.2005 re
+f*
+0.498 0 0.482 rg
+413.419 426.711 3.4122 0.2005 re
+f*
+0 g
+251.037 426.912 20.4734 0.2006 re
+f*
+1 g
+271.51 426.912 7.4266 0.2006 re
+f*
+0 g
+278.937 426.912 16.0575 0.2006 re
+f*
+1 g
+294.994 426.912 4.6166 0.2006 re
+f*
+0 g
+299.611 426.912 4.0144 0.2006 re
+f*
+1 g
+303.625 426.912 3.8137 0.2006 re
+f*
+0 g
+307.439 426.912 5.0179 0.2006 re
+f*
+1 g
+312.457 426.912 3.0108 0.2006 re
+f*
+0 g
+315.468 426.912 7.6274 0.2006 re
+f*
+1 g
+323.095 426.912 2.81 0.2006 re
+f*
+0 g
+325.905 426.912 6.6238 0.2006 re
+f*
+1 g
+332.529 426.912 3.0108 0.2006 re
+f*
+0 g
+335.54 426.912 7.4266 0.2006 re
+f*
+1 g
+342.966 426.912 3.2115 0.2006 re
+f*
+0 g
+346.178 426.912 5.2187 0.2006 re
+f*
+1 g
+351.397 426.912 8.4302 0.2006 re
+f*
+0.498 0 0.482 rg
+359.827 426.912 3.8137 0.2006 re
+f*
+1 g
+363.641 426.912 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 426.912 9.6346 0.2006 re
+f*
+1 g
+376.888 426.912 2.6093 0.2006 re
+f*
+0.498 0 0.482 rg
+379.497 426.912 7.4267 0.2006 re
+f*
+1 g
+386.924 426.912 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+387.928 426.912 0.2006 0.2006 re
+f*
+1 g
+388.128 426.912 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 426.912 9.6345 0.2006 re
+f*
+1 g
+401.376 426.912 2.6094 0.2006 re
+f*
+0.498 0 0.482 rg
+403.985 426.912 6.423 0.2006 re
+f*
+1 g
+410.408 426.912 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+413.419 426.912 3.4122 0.2006 re
+f*
+0 g
+251.037 427.113 20.4734 0.2006 re
+f*
+1 g
+271.51 427.113 7.4266 0.2006 re
+f*
+0 g
+278.937 427.113 16.0575 0.2006 re
+f*
+1 g
+294.994 427.113 3.613 0.2006 re
+f*
+0 g
+298.607 427.113 0.2007 0.2006 re
+f*
+1 g
+298.808 427.113 1.0036 0.2006 re
+f*
+0 g
+299.812 427.113 4.0144 0.2006 re
+f*
+1 g
+303.826 427.113 3.613 0.2006 re
+f*
+0 g
+307.439 427.113 5.0179 0.2006 re
+f*
+1 g
+312.457 427.113 3.0108 0.2006 re
+f*
+0 g
+315.468 427.113 7.6274 0.2006 re
+f*
+1 g
+323.095 427.113 2.6093 0.2006 re
+f*
+0 g
+325.704 427.113 7.0252 0.2006 re
+f*
+1 g
+332.73 427.113 3.0108 0.2006 re
+f*
+0 g
+335.74 427.113 7.0252 0.2006 re
+f*
+1 g
+342.766 427.113 3.4122 0.2006 re
+f*
+0 g
+346.178 427.113 5.018 0.2006 re
+f*
+1 g
+351.196 427.113 8.6309 0.2006 re
+f*
+0.498 0 0.482 rg
+359.827 427.113 3.8137 0.2006 re
+f*
+1 g
+363.641 427.113 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 427.113 9.8353 0.2006 re
+f*
+1 g
+377.089 427.113 2.6094 0.2006 re
+f*
+0.498 0 0.482 rg
+379.698 427.113 7.0251 0.2006 re
+f*
+1 g
+386.723 427.113 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+387.727 427.113 0.4014 0.2006 re
+f*
+1 g
+388.128 427.113 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 427.113 9.8352 0.2006 re
+f*
+1 g
+401.576 427.113 2.4087 0.2006 re
+f*
+0.498 0 0.482 rg
+403.985 427.113 6.2223 0.2006 re
+f*
+1 g
+410.207 427.113 3.0107 0.2006 re
+f*
+0.498 0 0.482 rg
+413.218 427.113 3.613 0.2006 re
+f*
+0 g
+251.037 427.313 20.4734 0.2005 re
+f*
+1 g
+271.51 427.313 7.4266 0.2005 re
+f*
+0 g
+278.937 427.313 16.0575 0.2005 re
+f*
+1 g
+294.994 427.313 3.613 0.2005 re
+f*
+0 g
+298.607 427.313 0.2007 0.2005 re
+f*
+1 g
+298.808 427.313 1.0036 0.2005 re
+f*
+0 g
+299.812 427.313 4.0144 0.2005 re
+f*
+1 g
+303.826 427.313 3.613 0.2005 re
+f*
+0 g
+307.439 427.313 5.2187 0.2005 re
+f*
+1 g
+312.658 427.313 2.81 0.2005 re
+f*
+0 g
+315.468 427.313 7.6274 0.2005 re
+f*
+1 g
+323.095 427.313 2.6093 0.2005 re
+f*
+0 g
+325.704 427.313 7.2259 0.2005 re
+f*
+1 g
+332.93 427.313 2.8101 0.2005 re
+f*
+0 g
+335.74 427.313 7.0252 0.2005 re
+f*
+1 g
+342.766 427.313 3.2114 0.2005 re
+f*
+0 g
+345.977 427.313 5.2188 0.2005 re
+f*
+1 g
+351.196 427.313 8.6309 0.2005 re
+f*
+0.498 0 0.482 rg
+359.827 427.313 3.8137 0.2005 re
+f*
+1 g
+363.641 427.313 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 427.313 10.036 0.2005 re
+f*
+1 g
+377.289 427.313 2.4087 0.2005 re
+f*
+0.498 0 0.482 rg
+379.698 427.313 6.8244 0.2005 re
+f*
+1 g
+386.522 427.313 1.0036 0.2005 re
+f*
+0.498 0 0.482 rg
+387.526 427.313 0.6021 0.2005 re
+f*
+1 g
+388.128 427.313 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 427.313 10.036 0.2005 re
+f*
+1 g
+401.777 427.313 2.4086 0.2005 re
+f*
+0.498 0 0.482 rg
+404.186 427.313 6.0216 0.2005 re
+f*
+1 g
+410.207 427.313 2.8101 0.2005 re
+f*
+0.498 0 0.482 rg
+413.017 427.313 3.8136 0.2005 re
+f*
+0 g
+251.037 427.514 20.4734 0.2006 re
+f*
+1 g
+271.51 427.514 7.4266 0.2006 re
+f*
+0 g
+278.937 427.514 16.0575 0.2006 re
+f*
+1 g
+294.994 427.514 3.613 0.2006 re
+f*
+0 g
+298.607 427.514 0.4014 0.2006 re
+f*
+1 g
+299.009 427.514 1.0036 0.2006 re
+f*
+0 g
+300.012 427.514 3.8137 0.2006 re
+f*
+1 g
+303.826 427.514 3.613 0.2006 re
+f*
+0 g
+307.439 427.514 5.4194 0.2006 re
+f*
+1 g
+312.858 427.514 2.8101 0.2006 re
+f*
+0 g
+315.669 427.514 7.2258 0.2006 re
+f*
+1 g
+322.894 427.514 2.6094 0.2006 re
+f*
+0 g
+325.504 427.514 7.4266 0.2006 re
+f*
+1 g
+332.93 427.514 3.0108 0.2006 re
+f*
+0 g
+335.941 427.514 6.8245 0.2006 re
+f*
+1 g
+342.766 427.514 3.2114 0.2006 re
+f*
+0 g
+345.977 427.514 5.018 0.2006 re
+f*
+1 g
+350.995 427.514 8.8317 0.2006 re
+f*
+0.498 0 0.482 rg
+359.827 427.514 3.8137 0.2006 re
+f*
+1 g
+363.641 427.514 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 427.514 10.2367 0.2006 re
+f*
+1 g
+377.49 427.514 2.4087 0.2006 re
+f*
+0.498 0 0.482 rg
+379.899 427.514 6.4229 0.2006 re
+f*
+1 g
+386.322 427.514 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+387.325 427.514 0.8029 0.2006 re
+f*
+1 g
+388.128 427.514 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 427.514 10.2367 0.2006 re
+f*
+1 g
+401.978 427.514 2.4086 0.2006 re
+f*
+0.498 0 0.482 rg
+404.386 427.514 5.6202 0.2006 re
+f*
+1 g
+410.007 427.514 2.81 0.2006 re
+f*
+0.498 0 0.482 rg
+412.817 427.514 3.8137 0.2006 re
+f*
+0 g
+251.238 427.714 20.2727 0.2005 re
+f*
+1 g
+271.51 427.714 7.4266 0.2005 re
+f*
+0 g
+278.937 427.714 16.0575 0.2005 re
+f*
+1 g
+294.994 427.714 3.613 0.2005 re
+f*
+0 g
+298.607 427.714 0.4014 0.2005 re
+f*
+1 g
+299.009 427.714 1.0036 0.2005 re
+f*
+0 g
+300.012 427.714 4.0144 0.2005 re
+f*
+1 g
+304.027 427.714 3.4123 0.2005 re
+f*
+0 g
+307.439 427.714 5.6201 0.2005 re
+f*
+1 g
+313.059 427.714 2.6094 0.2005 re
+f*
+0 g
+315.669 427.714 7.2258 0.2005 re
+f*
+1 g
+322.894 427.714 2.4087 0.2005 re
+f*
+0 g
+325.303 427.714 7.828 0.2005 re
+f*
+1 g
+333.131 427.714 2.8101 0.2005 re
+f*
+0 g
+335.941 427.714 6.8245 0.2005 re
+f*
+1 g
+342.766 427.714 3.0108 0.2005 re
+f*
+0 g
+345.776 427.714 5.018 0.2005 re
+f*
+1 g
+350.794 427.714 9.0323 0.2005 re
+f*
+0.498 0 0.482 rg
+359.827 427.714 3.8137 0.2005 re
+f*
+1 g
+363.641 427.714 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 427.714 10.4375 0.2005 re
+f*
+1 g
+377.691 427.714 2.4086 0.2005 re
+f*
+0.498 0 0.482 rg
+380.099 427.714 6.0215 0.2005 re
+f*
+1 g
+386.121 427.714 1.2043 0.2005 re
+f*
+0.498 0 0.482 rg
+387.325 427.714 0.8029 0.2005 re
+f*
+1 g
+388.128 427.714 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 427.714 10.4374 0.2005 re
+f*
+1 g
+402.179 427.714 2.4086 0.2005 re
+f*
+0.498 0 0.482 rg
+404.587 427.714 5.4195 0.2005 re
+f*
+1 g
+410.007 427.714 2.6093 0.2005 re
+f*
+0.498 0 0.482 rg
+412.616 427.714 4.0144 0.2005 re
+f*
+0 g
+251.238 427.915 20.2727 0.2006 re
+f*
+1 g
+271.51 427.915 7.4266 0.2006 re
+f*
+0 g
+278.937 427.915 16.0575 0.2006 re
+f*
+1 g
+294.994 427.915 3.613 0.2006 re
+f*
+0 g
+298.607 427.915 0.6021 0.2006 re
+f*
+1 g
+299.209 427.915 1.0036 0.2006 re
+f*
+0 g
+300.213 427.915 3.8137 0.2006 re
+f*
+1 g
+304.027 427.915 3.4123 0.2006 re
+f*
+0 g
+307.439 427.915 5.8208 0.2006 re
+f*
+1 g
+313.26 427.915 2.6093 0.2006 re
+f*
+0 g
+315.869 427.915 7.0252 0.2006 re
+f*
+1 g
+322.894 427.915 2.208 0.2006 re
+f*
+0 g
+325.102 427.915 8.2294 0.2006 re
+f*
+1 g
+333.332 427.915 2.8101 0.2006 re
+f*
+0 g
+336.142 427.915 6.423 0.2006 re
+f*
+1 g
+342.565 427.915 3.0108 0.2006 re
+f*
+0 g
+345.576 427.915 5.2188 0.2006 re
+f*
+1 g
+350.794 427.915 8.8316 0.2006 re
+f*
+0.498 0 0.482 rg
+359.626 427.915 4.0144 0.2006 re
+f*
+1 g
+363.641 427.915 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 427.915 10.6382 0.2006 re
+f*
+1 g
+377.892 427.915 2.4086 0.2006 re
+f*
+0.498 0 0.482 rg
+380.3 427.915 5.6201 0.2006 re
+f*
+1 g
+385.92 427.915 1.2043 0.2006 re
+f*
+0.498 0 0.482 rg
+387.125 427.915 1.0036 0.2006 re
+f*
+1 g
+388.128 427.915 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 427.915 10.8388 0.2006 re
+f*
+1 g
+402.58 427.915 2.208 0.2006 re
+f*
+0.498 0 0.482 rg
+404.788 427.915 5.018 0.2006 re
+f*
+1 g
+409.806 427.915 2.6093 0.2006 re
+f*
+0.498 0 0.482 rg
+412.415 427.915 4.2151 0.2006 re
+f*
+0 g
+251.238 428.115 20.2727 0.2006 re
+f*
+1 g
+271.51 428.115 7.4266 0.2006 re
+f*
+0 g
+278.937 428.115 16.0575 0.2006 re
+f*
+1 g
+294.994 428.115 3.613 0.2006 re
+f*
+0 g
+298.607 428.115 0.8029 0.2006 re
+f*
+1 g
+299.41 428.115 1.0036 0.2006 re
+f*
+0 g
+300.414 428.115 3.6129 0.2006 re
+f*
+1 g
+304.027 428.115 3.4123 0.2006 re
+f*
+0 g
+307.439 428.115 6.0215 0.2006 re
+f*
+1 g
+313.461 428.115 2.4086 0.2006 re
+f*
+0 g
+315.869 428.115 6.8246 0.2006 re
+f*
+1 g
+322.694 428.115 2.2078 0.2006 re
+f*
+0 g
+324.902 428.115 8.631 0.2006 re
+f*
+1 g
+333.533 428.115 2.6093 0.2006 re
+f*
+0 g
+336.142 428.115 6.423 0.2006 re
+f*
+1 g
+342.565 428.115 2.8101 0.2006 re
+f*
+0 g
+345.375 428.115 5.2187 0.2006 re
+f*
+1 g
+350.594 428.115 9.0324 0.2006 re
+f*
+0.498 0 0.482 rg
+359.626 428.115 4.0144 0.2006 re
+f*
+1 g
+363.641 428.115 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 428.115 11.0396 0.2006 re
+f*
+1 g
+378.293 428.115 2.2079 0.2006 re
+f*
+0.498 0 0.482 rg
+380.501 428.115 5.018 0.2006 re
+f*
+1 g
+385.519 428.115 1.4051 0.2006 re
+f*
+0.498 0 0.482 rg
+386.924 428.115 1.2042 0.2006 re
+f*
+1 g
+388.128 428.115 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 428.115 11.0396 0.2006 re
+f*
+1 g
+402.781 428.115 2.2079 0.2006 re
+f*
+0.498 0 0.482 rg
+404.989 428.115 4.6165 0.2006 re
+f*
+1 g
+409.605 428.115 2.4087 0.2006 re
+f*
+0.498 0 0.482 rg
+412.014 428.115 4.6165 0.2006 re
+f*
+0 g
+251.238 428.316 20.2727 0.2005 re
+f*
+1 g
+271.51 428.316 7.4266 0.2005 re
+f*
+0 g
+278.937 428.316 16.0575 0.2005 re
+f*
+1 g
+294.994 428.316 3.613 0.2005 re
+f*
+0 g
+298.607 428.316 0.8029 0.2005 re
+f*
+1 g
+299.41 428.316 1.2043 0.2005 re
+f*
+0 g
+300.615 428.316 3.4122 0.2005 re
+f*
+1 g
+304.027 428.316 3.2115 0.2005 re
+f*
+0 g
+307.238 428.316 6.4231 0.2005 re
+f*
+1 g
+313.661 428.316 2.4086 0.2005 re
+f*
+0 g
+316.07 428.316 6.6238 0.2005 re
+f*
+1 g
+322.694 428.316 2.0071 0.2005 re
+f*
+0 g
+324.701 428.316 9.0324 0.2005 re
+f*
+1 g
+333.733 428.316 2.6094 0.2005 re
+f*
+0 g
+336.343 428.316 6.0215 0.2005 re
+f*
+1 g
+342.364 428.316 3.0108 0.2005 re
+f*
+0 g
+345.375 428.316 5.018 0.2005 re
+f*
+1 g
+350.393 428.316 9.2331 0.2005 re
+f*
+0.498 0 0.482 rg
+359.626 428.316 1.0036 0.2005 re
+f*
+1 g
+360.63 428.316 0.2007 0.2005 re
+f*
+0.498 0 0.482 rg
+360.83 428.316 2.8101 0.2005 re
+f*
+1 g
+363.641 428.316 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 428.316 11.2403 0.2005 re
+f*
+1 g
+378.494 428.316 2.4087 0.2005 re
+f*
+0.498 0 0.482 rg
+380.902 428.316 4.215 0.2005 re
+f*
+1 g
+385.117 428.316 1.6058 0.2005 re
+f*
+0.498 0 0.482 rg
+386.723 428.316 1.405 0.2005 re
+f*
+1 g
+388.128 428.316 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 428.316 11.441 0.2005 re
+f*
+1 g
+403.182 428.316 2.2079 0.2005 re
+f*
+0.498 0 0.482 rg
+405.39 428.316 3.8137 0.2005 re
+f*
+1 g
+409.204 428.316 2.6093 0.2005 re
+f*
+0.498 0 0.482 rg
+411.813 428.316 4.8173 0.2005 re
+f*
+0 g
+251.438 428.516 20.072 0.2006 re
+f*
+1 g
+271.51 428.516 7.4266 0.2006 re
+f*
+0 g
+278.937 428.516 16.0575 0.2006 re
+f*
+1 g
+294.994 428.516 3.613 0.2006 re
+f*
+0 g
+298.607 428.516 1.0036 0.2006 re
+f*
+1 g
+299.611 428.516 1.2043 0.2006 re
+f*
+0 g
+300.815 428.516 3.2115 0.2006 re
+f*
+1 g
+304.027 428.516 3.2115 0.2006 re
+f*
+0 g
+307.238 428.516 6.8245 0.2006 re
+f*
+1 g
+314.063 428.516 2.2079 0.2006 re
+f*
+0 g
+316.271 428.516 6.2223 0.2006 re
+f*
+1 g
+322.493 428.516 2.0072 0.2006 re
+f*
+0 g
+324.5 428.516 9.4338 0.2006 re
+f*
+1 g
+333.934 428.516 2.6094 0.2006 re
+f*
+0 g
+336.543 428.516 5.8208 0.2006 re
+f*
+1 g
+342.364 428.516 2.8101 0.2006 re
+f*
+0 g
+345.174 428.516 5.2187 0.2006 re
+f*
+1 g
+350.393 428.516 9.2331 0.2006 re
+f*
+0.498 0 0.482 rg
+359.626 428.516 1.0036 0.2006 re
+f*
+1 g
+360.63 428.516 6.6237 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 428.516 11.6418 0.2006 re
+f*
+1 g
+378.895 428.516 2.4086 0.2006 re
+f*
+0.498 0 0.482 rg
+381.304 428.516 3.4122 0.2006 re
+f*
+1 g
+384.716 428.516 1.6057 0.2006 re
+f*
+0.498 0 0.482 rg
+386.322 428.516 1.8065 0.2006 re
+f*
+1 g
+388.128 428.516 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 428.516 11.6417 0.2006 re
+f*
+1 g
+403.383 428.516 2.4087 0.2006 re
+f*
+0.498 0 0.482 rg
+405.792 428.516 3.0108 0.2006 re
+f*
+1 g
+408.802 428.516 2.6093 0.2006 re
+f*
+0.498 0 0.482 rg
+411.412 428.516 5.018 0.2006 re
+f*
+0 g
+251.438 428.717 20.072 0.2005 re
+f*
+1 g
+271.51 428.717 7.4266 0.2005 re
+f*
+0 g
+278.937 428.717 16.0575 0.2005 re
+f*
+1 g
+294.994 428.717 3.613 0.2005 re
+f*
+0 g
+298.607 428.717 1.2043 0.2005 re
+f*
+1 g
+299.812 428.717 1.2043 0.2005 re
+f*
+0 g
+301.016 428.717 3.0108 0.2005 re
+f*
+1 g
+304.027 428.717 3.2115 0.2005 re
+f*
+0 g
+307.238 428.717 7.0252 0.2005 re
+f*
+1 g
+314.263 428.717 2.2079 0.2005 re
+f*
+0 g
+316.471 428.717 6.0216 0.2005 re
+f*
+1 g
+322.493 428.717 1.8065 0.2005 re
+f*
+0 g
+324.299 428.717 10.0359 0.2005 re
+f*
+1 g
+334.335 428.717 2.4087 0.2005 re
+f*
+0 g
+336.744 428.717 5.4194 0.2005 re
+f*
+1 g
+342.163 428.717 2.81 0.2005 re
+f*
+0 g
+344.973 428.717 5.2188 0.2005 re
+f*
+1 g
+350.192 428.717 9.4338 0.2005 re
+f*
+0.498 0 0.482 rg
+359.626 428.717 1.0036 0.2005 re
+f*
+1 g
+360.63 428.717 6.6237 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 428.717 12.0432 0.2005 re
+f*
+1 g
+379.297 428.717 2.81 0.2005 re
+f*
+0.498 0 0.482 rg
+382.107 428.717 1.8066 0.2005 re
+f*
+1 g
+383.913 428.717 2.2078 0.2005 re
+f*
+0.498 0 0.482 rg
+386.121 428.717 2.0072 0.2005 re
+f*
+1 g
+388.128 428.717 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 428.717 12.0432 0.2005 re
+f*
+1 g
+403.784 428.717 2.81 0.2005 re
+f*
+0.498 0 0.482 rg
+406.594 428.717 1.6058 0.2005 re
+f*
+1 g
+408.2 428.717 2.8101 0.2005 re
+f*
+0.498 0 0.482 rg
+411.01 428.717 5.4194 0.2005 re
+f*
+0 g
+251.438 428.918 20.072 0.2006 re
+f*
+1 g
+271.51 428.918 7.4266 0.2006 re
+f*
+0 g
+278.937 428.918 16.0575 0.2006 re
+f*
+1 g
+294.994 428.918 3.613 0.2006 re
+f*
+0 g
+298.607 428.918 1.405 0.2006 re
+f*
+1 g
+300.012 428.918 1.2043 0.2006 re
+f*
+0 g
+301.217 428.918 2.8101 0.2006 re
+f*
+1 g
+304.027 428.918 3.0108 0.2006 re
+f*
+0 g
+307.038 428.918 7.4266 0.2006 re
+f*
+1 g
+314.464 428.918 2.2079 0.2006 re
+f*
+0 g
+316.672 428.918 5.6202 0.2006 re
+f*
+1 g
+322.292 428.918 1.8065 0.2006 re
+f*
+0 g
+324.099 428.918 10.4374 0.2006 re
+f*
+1 g
+334.536 428.918 2.4086 0.2006 re
+f*
+0 g
+336.945 428.918 5.018 0.2006 re
+f*
+1 g
+341.963 428.918 2.8101 0.2006 re
+f*
+0 g
+344.773 428.918 5.2186 0.2006 re
+f*
+1 g
+349.991 428.918 9.6346 0.2006 re
+f*
+0.498 0 0.482 rg
+359.626 428.918 1.0036 0.2006 re
+f*
+1 g
+360.63 428.918 6.6237 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 428.918 12.4447 0.2006 re
+f*
+1 g
+379.698 428.918 6.0215 0.2006 re
+f*
+0.498 0 0.482 rg
+385.72 428.918 2.4086 0.2006 re
+f*
+1 g
+388.128 428.918 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 428.918 12.6453 0.2006 re
+f*
+1 g
+404.386 428.918 6.2223 0.2006 re
+f*
+0.498 0 0.482 rg
+410.609 428.918 5.8209 0.2006 re
+f*
+0 g
+251.438 429.118 20.2727 0.2006 re
+f*
+1 g
+271.711 429.118 7.2259 0.2006 re
+f*
+0 g
+278.937 429.118 16.0575 0.2006 re
+f*
+1 g
+294.994 429.118 3.613 0.2006 re
+f*
+0 g
+298.607 429.118 1.6057 0.2006 re
+f*
+1 g
+300.213 429.118 1.2044 0.2006 re
+f*
+0 g
+301.417 429.118 2.4086 0.2006 re
+f*
+1 g
+303.826 429.118 3.2115 0.2006 re
+f*
+0 g
+307.038 429.118 7.828 0.2006 re
+f*
+1 g
+314.866 429.118 2.0072 0.2006 re
+f*
+0 g
+316.873 429.118 5.2188 0.2006 re
+f*
+1 g
+322.092 429.118 1.8064 0.2006 re
+f*
+0 g
+323.898 429.118 10.8389 0.2006 re
+f*
+1 g
+334.737 429.118 2.4086 0.2006 re
+f*
+0 g
+337.146 429.118 4.6166 0.2006 re
+f*
+1 g
+341.762 429.118 2.6093 0.2006 re
+f*
+0 g
+344.371 429.118 5.4195 0.2006 re
+f*
+1 g
+349.791 429.118 9.8352 0.2006 re
+f*
+0.498 0 0.482 rg
+359.626 429.118 20.4734 0.2006 re
+f*
+1 g
+380.099 429.118 5.2187 0.2006 re
+f*
+0.498 0 0.482 rg
+385.318 429.118 2.81 0.2006 re
+f*
+1 g
+388.128 429.118 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 429.118 13.0468 0.2006 re
+f*
+1 g
+404.788 429.118 5.4194 0.2006 re
+f*
+0.498 0 0.482 rg
+410.207 429.118 6.2223 0.2006 re
+f*
+0 g
+251.639 429.319 20.0719 0.2005 re
+f*
+1 g
+271.711 429.319 7.2259 0.2005 re
+f*
+0 g
+278.937 429.319 16.0575 0.2005 re
+f*
+1 g
+294.994 429.319 3.613 0.2005 re
+f*
+0 g
+298.607 429.319 1.8065 0.2005 re
+f*
+1 g
+300.414 429.319 1.405 0.2005 re
+f*
+0 g
+301.819 429.319 1.8065 0.2005 re
+f*
+1 g
+303.625 429.319 3.2115 0.2005 re
+f*
+0 g
+306.837 429.319 8.4302 0.2005 re
+f*
+1 g
+315.267 429.319 1.8065 0.2005 re
+f*
+0 g
+317.074 429.319 4.8172 0.2005 re
+f*
+1 g
+321.891 429.319 1.6058 0.2005 re
+f*
+0 g
+323.497 429.319 11.6417 0.2005 re
+f*
+1 g
+335.138 429.319 2.208 0.2005 re
+f*
+0 g
+337.346 429.319 4.2151 0.2005 re
+f*
+1 g
+341.561 429.319 2.6093 0.2005 re
+f*
+0 g
+344.171 429.319 5.6202 0.2005 re
+f*
+1 g
+349.791 429.319 9.8352 0.2005 re
+f*
+0.498 0 0.482 rg
+359.626 429.319 21.2763 0.2005 re
+f*
+1 g
+380.902 429.319 3.8136 0.2005 re
+f*
+0.498 0 0.482 rg
+384.716 429.319 3.4122 0.2005 re
+f*
+1 g
+388.128 429.319 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 429.319 13.8497 0.2005 re
+f*
+1 g
+405.591 429.319 3.8136 0.2005 re
+f*
+0.498 0 0.482 rg
+409.404 429.319 6.8244 0.2005 re
+f*
+0 g
+251.639 429.519 20.0719 0.2005 re
+f*
+1 g
+271.711 429.519 7.2259 0.2005 re
+f*
+0 g
+278.937 429.519 13.0467 0.2005 re
+f*
+1 g
+291.984 429.519 0.2008 0.2005 re
+f*
+0 g
+292.184 429.519 2.81 0.2005 re
+f*
+1 g
+294.994 429.519 3.613 0.2005 re
+f*
+0 g
+298.607 429.519 2.0072 0.2005 re
+f*
+1 g
+300.615 429.519 1.6057 0.2005 re
+f*
+0 g
+302.22 429.519 1.2044 0.2005 re
+f*
+1 g
+303.425 429.519 3.2115 0.2005 re
+f*
+0 g
+306.636 429.519 9.0324 0.2005 re
+f*
+1 g
+315.669 429.519 1.8064 0.2005 re
+f*
+0 g
+317.475 429.519 4.2152 0.2005 re
+f*
+1 g
+321.69 429.519 1.405 0.2005 re
+f*
+0 g
+323.095 429.519 12.2439 0.2005 re
+f*
+1 g
+335.339 429.519 2.4086 0.2005 re
+f*
+0 g
+337.748 429.519 3.6129 0.2005 re
+f*
+1 g
+341.361 429.519 2.4087 0.2005 re
+f*
+0 g
+343.769 429.519 5.8208 0.2005 re
+f*
+1 g
+349.59 429.519 10.036 0.2005 re
+f*
+0.498 0 0.482 rg
+359.626 429.519 22.4805 0.2005 re
+f*
+1 g
+382.107 429.519 1.4051 0.2005 re
+f*
+0.498 0 0.482 rg
+383.512 429.519 4.6165 0.2005 re
+f*
+1 g
+388.128 429.519 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 429.519 15.054 0.2005 re
+f*
+1 g
+406.795 429.519 1.6057 0.2005 re
+f*
+0.498 0 0.482 rg
+408.401 429.519 7.828 0.2005 re
+f*
+0 g
+251.639 429.72 20.0719 0.2006 re
+f*
+1 g
+271.711 429.72 7.2259 0.2006 re
+f*
+0 g
+278.937 429.72 13.0467 0.2006 re
+f*
+1 g
+291.984 429.72 6.6238 0.2006 re
+f*
+0 g
+298.607 429.72 2.2079 0.2006 re
+f*
+1 g
+300.815 429.72 5.6202 0.2006 re
+f*
+0 g
+306.435 429.72 9.6345 0.2006 re
+f*
+1 g
+316.07 429.72 1.8064 0.2006 re
+f*
+0 g
+317.876 429.72 3.4123 0.2006 re
+f*
+1 g
+321.289 429.72 1.4051 0.2006 re
+f*
+0 g
+322.694 429.72 13.0467 0.2006 re
+f*
+1 g
+335.74 429.72 2.6093 0.2006 re
+f*
+0 g
+338.35 429.72 2.4087 0.2006 re
+f*
+1 g
+340.758 429.72 2.81 0.2006 re
+f*
+0 g
+343.568 429.72 5.8209 0.2006 re
+f*
+1 g
+349.389 429.72 10.2367 0.2006 re
+f*
+0.498 0 0.482 rg
+359.626 429.72 28.5021 0.2006 re
+f*
+1 g
+388.128 429.72 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 429.72 24.4877 0.2006 re
+f*
+0 g
+251.639 429.92 20.0719 0.2006 re
+f*
+1 g
+271.711 429.92 7.2259 0.2006 re
+f*
+0 g
+278.937 429.92 13.0467 0.2006 re
+f*
+1 g
+291.984 429.92 6.6238 0.2006 re
+f*
+0 g
+298.607 429.92 2.6093 0.2006 re
+f*
+1 g
+301.217 429.92 5.018 0.2006 re
+f*
+0 g
+306.235 429.92 10.4374 0.2006 re
+f*
+1 g
+316.672 429.92 2.0073 0.2006 re
+f*
+0 g
+318.679 429.92 1.8064 0.2006 re
+f*
+1 g
+320.486 429.92 1.6058 0.2006 re
+f*
+0 g
+322.092 429.92 14.0503 0.2006 re
+f*
+1 g
+336.142 429.92 7.0252 0.2006 re
+f*
+0 g
+343.167 429.92 6.0216 0.2006 re
+f*
+1 g
+349.189 429.92 10.2367 0.2006 re
+f*
+0.498 0 0.482 rg
+359.425 429.92 28.7028 0.2006 re
+f*
+1 g
+388.128 429.92 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 429.92 24.2871 0.2006 re
+f*
+0 g
+251.84 430.121 19.8712 0.2006 re
+f*
+1 g
+271.711 430.121 7.2259 0.2006 re
+f*
+0 g
+278.937 430.121 13.0467 0.2006 re
+f*
+1 g
+291.984 430.121 6.6238 0.2006 re
+f*
+0 g
+298.607 430.121 2.8101 0.2006 re
+f*
+1 g
+301.417 430.121 4.4158 0.2006 re
+f*
+0 g
+305.833 430.121 11.6417 0.2006 re
+f*
+1 g
+317.475 430.121 4.0144 0.2006 re
+f*
+0 g
+321.489 430.121 15.2547 0.2006 re
+f*
+1 g
+336.744 430.121 6.0216 0.2006 re
+f*
+0 g
+342.766 430.121 6.2222 0.2006 re
+f*
+1 g
+348.988 430.121 10.4375 0.2006 re
+f*
+0.498 0 0.482 rg
+359.425 430.121 28.7028 0.2006 re
+f*
+1 g
+388.128 430.121 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 430.121 24.2871 0.2006 re
+f*
+0 g
+251.84 430.322 19.8712 0.2005 re
+f*
+1 g
+271.711 430.322 7.2259 0.2005 re
+f*
+0 g
+278.937 430.322 23.0827 0.2005 re
+f*
+1 g
+302.02 430.322 3.4123 0.2005 re
+f*
+0 g
+305.432 430.322 13.4481 0.2005 re
+f*
+1 g
+318.88 430.322 1.6058 0.2005 re
+f*
+0 g
+320.486 430.322 16.8605 0.2005 re
+f*
+1 g
+337.346 430.322 4.8172 0.2005 re
+f*
+0 g
+342.163 430.322 6.6238 0.2005 re
+f*
+1 g
+348.787 430.322 10.6381 0.2005 re
+f*
+0.498 0 0.482 rg
+359.425 430.322 28.7028 0.2005 re
+f*
+1 g
+388.128 430.322 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 430.322 24.2871 0.2005 re
+f*
+0 g
+251.84 430.522 19.8712 0.2006 re
+f*
+1 g
+271.711 430.522 7.2259 0.2006 re
+f*
+0 g
+278.937 430.522 23.6849 0.2006 re
+f*
+1 g
+302.622 430.522 2.2079 0.2006 re
+f*
+0 g
+304.83 430.522 33.3194 0.2006 re
+f*
+1 g
+338.149 430.522 3.2115 0.2006 re
+f*
+0 g
+341.361 430.522 7.2259 0.2006 re
+f*
+1 g
+348.586 430.522 10.8389 0.2006 re
+f*
+0.498 0 0.482 rg
+359.425 430.522 28.7028 0.2006 re
+f*
+1 g
+388.128 430.522 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 430.522 24.0863 0.2006 re
+f*
+0 g
+252.04 430.723 19.8712 0.2005 re
+f*
+1 g
+271.912 430.723 7.0252 0.2005 re
+f*
+0 g
+278.937 430.723 69.4489 0.2005 re
+f*
+1 g
+348.386 430.723 11.0396 0.2005 re
+f*
+0.498 0 0.482 rg
+359.425 430.723 28.7028 0.2005 re
+f*
+1 g
+388.128 430.723 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 430.723 24.0863 0.2005 re
+f*
+0 g
+252.04 430.923 19.8712 0.2006 re
+f*
+1 g
+271.912 430.923 7.0252 0.2006 re
+f*
+0 g
+278.937 430.923 69.2482 0.2006 re
+f*
+1 g
+348.185 430.923 11.0395 0.2006 re
+f*
+0.498 0 0.482 rg
+359.225 430.923 28.9036 0.2006 re
+f*
+1 g
+388.128 430.923 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 430.923 24.0863 0.2006 re
+f*
+0 g
+252.04 431.124 19.8712 0.2006 re
+f*
+1 g
+271.912 431.124 7.0252 0.2006 re
+f*
+0 g
+278.937 431.124 69.0474 0.2006 re
+f*
+1 g
+347.984 431.124 11.2403 0.2006 re
+f*
+0.498 0 0.482 rg
+359.225 431.124 28.9036 0.2006 re
+f*
+1 g
+388.128 431.124 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 431.124 23.8856 0.2006 re
+f*
+0 g
+252.241 431.324 19.6705 0.2005 re
+f*
+1 g
+271.912 431.324 7.0252 0.2005 re
+f*
+0 g
+278.937 431.324 68.8468 0.2005 re
+f*
+1 g
+347.784 431.324 11.4409 0.2005 re
+f*
+0.498 0 0.482 rg
+359.225 431.324 28.9036 0.2005 re
+f*
+1 g
+388.128 431.324 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 431.324 23.8856 0.2005 re
+f*
+0 g
+252.241 431.525 19.6705 0.2005 re
+f*
+1 g
+271.912 431.525 7.0252 0.2005 re
+f*
+0 g
+278.937 431.525 68.4453 0.2005 re
+f*
+1 g
+347.382 431.525 11.8424 0.2005 re
+f*
+0.498 0 0.482 rg
+359.225 431.525 28.9036 0.2005 re
+f*
+1 g
+388.128 431.525 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 431.525 23.8856 0.2005 re
+f*
+0 g
+252.241 431.725 19.6705 0.2006 re
+f*
+1 g
+271.912 431.725 7.0252 0.2006 re
+f*
+0 g
+278.937 431.725 68.2446 0.2006 re
+f*
+1 g
+347.181 431.725 11.8424 0.2006 re
+f*
+0.498 0 0.482 rg
+359.024 431.725 29.1043 0.2006 re
+f*
+1 g
+388.128 431.725 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 431.725 23.6849 0.2006 re
+f*
+0 g
+252.442 431.926 19.6705 0.2006 re
+f*
+1 g
+272.112 431.926 6.8245 0.2006 re
+f*
+0 g
+278.937 431.926 68.0438 0.2006 re
+f*
+1 g
+346.981 431.926 12.0432 0.2006 re
+f*
+0.498 0 0.482 rg
+359.024 431.926 29.1043 0.2006 re
+f*
+1 g
+388.128 431.926 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 431.926 23.6849 0.2006 re
+f*
+0 g
+252.442 432.127 19.6705 0.2005 re
+f*
+1 g
+272.112 432.127 6.8245 0.2005 re
+f*
+0 g
+278.937 432.127 67.6424 0.2005 re
+f*
+1 g
+346.579 432.127 12.4446 0.2005 re
+f*
+0.498 0 0.482 rg
+359.024 432.127 29.1043 0.2005 re
+f*
+1 g
+388.128 432.127 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 432.127 23.4841 0.2005 re
+f*
+0 g
+252.643 432.327 19.4697 0.2005 re
+f*
+1 g
+272.112 432.327 6.8245 0.2005 re
+f*
+0 g
+278.937 432.327 67.4417 0.2005 re
+f*
+1 g
+346.379 432.327 12.6453 0.2005 re
+f*
+0.498 0 0.482 rg
+359.024 432.327 29.1043 0.2005 re
+f*
+1 g
+388.128 432.327 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 432.327 23.4841 0.2005 re
+f*
+0 g
+252.643 432.528 19.4697 0.2006 re
+f*
+1 g
+272.112 432.528 6.8245 0.2006 re
+f*
+0 g
+278.937 432.528 67.0402 0.2006 re
+f*
+1 g
+345.977 432.528 12.8461 0.2006 re
+f*
+0.498 0 0.482 rg
+358.823 432.528 29.305 0.2006 re
+f*
+1 g
+388.128 432.528 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 432.528 23.4841 0.2006 re
+f*
+0 g
+252.643 432.728 19.6705 0.2006 re
+f*
+1 g
+272.313 432.728 6.6237 0.2006 re
+f*
+0 g
+278.937 432.728 66.8396 0.2006 re
+f*
+1 g
+345.776 432.728 13.0467 0.2006 re
+f*
+0.498 0 0.482 rg
+358.823 432.728 29.305 0.2006 re
+f*
+1 g
+388.128 432.728 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 432.728 23.2835 0.2006 re
+f*
+0 g
+252.843 432.929 19.4698 0.2006 re
+f*
+1 g
+272.313 432.929 6.6237 0.2006 re
+f*
+0 g
+278.937 432.929 66.4381 0.2006 re
+f*
+1 g
+345.375 432.929 13.4482 0.2006 re
+f*
+0.498 0 0.482 rg
+358.823 432.929 29.305 0.2006 re
+f*
+1 g
+388.128 432.929 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 432.929 23.2835 0.2006 re
+f*
+0 g
+252.843 433.129 19.4698 0.2006 re
+f*
+1 g
+272.313 433.129 6.6237 0.2006 re
+f*
+0 g
+278.937 433.129 66.0366 0.2006 re
+f*
+1 g
+344.973 433.129 13.649 0.2006 re
+f*
+0.498 0 0.482 rg
+358.623 433.129 29.5057 0.2006 re
+f*
+1 g
+388.128 433.129 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 433.129 23.2835 0.2006 re
+f*
+0 g
+253.044 433.33 19.2691 0.2005 re
+f*
+1 g
+272.313 433.33 6.8244 0.2005 re
+f*
+0 g
+279.138 433.33 65.4345 0.2005 re
+f*
+1 g
+344.572 433.33 14.0504 0.2005 re
+f*
+0.498 0 0.482 rg
+358.623 433.33 29.5057 0.2005 re
+f*
+1 g
+388.128 433.33 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 433.33 23.0827 0.2005 re
+f*
+0 g
+253.044 433.53 19.4698 0.2005 re
+f*
+1 g
+272.514 433.53 6.6237 0.2005 re
+f*
+0 g
+279.138 433.53 65.0331 0.2005 re
+f*
+1 g
+344.171 433.53 14.2511 0.2005 re
+f*
+0.498 0 0.482 rg
+358.422 433.53 29.7064 0.2005 re
+f*
+1 g
+388.128 433.53 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 433.53 23.0827 0.2005 re
+f*
+0 g
+253.044 433.731 19.4698 0.2006 re
+f*
+1 g
+272.514 433.731 6.6237 0.2006 re
+f*
+0 g
+279.138 433.731 64.6317 0.2006 re
+f*
+1 g
+343.769 433.731 14.6525 0.2006 re
+f*
+0.498 0 0.482 rg
+358.422 433.731 29.7064 0.2006 re
+f*
+1 g
+388.128 433.731 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 433.731 22.882 0.2006 re
+f*
+0 g
+253.245 433.932 19.2691 0.2006 re
+f*
+1 g
+272.514 433.932 6.6237 0.2006 re
+f*
+0 g
+279.138 433.932 64.2302 0.2006 re
+f*
+1 g
+343.368 433.932 14.8532 0.2006 re
+f*
+0.498 0 0.482 rg
+358.221 433.932 29.9072 0.2006 re
+f*
+1 g
+388.128 433.932 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 433.932 22.882 0.2006 re
+f*
+0 g
+253.245 434.132 19.2691 0.2005 re
+f*
+1 g
+272.514 434.132 6.6237 0.2005 re
+f*
+0 g
+279.138 434.132 63.8288 0.2005 re
+f*
+1 g
+342.966 434.132 15.2546 0.2005 re
+f*
+0.498 0 0.482 rg
+358.221 434.132 29.9072 0.2005 re
+f*
+1 g
+388.128 434.132 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 434.132 22.6813 0.2005 re
+f*
+0 g
+253.445 434.333 19.2691 0.2006 re
+f*
+1 g
+272.715 434.333 6.423 0.2006 re
+f*
+0 g
+279.138 434.333 15.4554 0.2006 re
+f*
+1 g
+294.593 434.333 2.4086 0.2006 re
+f*
+0 g
+297.002 434.333 45.3626 0.2006 re
+f*
+1 g
+342.364 434.333 15.6561 0.2006 re
+f*
+0.498 0 0.482 rg
+358.02 434.333 30.1079 0.2006 re
+f*
+1 g
+388.128 434.333 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 434.333 22.6813 0.2006 re
+f*
+0 g
+253.445 434.533 19.2691 0.2005 re
+f*
+1 g
+272.715 434.533 6.423 0.2005 re
+f*
+0 g
+279.138 434.533 14.6525 0.2005 re
+f*
+1 g
+293.79 434.533 3.8137 0.2005 re
+f*
+0 g
+297.604 434.533 44.359 0.2005 re
+f*
+1 g
+341.963 434.533 16.0575 0.2005 re
+f*
+0.498 0 0.482 rg
+358.02 434.533 30.1079 0.2005 re
+f*
+1 g
+388.128 434.533 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 434.533 22.4805 0.2005 re
+f*
+0 g
+253.646 434.734 19.0683 0.2006 re
+f*
+1 g
+272.715 434.734 6.423 0.2006 re
+f*
+0 g
+279.138 434.734 14.0504 0.2006 re
+f*
+1 g
+293.188 434.734 4.8172 0.2006 re
+f*
+0 g
+298.005 434.734 43.3554 0.2006 re
+f*
+1 g
+341.361 434.734 16.459 0.2006 re
+f*
+0.498 0 0.482 rg
+357.82 434.734 30.3086 0.2006 re
+f*
+1 g
+388.128 434.734 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 434.734 22.4805 0.2006 re
+f*
+0 g
+253.646 434.934 19.269 0.2005 re
+f*
+1 g
+272.915 434.934 6.2223 0.2005 re
+f*
+0 g
+279.138 434.934 13.6489 0.2005 re
+f*
+1 g
+292.786 434.934 5.6202 0.2005 re
+f*
+0 g
+298.407 434.934 42.3518 0.2005 re
+f*
+1 g
+340.758 434.934 17.0611 0.2005 re
+f*
+0.498 0 0.482 rg
+357.82 434.934 30.3086 0.2005 re
+f*
+1 g
+388.128 434.934 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 434.934 22.4805 0.2005 re
+f*
+0 g
+253.847 435.135 19.0683 0.2006 re
+f*
+1 g
+272.915 435.135 6.2223 0.2006 re
+f*
+0 g
+279.138 435.135 13.2475 0.2006 re
+f*
+1 g
+292.385 435.135 6.2223 0.2006 re
+f*
+0 g
+298.607 435.135 41.5489 0.2006 re
+f*
+1 g
+340.156 435.135 17.4626 0.2006 re
+f*
+0.498 0 0.482 rg
+357.619 435.135 30.5093 0.2006 re
+f*
+1 g
+388.128 435.135 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 435.135 22.2799 0.2006 re
+f*
+0 g
+253.847 435.335 19.0683 0.2005 re
+f*
+1 g
+272.915 435.335 6.2223 0.2005 re
+f*
+0 g
+279.138 435.335 13.0468 0.2005 re
+f*
+1 g
+292.184 435.335 6.6237 0.2005 re
+f*
+0 g
+298.808 435.335 40.7461 0.2005 re
+f*
+1 g
+339.554 435.335 17.864 0.2005 re
+f*
+0.498 0 0.482 rg
+357.418 435.335 30.71 0.2005 re
+f*
+1 g
+388.128 435.335 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 435.335 22.2799 0.2005 re
+f*
+0 g
+254.048 435.536 19.0683 0.2006 re
+f*
+1 g
+273.116 435.536 6.0216 0.2006 re
+f*
+0 g
+279.138 435.536 13.0468 0.2006 re
+f*
+1 g
+292.184 435.536 6.8244 0.2006 re
+f*
+0 g
+299.009 435.536 39.7425 0.2006 re
+f*
+1 g
+338.751 435.536 18.6669 0.2006 re
+f*
+0.498 0 0.482 rg
+357.418 435.536 30.71 0.2006 re
+f*
+1 g
+388.128 435.536 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 435.536 22.0791 0.2006 re
+f*
+0 g
+254.048 435.737 19.0683 0.2006 re
+f*
+1 g
+273.116 435.737 6.0216 0.2006 re
+f*
+0 g
+279.138 435.737 12.846 0.2006 re
+f*
+1 g
+291.984 435.737 7.0252 0.2006 re
+f*
+0 g
+299.009 435.737 39.1403 0.2006 re
+f*
+1 g
+338.149 435.737 19.0683 0.2006 re
+f*
+0.498 0 0.482 rg
+357.217 435.737 30.9108 0.2006 re
+f*
+1 g
+388.128 435.737 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 435.737 22.0791 0.2006 re
+f*
+0 g
+254.248 435.937 19.0683 0.2006 re
+f*
+1 g
+273.317 435.937 5.8209 0.2006 re
+f*
+0 g
+279.138 435.937 12.6453 0.2006 re
+f*
+1 g
+291.783 435.937 7.4266 0.2006 re
+f*
+0 g
+299.209 435.937 38.3375 0.2006 re
+f*
+1 g
+337.547 435.937 19.4697 0.2006 re
+f*
+0.498 0 0.482 rg
+357.017 435.937 31.1115 0.2006 re
+f*
+1 g
+388.128 435.937 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 435.937 21.8784 0.2006 re
+f*
+0 g
+254.248 436.138 19.0683 0.2005 re
+f*
+1 g
+273.317 436.138 6.0216 0.2005 re
+f*
+0 g
+279.338 436.138 12.4446 0.2005 re
+f*
+1 g
+291.783 436.138 7.4266 0.2005 re
+f*
+0 g
+299.209 436.138 37.7353 0.2005 re
+f*
+1 g
+336.945 436.138 20.0719 0.2005 re
+f*
+0.498 0 0.482 rg
+357.017 436.138 7.4267 0.2005 re
+f*
+1 g
+364.443 436.138 1.8064 0.2005 re
+f*
+0.498 0 0.482 rg
+366.25 436.138 21.8784 0.2005 re
+f*
+1 g
+388.128 436.138 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 436.138 21.8784 0.2005 re
+f*
+0 g
+254.449 436.338 19.0684 0.2005 re
+f*
+1 g
+273.517 436.338 5.8208 0.2005 re
+f*
+0 g
+279.338 436.338 12.4446 0.2005 re
+f*
+1 g
+291.783 436.338 7.6274 0.2005 re
+f*
+0 g
+299.41 436.338 36.9324 0.2005 re
+f*
+1 g
+336.343 436.338 20.4733 0.2005 re
+f*
+0.498 0 0.482 rg
+356.816 436.338 7.2259 0.2005 re
+f*
+1 g
+364.042 436.338 2.6094 0.2005 re
+f*
+0.498 0 0.482 rg
+366.651 436.338 21.4769 0.2005 re
+f*
+1 g
+388.128 436.338 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 436.338 21.6777 0.2005 re
+f*
+0 g
+254.449 436.539 19.0684 0.2006 re
+f*
+1 g
+273.517 436.539 5.8208 0.2006 re
+f*
+0 g
+279.338 436.539 12.4446 0.2006 re
+f*
+1 g
+291.783 436.539 7.8281 0.2006 re
+f*
+0 g
+299.611 436.539 35.9288 0.2006 re
+f*
+1 g
+335.54 436.539 21.0755 0.2006 re
+f*
+0.498 0 0.482 rg
+356.615 436.539 7.2259 0.2006 re
+f*
+1 g
+363.841 436.539 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+366.852 436.539 21.2762 0.2006 re
+f*
+1 g
+388.128 436.539 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 436.539 21.6777 0.2006 re
+f*
+0 g
+254.65 436.739 19.0684 0.2006 re
+f*
+1 g
+273.718 436.739 5.6201 0.2006 re
+f*
+0 g
+279.338 436.739 12.4446 0.2006 re
+f*
+1 g
+291.783 436.739 7.8281 0.2006 re
+f*
+0 g
+299.611 436.739 35.3266 0.2006 re
+f*
+1 g
+334.938 436.739 21.477 0.2006 re
+f*
+0.498 0 0.482 rg
+356.415 436.739 7.2259 0.2006 re
+f*
+1 g
+363.641 436.739 3.4122 0.2006 re
+f*
+0.498 0 0.482 rg
+367.053 436.739 21.0755 0.2006 re
+f*
+1 g
+388.128 436.739 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 436.739 21.4769 0.2006 re
+f*
+0 g
+254.65 436.94 19.0684 0.2006 re
+f*
+1 g
+273.718 436.94 5.6201 0.2006 re
+f*
+0 g
+279.338 436.94 12.4446 0.2006 re
+f*
+1 g
+291.783 436.94 7.8281 0.2006 re
+f*
+0 g
+299.611 436.94 34.7244 0.2006 re
+f*
+1 g
+334.335 436.94 22.0792 0.2006 re
+f*
+0.498 0 0.482 rg
+356.415 436.94 7.0252 0.2006 re
+f*
+1 g
+363.44 436.94 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+367.253 436.94 20.8748 0.2006 re
+f*
+1 g
+388.128 436.94 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 436.94 21.2763 0.2006 re
+f*
+0 g
+254.851 437.141 19.0684 0.2005 re
+f*
+1 g
+273.919 437.141 5.4194 0.2005 re
+f*
+0 g
+279.338 437.141 12.4446 0.2005 re
+f*
+1 g
+291.783 437.141 8.0288 0.2005 re
+f*
+0 g
+299.812 437.141 33.9216 0.2005 re
+f*
+1 g
+333.733 437.141 22.4805 0.2005 re
+f*
+0.498 0 0.482 rg
+356.214 437.141 7.226 0.2005 re
+f*
+1 g
+363.44 437.141 3.8136 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 437.141 20.8748 0.2005 re
+f*
+1 g
+388.128 437.141 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 437.141 21.2763 0.2005 re
+f*
+0 g
+254.851 437.341 19.0684 0.2005 re
+f*
+1 g
+273.919 437.341 5.4194 0.2005 re
+f*
+0 g
+279.338 437.341 12.4446 0.2005 re
+f*
+1 g
+291.783 437.341 8.0288 0.2005 re
+f*
+0 g
+299.812 437.341 33.3194 0.2005 re
+f*
+1 g
+333.131 437.341 22.882 0.2005 re
+f*
+0.498 0 0.482 rg
+356.013 437.341 7.2259 0.2005 re
+f*
+1 g
+363.239 437.341 4.2152 0.2005 re
+f*
+0.498 0 0.482 rg
+367.454 437.341 20.674 0.2005 re
+f*
+1 g
+388.128 437.341 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 437.341 21.0755 0.2005 re
+f*
+0 g
+255.051 437.542 19.0683 0.2006 re
+f*
+1 g
+274.12 437.542 5.4195 0.2006 re
+f*
+0 g
+279.539 437.542 12.2438 0.2006 re
+f*
+1 g
+291.783 437.542 8.0288 0.2006 re
+f*
+0 g
+299.812 437.542 32.5165 0.2006 re
+f*
+1 g
+332.328 437.542 23.4842 0.2006 re
+f*
+0.498 0 0.482 rg
+355.812 437.542 7.4266 0.2006 re
+f*
+1 g
+363.239 437.542 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+367.454 437.542 20.674 0.2006 re
+f*
+1 g
+388.128 437.542 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 437.542 21.0755 0.2006 re
+f*
+0 g
+255.252 437.742 18.8676 0.2006 re
+f*
+1 g
+274.12 437.742 5.4195 0.2006 re
+f*
+0 g
+279.539 437.742 12.2438 0.2006 re
+f*
+1 g
+291.783 437.742 8.0288 0.2006 re
+f*
+0 g
+299.812 437.742 31.9144 0.2006 re
+f*
+1 g
+331.726 437.742 23.8856 0.2006 re
+f*
+0.498 0 0.482 rg
+355.612 437.742 7.6273 0.2006 re
+f*
+1 g
+363.239 437.742 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+367.454 437.742 20.674 0.2006 re
+f*
+1 g
+388.128 437.742 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 437.742 20.8748 0.2006 re
+f*
+0 g
+255.252 437.943 19.0683 0.2005 re
+f*
+1 g
+274.32 437.943 5.2188 0.2005 re
+f*
+0 g
+279.539 437.943 12.2438 0.2005 re
+f*
+1 g
+291.783 437.943 8.2295 0.2005 re
+f*
+0 g
+300.012 437.943 31.1115 0.2005 re
+f*
+1 g
+331.124 437.943 24.2871 0.2005 re
+f*
+0.498 0 0.482 rg
+355.411 437.943 7.828 0.2005 re
+f*
+1 g
+363.239 437.943 4.2152 0.2005 re
+f*
+0.498 0 0.482 rg
+367.454 437.943 20.674 0.2005 re
+f*
+1 g
+388.128 437.943 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 437.943 20.8748 0.2005 re
+f*
+0 g
+255.453 438.143 19.0684 0.2006 re
+f*
+1 g
+274.521 438.143 5.018 0.2006 re
+f*
+0 g
+279.539 438.143 12.2438 0.2006 re
+f*
+1 g
+291.783 438.143 8.2295 0.2006 re
+f*
+0 g
+300.012 438.143 30.5094 0.2006 re
+f*
+1 g
+330.522 438.143 24.6885 0.2006 re
+f*
+0.498 0 0.482 rg
+355.21 438.143 8.0287 0.2006 re
+f*
+1 g
+363.239 438.143 4.4159 0.2006 re
+f*
+0.498 0 0.482 rg
+367.655 438.143 20.4733 0.2006 re
+f*
+1 g
+388.128 438.143 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 438.143 20.6741 0.2006 re
+f*
+0 g
+255.453 438.344 19.0684 0.2005 re
+f*
+1 g
+274.521 438.344 5.2186 0.2005 re
+f*
+0 g
+279.74 438.344 12.0432 0.2005 re
+f*
+1 g
+291.783 438.344 8.2295 0.2005 re
+f*
+0 g
+300.012 438.344 29.9072 0.2005 re
+f*
+1 g
+329.92 438.344 25.2907 0.2005 re
+f*
+0.498 0 0.482 rg
+355.21 438.344 8.0287 0.2005 re
+f*
+1 g
+363.239 438.344 4.4159 0.2005 re
+f*
+0.498 0 0.482 rg
+367.655 438.344 20.4733 0.2005 re
+f*
+1 g
+388.128 438.344 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 438.344 20.6741 0.2005 re
+f*
+0 g
+255.653 438.544 19.0683 0.2006 re
+f*
+1 g
+274.722 438.544 5.018 0.2006 re
+f*
+0 g
+279.74 438.544 12.2439 0.2006 re
+f*
+1 g
+291.984 438.544 8.0288 0.2006 re
+f*
+0 g
+300.012 438.544 29.3051 0.2006 re
+f*
+1 g
+329.317 438.544 25.692 0.2006 re
+f*
+0.498 0 0.482 rg
+355.01 438.544 8.2295 0.2006 re
+f*
+1 g
+363.239 438.544 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+367.454 438.544 20.674 0.2006 re
+f*
+1 g
+388.128 438.544 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 438.544 20.4734 0.2006 re
+f*
+0 g
+255.653 438.745 19.2691 0.2006 re
+f*
+1 g
+274.922 438.745 4.8172 0.2006 re
+f*
+0 g
+279.74 438.745 12.2439 0.2006 re
+f*
+1 g
+291.984 438.745 8.0288 0.2006 re
+f*
+0 g
+300.012 438.745 28.7029 0.2006 re
+f*
+1 g
+328.715 438.745 26.0935 0.2006 re
+f*
+0.498 0 0.482 rg
+354.809 438.745 8.4302 0.2006 re
+f*
+1 g
+363.239 438.745 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+367.454 438.745 20.674 0.2006 re
+f*
+1 g
+388.128 438.745 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 438.745 20.2727 0.2006 re
+f*
+0 g
+255.854 438.946 19.0684 0.2005 re
+f*
+1 g
+274.922 438.946 4.8172 0.2005 re
+f*
+0 g
+279.74 438.946 12.4447 0.2005 re
+f*
+1 g
+292.184 438.946 7.828 0.2005 re
+f*
+0 g
+300.012 438.946 28.1007 0.2005 re
+f*
+1 g
+328.113 438.946 26.2943 0.2005 re
+f*
+0.498 0 0.482 rg
+354.407 438.946 8.8316 0.2005 re
+f*
+1 g
+363.239 438.946 4.2152 0.2005 re
+f*
+0.498 0 0.482 rg
+367.454 438.946 20.674 0.2005 re
+f*
+1 g
+388.128 438.946 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 438.946 20.2727 0.2005 re
+f*
+0 g
+256.055 439.146 19.0683 0.2006 re
+f*
+1 g
+275.123 439.146 4.8173 0.2006 re
+f*
+0 g
+279.94 439.146 12.2439 0.2006 re
+f*
+1 g
+292.184 439.146 7.828 0.2006 re
+f*
+0 g
+300.012 439.146 27.4986 0.2006 re
+f*
+1 g
+327.511 439.146 26.6957 0.2006 re
+f*
+0.498 0 0.482 rg
+354.207 439.146 9.0323 0.2006 re
+f*
+1 g
+363.239 439.146 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+367.454 439.146 20.674 0.2006 re
+f*
+1 g
+388.128 439.146 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 439.146 20.0719 0.2006 re
+f*
+0 g
+256.055 439.347 19.269 0.2005 re
+f*
+1 g
+275.324 439.347 4.6166 0.2005 re
+f*
+0 g
+279.94 439.347 12.4446 0.2005 re
+f*
+1 g
+292.385 439.347 7.6273 0.2005 re
+f*
+0 g
+300.012 439.347 26.8964 0.2005 re
+f*
+1 g
+326.909 439.347 27.0971 0.2005 re
+f*
+0.498 0 0.482 rg
+354.006 439.347 9.4339 0.2005 re
+f*
+1 g
+363.44 439.347 3.8136 0.2005 re
+f*
+0.498 0 0.482 rg
+367.253 439.347 20.8748 0.2005 re
+f*
+1 g
+388.128 439.347 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 439.347 19.8712 0.2005 re
+f*
+0 g
+256.256 439.547 19.2691 0.2006 re
+f*
+1 g
+275.525 439.547 4.4158 0.2006 re
+f*
+0 g
+279.94 439.547 12.4446 0.2006 re
+f*
+1 g
+292.385 439.547 7.6273 0.2006 re
+f*
+0 g
+300.012 439.547 26.495 0.2006 re
+f*
+1 g
+326.507 439.547 27.2979 0.2006 re
+f*
+0.498 0 0.482 rg
+353.805 439.547 9.8352 0.2006 re
+f*
+1 g
+363.641 439.547 3.4122 0.2006 re
+f*
+0.498 0 0.482 rg
+367.053 439.547 21.0755 0.2006 re
+f*
+1 g
+388.128 439.547 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 439.547 19.8712 0.2006 re
+f*
+0 g
+256.456 439.748 19.0684 0.2006 re
+f*
+1 g
+275.525 439.748 4.6165 0.2006 re
+f*
+0 g
+280.141 439.748 12.4446 0.2006 re
+f*
+1 g
+292.586 439.748 7.2259 0.2006 re
+f*
+0 g
+299.812 439.748 26.0935 0.2006 re
+f*
+1 g
+325.905 439.748 27.6993 0.2006 re
+f*
+0.498 0 0.482 rg
+353.605 439.748 10.2367 0.2006 re
+f*
+1 g
+363.841 439.748 3.2115 0.2006 re
+f*
+0.498 0 0.482 rg
+367.053 439.748 21.0755 0.2006 re
+f*
+1 g
+388.128 439.748 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 439.748 19.6705 0.2006 re
+f*
+0 g
+256.456 439.948 19.269 0.2005 re
+f*
+1 g
+275.725 439.948 4.4159 0.2005 re
+f*
+0 g
+280.141 439.948 12.6453 0.2005 re
+f*
+1 g
+292.786 439.948 7.0252 0.2005 re
+f*
+0 g
+299.812 439.948 25.6921 0.2005 re
+f*
+1 g
+325.504 439.948 27.6993 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 439.948 10.8388 0.2005 re
+f*
+1 g
+364.042 439.948 2.6094 0.2005 re
+f*
+0.498 0 0.482 rg
+366.651 439.948 18.4661 0.2005 re
+f*
+1 g
+385.117 439.948 0.2008 0.2005 re
+f*
+0.498 0 0.482 rg
+385.318 439.948 2.81 0.2005 re
+f*
+1 g
+388.128 439.948 3.613 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 439.948 19.6705 0.2005 re
+f*
+0 g
+256.657 440.149 19.2691 0.2006 re
+f*
+1 g
+275.926 440.149 4.2151 0.2006 re
+f*
+0 g
+280.141 440.149 12.6453 0.2006 re
+f*
+1 g
+292.786 440.149 7.0252 0.2006 re
+f*
+0 g
+299.812 440.149 25.2907 0.2006 re
+f*
+1 g
+325.102 440.149 27.8999 0.2006 re
+f*
+0.498 0 0.482 rg
+353.002 440.149 11.2403 0.2006 re
+f*
+1 g
+364.243 440.149 2.208 0.2006 re
+f*
+0.498 0 0.482 rg
+366.451 440.149 18.6668 0.2006 re
+f*
+1 g
+385.117 440.149 6.6238 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 440.149 19.4698 0.2006 re
+f*
+0 g
+256.858 440.35 19.2691 0.2005 re
+f*
+1 g
+276.127 440.35 4.2151 0.2005 re
+f*
+0 g
+280.342 440.35 12.6453 0.2005 re
+f*
+1 g
+292.987 440.35 6.8245 0.2005 re
+f*
+0 g
+299.812 440.35 24.6885 0.2005 re
+f*
+1 g
+324.5 440.35 28.1007 0.2005 re
+f*
+0.498 0 0.482 rg
+352.601 440.35 12.2439 0.2005 re
+f*
+1 g
+364.845 440.35 1.0036 0.2005 re
+f*
+0.498 0 0.482 rg
+365.848 440.35 19.269 0.2005 re
+f*
+1 g
+385.117 440.35 6.6238 0.2005 re
+f*
+0.498 0 0.482 rg
+391.741 440.35 19.2691 0.2005 re
+f*
+0 g
+256.858 440.55 19.4698 0.2006 re
+f*
+1 g
+276.327 440.55 4.0144 0.2006 re
+f*
+0 g
+280.342 440.55 12.6453 0.2006 re
+f*
+1 g
+292.987 440.55 6.6238 0.2006 re
+f*
+0 g
+299.611 440.55 24.4878 0.2006 re
+f*
+1 g
+324.099 440.55 28.3014 0.2006 re
+f*
+0.498 0 0.482 rg
+352.4 440.55 32.7172 0.2006 re
+f*
+1 g
+385.117 440.55 6.6238 0.2006 re
+f*
+0.498 0 0.482 rg
+391.741 440.55 19.2691 0.2006 re
+f*
+0 g
+257.058 440.751 19.4698 0.2005 re
+f*
+1 g
+276.528 440.751 4.0144 0.2005 re
+f*
+0 g
+280.543 440.751 12.6453 0.2005 re
+f*
+1 g
+293.188 440.751 6.423 0.2005 re
+f*
+0 g
+299.611 440.751 24.0863 0.2005 re
+f*
+1 g
+323.697 440.751 28.3014 0.2005 re
+f*
+0.498 0 0.482 rg
+351.999 440.751 58.8108 0.2005 re
+f*
+0 g
+257.259 440.951 19.4697 0.2006 re
+f*
+1 g
+276.729 440.951 3.8138 0.2006 re
+f*
+0 g
+280.543 440.951 12.6453 0.2006 re
+f*
+1 g
+293.188 440.951 6.423 0.2006 re
+f*
+0 g
+299.611 440.951 23.6849 0.2006 re
+f*
+1 g
+323.296 440.951 28.5022 0.2006 re
+f*
+0.498 0 0.482 rg
+351.798 440.951 58.8107 0.2006 re
+f*
+0 g
+257.259 441.152 19.6705 0.2006 re
+f*
+1 g
+276.93 441.152 3.8136 0.2006 re
+f*
+0 g
+280.743 441.152 12.4447 0.2006 re
+f*
+1 g
+293.188 441.152 6.2223 0.2006 re
+f*
+0 g
+299.41 441.152 23.4841 0.2006 re
+f*
+1 g
+322.894 441.152 28.5022 0.2006 re
+f*
+0.498 0 0.482 rg
+351.397 441.152 59.0115 0.2006 re
+f*
+0 g
+257.46 441.352 19.6705 0.2005 re
+f*
+1 g
+277.13 441.352 3.6129 0.2005 re
+f*
+0 g
+280.743 441.352 12.4447 0.2005 re
+f*
+1 g
+293.188 441.352 6.2223 0.2005 re
+f*
+0 g
+299.41 441.352 23.0827 0.2005 re
+f*
+1 g
+322.493 441.352 28.5021 0.2005 re
+f*
+0.498 0 0.482 rg
+350.995 441.352 59.413 0.2005 re
+f*
+0 g
+257.661 441.553 19.6705 0.2006 re
+f*
+1 g
+277.331 441.553 3.613 0.2006 re
+f*
+0 g
+280.944 441.553 12.4446 0.2006 re
+f*
+1 g
+293.389 441.553 5.8208 0.2006 re
+f*
+0 g
+299.209 441.553 23.0828 0.2006 re
+f*
+1 g
+322.292 441.553 28.5022 0.2006 re
+f*
+0.498 0 0.482 rg
+350.794 441.553 59.4129 0.2006 re
+f*
+0 g
+257.661 441.753 19.8713 0.2005 re
+f*
+1 g
+277.532 441.753 3.4122 0.2005 re
+f*
+0 g
+280.944 441.753 12.4446 0.2005 re
+f*
+1 g
+293.389 441.753 5.8208 0.2005 re
+f*
+0 g
+299.209 441.753 22.6813 0.2005 re
+f*
+1 g
+321.891 441.753 28.5022 0.2005 re
+f*
+0.498 0 0.482 rg
+350.393 441.753 59.6137 0.2005 re
+f*
+0 g
+257.861 441.954 19.8712 0.2006 re
+f*
+1 g
+277.732 441.954 3.4123 0.2006 re
+f*
+0 g
+281.145 441.954 12.2439 0.2006 re
+f*
+1 g
+293.389 441.954 5.6201 0.2006 re
+f*
+0 g
+299.009 441.954 22.4806 0.2006 re
+f*
+1 g
+321.489 441.954 28.5021 0.2006 re
+f*
+0.498 0 0.482 rg
+349.991 441.954 60.0152 0.2006 re
+f*
+0 g
+258.062 442.155 19.8712 0.2006 re
+f*
+1 g
+277.933 442.155 3.4122 0.2006 re
+f*
+0 g
+281.346 442.155 12.0432 0.2006 re
+f*
+1 g
+293.389 442.155 5.6201 0.2006 re
+f*
+0 g
+299.009 442.155 22.2799 0.2006 re
+f*
+1 g
+321.289 442.155 28.1007 0.2006 re
+f*
+0.498 0 0.482 rg
+349.389 442.155 60.4166 0.2006 re
+f*
+0 g
+258.263 442.355 19.8712 0.2005 re
+f*
+1 g
+278.134 442.355 3.4123 0.2005 re
+f*
+0 g
+281.546 442.355 11.8424 0.2005 re
+f*
+1 g
+293.389 442.355 5.4194 0.2005 re
+f*
+0 g
+298.808 442.355 22.0791 0.2005 re
+f*
+1 g
+320.887 442.355 28.1007 0.2005 re
+f*
+0.498 0 0.482 rg
+348.988 442.355 60.6173 0.2005 re
+f*
+0 g
+258.263 442.556 20.0719 0.2006 re
+f*
+1 g
+278.335 442.556 3.2116 0.2006 re
+f*
+0 g
+281.546 442.556 11.8424 0.2006 re
+f*
+1 g
+293.389 442.556 5.2187 0.2006 re
+f*
+0 g
+298.607 442.556 22.0792 0.2006 re
+f*
+1 g
+320.687 442.556 27.6992 0.2006 re
+f*
+0.498 0 0.482 rg
+348.386 442.556 61.0187 0.2006 re
+f*
+0 g
+258.463 442.756 20.072 0.2005 re
+f*
+1 g
+278.535 442.756 3.2114 0.2005 re
+f*
+0 g
+281.747 442.756 11.6418 0.2005 re
+f*
+1 g
+293.389 442.756 5.2187 0.2005 re
+f*
+0 g
+298.607 442.756 21.6777 0.2005 re
+f*
+1 g
+320.285 442.756 27.6992 0.2005 re
+f*
+0.498 0 0.482 rg
+347.984 442.756 61.4202 0.2005 re
+f*
+0 g
+258.664 442.957 20.0719 0.2006 re
+f*
+1 g
+278.736 442.957 3.2116 0.2006 re
+f*
+0 g
+281.948 442.957 11.441 0.2006 re
+f*
+1 g
+293.389 442.957 5.018 0.2006 re
+f*
+0 g
+298.407 442.957 21.6777 0.2006 re
+f*
+1 g
+320.084 442.957 27.2978 0.2006 re
+f*
+0.498 0 0.482 rg
+347.382 442.957 61.8216 0.2006 re
+f*
+0 g
+258.865 443.157 20.2727 0.2006 re
+f*
+1 g
+279.138 443.157 3.0108 0.2006 re
+f*
+0 g
+282.148 443.157 11.2403 0.2006 re
+f*
+1 g
+293.389 443.157 4.8173 0.2006 re
+f*
+0 g
+298.206 443.157 21.6776 0.2006 re
+f*
+1 g
+319.884 443.157 26.8965 0.2006 re
+f*
+0.498 0 0.482 rg
+346.78 443.157 62.223 0.2006 re
+f*
+0 g
+258.865 443.358 20.4734 0.2005 re
+f*
+1 g
+279.338 443.358 3.0108 0.2005 re
+f*
+0 g
+282.349 443.358 11.0396 0.2005 re
+f*
+1 g
+293.389 443.358 4.6165 0.2005 re
+f*
+0 g
+298.005 443.358 21.477 0.2005 re
+f*
+1 g
+319.482 443.358 26.6957 0.2005 re
+f*
+0.498 0 0.482 rg
+346.178 443.358 62.6245 0.2005 re
+f*
+0 g
+259.066 443.558 20.4734 0.2006 re
+f*
+1 g
+279.539 443.558 3.0108 0.2006 re
+f*
+0 g
+282.55 443.558 10.8388 0.2006 re
+f*
+1 g
+293.389 443.558 4.4158 0.2006 re
+f*
+0 g
+297.805 443.558 21.477 0.2006 re
+f*
+1 g
+319.281 443.558 26.2942 0.2006 re
+f*
+0.498 0 0.482 rg
+345.576 443.558 63.2267 0.2006 re
+f*
+0 g
+259.266 443.759 20.4733 0.2005 re
+f*
+1 g
+279.74 443.759 3.0108 0.2005 re
+f*
+0 g
+282.75 443.759 10.4375 0.2005 re
+f*
+1 g
+293.188 443.759 4.4158 0.2005 re
+f*
+0 g
+297.604 443.759 21.4769 0.2005 re
+f*
+1 g
+319.081 443.759 25.8928 0.2005 re
+f*
+0.498 0 0.482 rg
+344.973 443.759 63.6281 0.2005 re
+f*
+0 g
+259.467 443.959 20.6741 0.2006 re
+f*
+1 g
+280.141 443.959 2.8101 0.2006 re
+f*
+0 g
+282.951 443.959 10.2367 0.2006 re
+f*
+1 g
+293.188 443.959 4.2151 0.2006 re
+f*
+0 g
+297.403 443.959 21.4769 0.2006 re
+f*
+1 g
+318.88 443.959 25.6921 0.2006 re
+f*
+0.498 0 0.482 rg
+344.572 443.959 63.8288 0.2006 re
+f*
+0 g
+259.668 444.16 20.6741 0.2006 re
+f*
+1 g
+280.342 444.16 2.8101 0.2006 re
+f*
+0 g
+283.152 444.16 9.8352 0.2006 re
+f*
+1 g
+292.987 444.16 4.2152 0.2006 re
+f*
+0 g
+297.202 444.16 21.477 0.2006 re
+f*
+1 g
+318.679 444.16 25.2905 0.2006 re
+f*
+0.498 0 0.482 rg
+343.97 444.16 64.2303 0.2006 re
+f*
+0 g
+259.868 444.361 20.8748 0.2005 re
+f*
+1 g
+280.743 444.361 2.6094 0.2005 re
+f*
+0 g
+283.353 444.361 9.6345 0.2005 re
+f*
+1 g
+292.987 444.361 4.0144 0.2005 re
+f*
+0 g
+297.002 444.361 21.477 0.2005 re
+f*
+1 g
+318.479 444.361 24.8892 0.2005 re
+f*
+0.498 0 0.482 rg
+343.368 444.361 64.6317 0.2005 re
+f*
+0 g
+259.868 444.561 21.0756 0.2005 re
+f*
+1 g
+280.944 444.561 2.81 0.2005 re
+f*
+0 g
+283.754 444.561 9.0324 0.2005 re
+f*
+1 g
+292.786 444.561 4.0144 0.2005 re
+f*
+0 g
+296.801 444.561 21.477 0.2005 re
+f*
+1 g
+318.278 444.561 24.287 0.2005 re
+f*
+0.498 0 0.482 rg
+342.565 444.561 65.2339 0.2005 re
+f*
+0 g
+260.069 444.762 21.2762 0.2006 re
+f*
+1 g
+281.346 444.762 2.6094 0.2006 re
+f*
+0 g
+283.955 444.762 8.6309 0.2006 re
+f*
+1 g
+292.586 444.762 4.0144 0.2006 re
+f*
+0 g
+296.6 444.762 21.4769 0.2006 re
+f*
+1 g
+318.077 444.762 23.8857 0.2006 re
+f*
+0.498 0 0.482 rg
+341.963 444.762 65.836 0.2006 re
+f*
+0 g
+260.27 444.962 21.2763 0.2006 re
+f*
+1 g
+281.546 444.962 2.81 0.2006 re
+f*
+0 g
+284.356 444.962 8.0288 0.2006 re
+f*
+1 g
+292.385 444.962 3.8137 0.2006 re
+f*
+0 g
+296.199 444.962 21.6776 0.2006 re
+f*
+1 g
+317.876 444.962 23.4842 0.2006 re
+f*
+0.498 0 0.482 rg
+341.361 444.962 66.2374 0.2006 re
+f*
+0 g
+260.471 445.163 21.477 0.2006 re
+f*
+1 g
+281.948 445.163 2.6094 0.2006 re
+f*
+0 g
+284.557 445.163 7.6273 0.2006 re
+f*
+1 g
+292.184 445.163 3.8136 0.2006 re
+f*
+0 g
+295.998 445.163 21.6778 0.2006 re
+f*
+1 g
+317.676 445.163 23.0827 0.2006 re
+f*
+0.498 0 0.482 rg
+340.758 445.163 66.6388 0.2006 re
+f*
+0 g
+260.671 445.363 21.6777 0.2005 re
+f*
+1 g
+282.349 445.363 2.8101 0.2005 re
+f*
+0 g
+285.159 445.363 6.6237 0.2005 re
+f*
+1 g
+291.783 445.363 3.8137 0.2005 re
+f*
+0 g
+295.597 445.363 21.8784 0.2005 re
+f*
+1 g
+317.475 445.363 22.6813 0.2005 re
+f*
+0.498 0 0.482 rg
+340.156 445.363 67.0403 0.2005 re
+f*
+0 g
+260.872 445.564 21.8784 0.2006 re
+f*
+1 g
+282.75 445.564 2.8101 0.2006 re
+f*
+0 g
+285.561 445.564 5.6202 0.2006 re
+f*
+1 g
+291.181 445.564 4.0144 0.2006 re
+f*
+0 g
+295.195 445.564 22.0791 0.2006 re
+f*
+1 g
+317.274 445.564 22.2799 0.2006 re
+f*
+0.498 0 0.482 rg
+339.554 445.564 67.4417 0.2006 re
+f*
+0 g
+261.073 445.765 22.0792 0.2005 re
+f*
+1 g
+283.152 445.765 3.0108 0.2005 re
+f*
+0 g
+286.163 445.765 4.2151 0.2005 re
+f*
+1 g
+290.378 445.765 4.4158 0.2005 re
+f*
+0 g
+294.794 445.765 22.2799 0.2005 re
+f*
+1 g
+317.074 445.765 21.8784 0.2005 re
+f*
+0.498 0 0.482 rg
+338.952 445.765 67.8432 0.2005 re
+f*
+0 g
+261.073 445.965 22.4807 0.2006 re
+f*
+1 g
+283.553 445.965 3.6129 0.2006 re
+f*
+0 g
+287.166 445.965 2.2079 0.2006 re
+f*
+1 g
+289.374 445.965 5.018 0.2006 re
+f*
+0 g
+294.392 445.965 22.4805 0.2006 re
+f*
+1 g
+316.873 445.965 21.477 0.2006 re
+f*
+0.498 0 0.482 rg
+338.35 445.965 68.2446 0.2006 re
+f*
+0 g
+261.274 446.166 22.882 0.2006 re
+f*
+1 g
+284.156 446.166 9.8352 0.2006 re
+f*
+0 g
+293.991 446.166 22.6813 0.2006 re
+f*
+1 g
+316.672 446.166 21.0756 0.2006 re
+f*
+0.498 0 0.482 rg
+337.748 446.166 68.646 0.2006 re
+f*
+0 g
+261.474 446.366 23.2834 0.2005 re
+f*
+1 g
+284.758 446.366 8.631 0.2005 re
+f*
+0 g
+293.389 446.366 23.2834 0.2005 re
+f*
+1 g
+316.672 446.366 20.4734 0.2005 re
+f*
+0.498 0 0.482 rg
+337.146 446.366 69.0475 0.2005 re
+f*
+0 g
+261.675 446.567 23.6849 0.2005 re
+f*
+1 g
+285.36 446.567 7.4266 0.2005 re
+f*
+0 g
+292.786 446.567 23.6849 0.2005 re
+f*
+1 g
+316.471 446.567 19.8713 0.2005 re
+f*
+0.498 0 0.482 rg
+336.343 446.567 69.8503 0.2005 re
+f*
+0 g
+261.876 446.767 24.2871 0.2006 re
+f*
+1 g
+286.163 446.767 5.6201 0.2006 re
+f*
+0 g
+291.783 446.767 24.4878 0.2006 re
+f*
+1 g
+316.271 446.767 19.4698 0.2006 re
+f*
+0.498 0 0.482 rg
+335.74 446.767 70.2518 0.2006 re
+f*
+0 g
+262.076 446.968 25.2907 0.2006 re
+f*
+1 g
+287.367 446.968 3.2115 0.2006 re
+f*
+0 g
+290.579 446.968 25.6921 0.2006 re
+f*
+1 g
+316.271 446.968 18.8676 0.2006 re
+f*
+0.498 0 0.482 rg
+335.138 446.968 70.6533 0.2006 re
+f*
+0 g
+262.277 447.168 53.7928 0.2005 re
+f*
+1 g
+316.07 447.168 18.4662 0.2005 re
+f*
+0.498 0 0.482 rg
+334.536 447.168 71.0547 0.2005 re
+f*
+0 g
+262.478 447.369 53.3913 0.2006 re
+f*
+1 g
+315.869 447.369 18.0648 0.2006 re
+f*
+0.498 0 0.482 rg
+333.934 447.369 71.4561 0.2006 re
+f*
+0 g
+262.679 447.57 53.1906 0.2005 re
+f*
+1 g
+315.869 447.57 17.4626 0.2005 re
+f*
+0.498 0 0.482 rg
+333.332 447.57 71.8576 0.2005 re
+f*
+0 g
+262.879 447.77 52.7893 0.2006 re
+f*
+1 g
+315.669 447.77 17.0611 0.2006 re
+f*
+0.498 0 0.482 rg
+332.73 447.77 72.259 0.2006 re
+f*
+0 g
+263.08 447.971 52.5886 0.2006 re
+f*
+1 g
+315.669 447.971 16.4589 0.2006 re
+f*
+0.498 0 0.482 rg
+332.127 447.971 72.6605 0.2006 re
+f*
+0 g
+263.281 448.171 52.187 0.2006 re
+f*
+1 g
+315.468 448.171 16.0576 0.2006 re
+f*
+0.498 0 0.482 rg
+331.525 448.171 73.0618 0.2006 re
+f*
+0 g
+263.481 448.372 51.9863 0.2005 re
+f*
+1 g
+315.468 448.372 15.4554 0.2005 re
+f*
+0.498 0 0.482 rg
+330.923 448.372 73.4633 0.2005 re
+f*
+0 g
+263.682 448.572 51.5849 0.2005 re
+f*
+1 g
+315.267 448.572 15.0539 0.2005 re
+f*
+0.498 0 0.482 rg
+330.321 448.572 73.8648 0.2005 re
+f*
+0 g
+263.883 448.773 51.3842 0.2006 re
+f*
+1 g
+315.267 448.773 14.4518 0.2006 re
+f*
+0.498 0 0.482 rg
+329.719 448.773 74.2662 0.2006 re
+f*
+0 g
+264.084 448.973 50.9828 0.2006 re
+f*
+1 g
+315.066 448.973 14.2511 0.2006 re
+f*
+0.498 0 0.482 rg
+329.317 448.973 74.4669 0.2006 re
+f*
+0 g
+264.284 449.174 50.782 0.2005 re
+f*
+1 g
+315.066 449.174 13.6489 0.2005 re
+f*
+0.498 0 0.482 rg
+328.715 449.174 74.8683 0.2005 re
+f*
+0 g
+264.485 449.375 50.5813 0.2006 re
+f*
+1 g
+315.066 449.375 13.2475 0.2006 re
+f*
+0.498 0 0.482 rg
+328.314 449.375 75.069 0.2006 re
+f*
+0 g
+264.686 449.575 50.1798 0.2005 re
+f*
+1 g
+314.866 449.575 12.8461 0.2005 re
+f*
+0.498 0 0.482 rg
+327.712 449.575 75.2698 0.2005 re
+f*
+0 g
+264.886 449.776 49.9791 0.2006 re
+f*
+1 g
+314.866 449.776 12.4447 0.2006 re
+f*
+0.498 0 0.482 rg
+327.31 449.776 75.4705 0.2006 re
+f*
+0 g
+265.288 449.976 49.5776 0.2006 re
+f*
+1 g
+314.866 449.976 12.0432 0.2006 re
+f*
+0.498 0 0.482 rg
+326.909 449.976 75.6712 0.2006 re
+f*
+0 g
+265.489 450.177 49.1763 0.2005 re
+f*
+1 g
+314.665 450.177 11.8424 0.2005 re
+f*
+0.498 0 0.482 rg
+326.507 450.177 75.8719 0.2005 re
+f*
+0 g
+265.689 450.377 48.9756 0.2005 re
+f*
+1 g
+314.665 450.377 11.4409 0.2005 re
+f*
+0.498 0 0.482 rg
+326.106 450.377 76.0727 0.2005 re
+f*
+0 g
+265.89 450.578 48.7749 0.2006 re
+f*
+1 g
+314.665 450.578 11.0395 0.2006 re
+f*
+0.498 0 0.482 rg
+325.704 450.578 76.2734 0.2006 re
+f*
+0 g
+266.091 450.778 48.3733 0.2006 re
+f*
+1 g
+314.464 450.778 10.8389 0.2006 re
+f*
+0.498 0 0.482 rg
+325.303 450.778 76.4741 0.2006 re
+f*
+0 g
+266.292 450.979 48.1726 0.2006 re
+f*
+1 g
+314.464 450.979 10.4374 0.2006 re
+f*
+0.498 0 0.482 rg
+324.902 450.979 76.6748 0.2006 re
+f*
+0 g
+266.492 451.18 47.9719 0.2005 re
+f*
+1 g
+314.464 451.18 10.2367 0.2005 re
+f*
+0.498 0 0.482 rg
+324.701 451.18 76.6748 0.2005 re
+f*
+0 g
+266.693 451.38 47.7712 0.2005 re
+f*
+1 g
+314.464 451.38 9.8353 0.2005 re
+f*
+0.498 0 0.482 rg
+324.299 451.38 76.6748 0.2005 re
+f*
+0 g
+267.094 451.581 47.169 0.2006 re
+f*
+1 g
+314.263 451.581 9.8353 0.2006 re
+f*
+0.498 0 0.482 rg
+324.099 451.581 76.6748 0.2006 re
+f*
+0 g
+267.295 451.781 46.9683 0.2006 re
+f*
+1 g
+314.263 451.781 9.4338 0.2006 re
+f*
+0.498 0 0.482 rg
+323.697 451.781 76.8755 0.2006 re
+f*
+0 g
+267.496 451.982 46.7676 0.2006 re
+f*
+1 g
+314.263 451.982 9.2331 0.2006 re
+f*
+0.498 0 0.482 rg
+323.497 451.982 76.8755 0.2006 re
+f*
+0 g
+267.697 452.183 46.5669 0.2005 re
+f*
+1 g
+314.263 452.183 9.0324 0.2005 re
+f*
+0.498 0 0.482 rg
+323.296 452.183 76.6748 0.2005 re
+f*
+0 g
+268.098 452.383 46.1654 0.2005 re
+f*
+1 g
+314.263 452.383 8.6309 0.2005 re
+f*
+0.498 0 0.482 rg
+322.894 452.383 76.8756 0.2005 re
+f*
+0 g
+268.299 452.583 45.764 0.2006 re
+f*
+1 g
+314.063 452.583 8.631 0.2006 re
+f*
+0.498 0 0.482 rg
+322.694 452.583 76.8754 0.2006 re
+f*
+0 g
+268.499 452.784 45.5633 0.2006 re
+f*
+1 g
+314.063 452.784 8.4302 0.2006 re
+f*
+0.498 0 0.482 rg
+322.493 452.784 76.8755 0.2006 re
+f*
+0 g
+268.7 452.985 45.3626 0.2005 re
+f*
+1 g
+314.063 452.985 8.2295 0.2005 re
+f*
+0.498 0 0.482 rg
+322.292 452.985 76.6748 0.2005 re
+f*
+0 g
+269.102 453.185 44.9612 0.2006 re
+f*
+1 g
+314.063 453.185 8.0288 0.2006 re
+f*
+0.498 0 0.482 rg
+322.092 453.185 76.6748 0.2006 re
+f*
+0 g
+269.302 453.386 44.7604 0.2005 re
+f*
+1 g
+314.063 453.386 7.828 0.2005 re
+f*
+0.498 0 0.482 rg
+321.891 453.386 76.6748 0.2005 re
+f*
+0 g
+269.503 453.586 44.5597 0.2006 re
+f*
+1 g
+314.063 453.586 7.6274 0.2006 re
+f*
+0.498 0 0.482 rg
+321.69 453.586 76.6747 0.2006 re
+f*
+0 g
+269.904 453.787 44.1583 0.2006 re
+f*
+1 g
+314.063 453.787 7.4266 0.2006 re
+f*
+0.498 0 0.482 rg
+321.489 453.787 76.4741 0.2006 re
+f*
+0 g
+270.105 453.987 43.9576 0.2005 re
+f*
+1 g
+314.063 453.987 7.2259 0.2005 re
+f*
+0.498 0 0.482 rg
+321.289 453.987 76.4741 0.2005 re
+f*
+0 g
+270.306 454.188 43.7568 0.2006 re
+f*
+1 g
+314.063 454.188 7.2259 0.2006 re
+f*
+0.498 0 0.482 rg
+321.289 454.188 76.2734 0.2006 re
+f*
+0 g
+270.707 454.389 43.3554 0.2005 re
+f*
+1 g
+314.063 454.389 7.0252 0.2005 re
+f*
+0.498 0 0.482 rg
+321.088 454.389 76.0726 0.2005 re
+f*
+0 g
+270.908 454.589 43.1547 0.2006 re
+f*
+1 g
+314.063 454.589 6.8244 0.2006 re
+f*
+0.498 0 0.482 rg
+320.887 454.589 76.0727 0.2006 re
+f*
+0 g
+271.109 454.79 42.954 0.2006 re
+f*
+1 g
+314.063 454.79 6.6238 0.2006 re
+f*
+0.498 0 0.482 rg
+320.687 454.79 75.8719 0.2006 re
+f*
+0 g
+271.51 454.99 42.3517 0.2005 re
+f*
+1 g
+313.862 454.99 6.8246 0.2005 re
+f*
+0.498 0 0.482 rg
+320.687 454.99 75.6711 0.2005 re
+f*
+0 g
+271.711 455.191 42.151 0.2006 re
+f*
+1 g
+313.862 455.191 6.6238 0.2006 re
+f*
+0.498 0 0.482 rg
+320.486 455.191 75.6712 0.2006 re
+f*
+0 g
+272.112 455.391 41.7496 0.2005 re
+f*
+1 g
+313.862 455.391 6.4231 0.2005 re
+f*
+0.498 0 0.482 rg
+320.285 455.391 75.4705 0.2005 re
+f*
+0 g
+272.313 455.592 41.5488 0.2006 re
+f*
+1 g
+313.862 455.592 6.4231 0.2006 re
+f*
+0.498 0 0.482 rg
+320.285 455.592 75.2698 0.2006 re
+f*
+0 g
+272.715 455.792 41.1474 0.2005 re
+f*
+1 g
+313.862 455.792 6.2224 0.2005 re
+f*
+0.498 0 0.482 rg
+320.084 455.792 75.069 0.2005 re
+f*
+0 g
+272.915 455.993 41.1475 0.2006 re
+f*
+1 g
+314.063 455.993 6.0216 0.2006 re
+f*
+0.498 0 0.482 rg
+320.084 455.993 74.8683 0.2006 re
+f*
+0 g
+273.116 456.194 40.9468 0.2006 re
+f*
+1 g
+314.063 456.194 5.8208 0.2006 re
+f*
+0.498 0 0.482 rg
+319.884 456.194 74.6677 0.2006 re
+f*
+0 g
+273.517 456.394 40.5453 0.2005 re
+f*
+1 g
+314.063 456.394 5.8208 0.2005 re
+f*
+0.498 0 0.482 rg
+319.884 456.394 74.4669 0.2005 re
+f*
+0 g
+273.919 456.595 40.1439 0.2006 re
+f*
+1 g
+314.063 456.595 5.6202 0.2006 re
+f*
+0.498 0 0.482 rg
+319.683 456.595 74.2661 0.2006 re
+f*
+0 g
+274.12 456.795 39.9432 0.2005 re
+f*
+1 g
+314.063 456.795 5.6202 0.2005 re
+f*
+0.498 0 0.482 rg
+319.683 456.795 32.5165 0.2005 re
+f*
+1 g
+352.2 456.795 1.0036 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 456.795 40.5453 0.2005 re
+f*
+0 g
+274.521 456.996 39.5417 0.2006 re
+f*
+1 g
+314.063 456.996 5.4194 0.2006 re
+f*
+0.498 0 0.482 rg
+319.482 456.996 32.7173 0.2006 re
+f*
+1 g
+352.2 456.996 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 456.996 40.1439 0.2006 re
+f*
+0 g
+274.722 457.196 39.3411 0.2006 re
+f*
+1 g
+314.063 457.196 5.4194 0.2006 re
+f*
+0.498 0 0.482 rg
+319.482 457.196 32.7173 0.2006 re
+f*
+1 g
+352.2 457.196 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 457.196 39.9431 0.2006 re
+f*
+0 g
+275.123 457.397 38.9396 0.2005 re
+f*
+1 g
+314.063 457.397 5.4194 0.2005 re
+f*
+0.498 0 0.482 rg
+319.482 457.397 32.7173 0.2005 re
+f*
+1 g
+352.2 457.397 1.0036 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 457.397 39.5417 0.2005 re
+f*
+0 g
+275.324 457.597 38.7389 0.2006 re
+f*
+1 g
+314.063 457.597 5.2187 0.2006 re
+f*
+0.498 0 0.482 rg
+319.281 457.597 32.918 0.2006 re
+f*
+1 g
+352.2 457.597 1.0036 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 457.597 39.1403 0.2006 re
+f*
+0 g
+275.725 457.798 38.3375 0.2005 re
+f*
+1 g
+314.063 457.798 5.2187 0.2005 re
+f*
+0.498 0 0.482 rg
+319.281 457.798 32.7172 0.2005 re
+f*
+1 g
+351.999 457.798 1.2044 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 457.798 38.9395 0.2005 re
+f*
+0 g
+276.127 457.999 37.936 0.2006 re
+f*
+1 g
+314.063 457.999 5.2187 0.2006 re
+f*
+0.498 0 0.482 rg
+319.281 457.999 32.7172 0.2006 re
+f*
+1 g
+351.999 457.999 1.2044 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 457.999 38.5381 0.2006 re
+f*
+0 g
+276.327 458.199 37.7353 0.2006 re
+f*
+1 g
+314.063 458.199 5.0179 0.2006 re
+f*
+0.498 0 0.482 rg
+319.081 458.199 32.918 0.2006 re
+f*
+1 g
+351.999 458.199 1.2044 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 458.199 38.1367 0.2006 re
+f*
+0 g
+276.729 458.4 37.3339 0.2005 re
+f*
+1 g
+314.063 458.4 5.0179 0.2005 re
+f*
+0.498 0 0.482 rg
+319.081 458.4 32.918 0.2005 re
+f*
+1 g
+351.999 458.4 1.2044 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 458.4 37.9359 0.2005 re
+f*
+0 g
+277.13 458.6 37.1331 0.2006 re
+f*
+1 g
+314.263 458.6 4.8172 0.2006 re
+f*
+0.498 0 0.482 rg
+319.081 458.6 32.7174 0.2006 re
+f*
+1 g
+351.798 458.6 1.405 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 458.6 37.5345 0.2006 re
+f*
+0 g
+277.532 458.801 36.7316 0.2005 re
+f*
+1 g
+314.263 458.801 4.8172 0.2005 re
+f*
+0.498 0 0.482 rg
+319.081 458.801 32.7174 0.2005 re
+f*
+1 g
+351.798 458.801 1.405 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 458.801 37.1331 0.2005 re
+f*
+0 g
+277.732 459.001 36.531 0.2006 re
+f*
+1 g
+314.263 459.001 4.8172 0.2006 re
+f*
+0.498 0 0.482 rg
+319.081 459.001 32.7174 0.2006 re
+f*
+1 g
+351.798 459.001 1.405 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 459.001 36.9323 0.2006 re
+f*
+0 g
+278.134 459.202 36.1295 0.2006 re
+f*
+1 g
+314.263 459.202 4.8172 0.2006 re
+f*
+0.498 0 0.482 rg
+319.081 459.202 32.7174 0.2006 re
+f*
+1 g
+351.798 459.202 1.405 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 459.202 36.5309 0.2006 re
+f*
+0 g
+278.535 459.403 35.728 0.2005 re
+f*
+1 g
+314.263 459.403 4.6165 0.2005 re
+f*
+0.498 0 0.482 rg
+318.88 459.403 32.7173 0.2005 re
+f*
+1 g
+351.597 459.403 1.6058 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 459.403 36.1295 0.2005 re
+f*
+0 g
+278.736 459.603 35.5274 0.2005 re
+f*
+1 g
+314.263 459.603 4.6165 0.2005 re
+f*
+0.498 0 0.482 rg
+318.88 459.603 32.7173 0.2005 re
+f*
+1 g
+351.597 459.603 1.6058 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 459.603 35.7281 0.2005 re
+f*
+0 g
+279.138 459.804 35.3266 0.2006 re
+f*
+1 g
+314.464 459.804 4.4158 0.2006 re
+f*
+0.498 0 0.482 rg
+318.88 459.804 32.7173 0.2006 re
+f*
+1 g
+351.597 459.804 1.6058 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 459.804 35.3266 0.2006 re
+f*
+0 g
+279.539 460.004 34.9251 0.2006 re
+f*
+1 g
+314.464 460.004 4.4158 0.2006 re
+f*
+0.498 0 0.482 rg
+318.88 460.004 32.7173 0.2006 re
+f*
+1 g
+351.597 460.004 1.6058 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 460.004 34.9251 0.2006 re
+f*
+0 g
+279.94 460.205 34.5237 0.2006 re
+f*
+1 g
+314.464 460.205 4.4158 0.2006 re
+f*
+0.498 0 0.482 rg
+318.88 460.205 32.5166 0.2006 re
+f*
+1 g
+351.397 460.205 1.8065 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 460.205 34.7245 0.2006 re
+f*
+0 g
+280.342 460.405 34.1223 0.2005 re
+f*
+1 g
+314.464 460.405 4.4158 0.2005 re
+f*
+0.498 0 0.482 rg
+318.88 460.405 32.5166 0.2005 re
+f*
+1 g
+351.397 460.405 1.8065 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 460.405 34.323 0.2005 re
+f*
+0 g
+280.743 460.606 33.9217 0.2006 re
+f*
+1 g
+314.665 460.606 4.215 0.2006 re
+f*
+0.498 0 0.482 rg
+318.88 460.606 32.5166 0.2006 re
+f*
+1 g
+351.397 460.606 1.8065 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 460.606 33.9215 0.2006 re
+f*
+0 g
+281.145 460.806 33.5202 0.2005 re
+f*
+1 g
+314.665 460.806 4.215 0.2005 re
+f*
+0.498 0 0.482 rg
+318.88 460.806 32.3159 0.2005 re
+f*
+1 g
+351.196 460.806 2.0072 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 460.806 33.5201 0.2005 re
+f*
+0 g
+281.546 461.007 33.1187 0.2006 re
+f*
+1 g
+314.665 461.007 4.215 0.2006 re
+f*
+0.498 0 0.482 rg
+318.88 461.007 32.3159 0.2006 re
+f*
+1 g
+351.196 461.007 2.0072 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 461.007 33.1186 0.2006 re
+f*
+0 g
+281.948 461.208 32.7173 0.2006 re
+f*
+1 g
+314.665 461.208 4.215 0.2006 re
+f*
+0.498 0 0.482 rg
+318.88 461.208 32.3159 0.2006 re
+f*
+1 g
+351.196 461.208 2.0072 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 461.208 32.7172 0.2006 re
+f*
+0 g
+282.349 461.408 32.3159 0.2005 re
+f*
+1 g
+314.665 461.408 4.215 0.2005 re
+f*
+0.498 0 0.482 rg
+318.88 461.408 32.1151 0.2005 re
+f*
+1 g
+350.995 461.408 2.208 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 461.408 32.3158 0.2005 re
+f*
+0 g
+282.75 461.609 32.1151 0.2005 re
+f*
+1 g
+314.866 461.609 4.0144 0.2005 re
+f*
+0.498 0 0.482 rg
+318.88 461.609 32.1151 0.2005 re
+f*
+1 g
+350.995 461.609 2.208 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 461.609 31.9143 0.2005 re
+f*
+0 g
+283.152 461.809 31.7136 0.2006 re
+f*
+1 g
+314.866 461.809 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+318.88 461.809 32.1151 0.2006 re
+f*
+1 g
+350.995 461.809 2.208 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 461.809 31.5129 0.2006 re
+f*
+0 g
+283.553 462.01 31.3121 0.2006 re
+f*
+1 g
+314.866 462.01 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+318.88 462.01 31.9145 0.2006 re
+f*
+1 g
+350.794 462.01 2.4086 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 462.01 31.1115 0.2006 re
+f*
+0 g
+283.955 462.21 31.1115 0.2005 re
+f*
+1 g
+315.066 462.21 3.8136 0.2005 re
+f*
+0.498 0 0.482 rg
+318.88 462.21 31.9145 0.2005 re
+f*
+1 g
+350.794 462.21 2.4086 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 462.21 30.7101 0.2005 re
+f*
+0 g
+284.356 462.411 30.7101 0.2006 re
+f*
+1 g
+315.066 462.411 3.8136 0.2006 re
+f*
+0.498 0 0.482 rg
+318.88 462.411 31.9145 0.2006 re
+f*
+1 g
+350.794 462.411 2.4086 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 462.411 30.1079 0.2006 re
+f*
+0 g
+284.758 462.611 30.5094 0.2005 re
+f*
+1 g
+315.267 462.611 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+318.88 462.611 31.7137 0.2005 re
+f*
+1 g
+350.594 462.611 2.6094 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 462.611 29.7065 0.2005 re
+f*
+0 g
+285.36 462.812 29.9072 0.2006 re
+f*
+1 g
+315.267 462.812 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+318.88 462.812 31.7137 0.2006 re
+f*
+1 g
+350.594 462.812 2.6094 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 462.812 29.305 0.2006 re
+f*
+0 g
+285.761 463.013 29.5058 0.2006 re
+f*
+1 g
+315.267 463.013 3.6129 0.2006 re
+f*
+0.498 0 0.482 rg
+318.88 463.013 31.7137 0.2006 re
+f*
+1 g
+350.594 463.013 2.6094 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 463.013 28.9035 0.2006 re
+f*
+0 g
+286.163 463.213 29.305 0.2006 re
+f*
+1 g
+315.468 463.213 3.4122 0.2006 re
+f*
+0.498 0 0.482 rg
+318.88 463.213 31.513 0.2006 re
+f*
+1 g
+350.393 463.213 2.8101 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 463.213 28.5021 0.2006 re
+f*
+0 g
+286.564 463.414 28.9036 0.2005 re
+f*
+1 g
+315.468 463.414 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+319.081 463.414 31.3123 0.2005 re
+f*
+1 g
+350.393 463.414 2.8101 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 463.414 27.9 0.2005 re
+f*
+0 g
+287.166 463.614 28.3014 0.2005 re
+f*
+1 g
+315.468 463.614 3.6129 0.2005 re
+f*
+0.498 0 0.482 rg
+319.081 463.614 31.1116 0.2005 re
+f*
+1 g
+350.192 463.614 3.0108 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 463.614 27.4985 0.2005 re
+f*
+0 g
+287.568 463.815 28.1008 0.2006 re
+f*
+1 g
+315.669 463.815 3.4121 0.2006 re
+f*
+0.498 0 0.482 rg
+319.081 463.815 31.1116 0.2006 re
+f*
+1 g
+350.192 463.815 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 463.815 27.0971 0.2006 re
+f*
+0 g
+287.969 464.015 27.6994 0.2006 re
+f*
+1 g
+315.669 464.015 3.4121 0.2006 re
+f*
+0.498 0 0.482 rg
+319.081 464.015 30.9108 0.2006 re
+f*
+1 g
+349.991 464.015 3.2116 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 464.015 26.495 0.2006 re
+f*
+0 g
+288.571 464.216 27.2978 0.2005 re
+f*
+1 g
+315.869 464.216 3.2115 0.2005 re
+f*
+0.498 0 0.482 rg
+319.081 464.216 30.9108 0.2005 re
+f*
+1 g
+349.991 464.216 3.2116 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 464.216 26.0935 0.2005 re
+f*
+0 g
+288.973 464.416 26.8964 0.2006 re
+f*
+1 g
+315.869 464.416 3.2115 0.2006 re
+f*
+0.498 0 0.482 rg
+319.081 464.416 30.7102 0.2006 re
+f*
+1 g
+349.791 464.416 3.4122 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 464.416 25.4914 0.2006 re
+f*
+0 g
+289.575 464.617 26.495 0.2005 re
+f*
+1 g
+316.07 464.617 3.2115 0.2005 re
+f*
+0.498 0 0.482 rg
+319.281 464.617 30.5094 0.2005 re
+f*
+1 g
+349.791 464.617 3.4122 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 464.617 25.0899 0.2005 re
+f*
+0 g
+289.976 464.818 26.0936 0.2006 re
+f*
+1 g
+316.07 464.818 3.2115 0.2006 re
+f*
+0.498 0 0.482 rg
+319.281 464.818 30.3086 0.2006 re
+f*
+1 g
+349.59 464.818 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 464.818 24.4878 0.2006 re
+f*
+0 g
+290.579 465.018 25.6921 0.2006 re
+f*
+1 g
+316.271 465.018 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+319.281 465.018 30.3086 0.2006 re
+f*
+1 g
+349.59 465.018 3.613 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 465.018 24.0863 0.2006 re
+f*
+0 g
+291.181 465.219 25.0899 0.2005 re
+f*
+1 g
+316.271 465.219 3.0108 0.2005 re
+f*
+0.498 0 0.482 rg
+319.281 465.219 30.1079 0.2005 re
+f*
+1 g
+349.389 465.219 3.8137 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 465.219 23.4842 0.2005 re
+f*
+0 g
+291.582 465.419 24.8892 0.2005 re
+f*
+1 g
+316.471 465.419 3.0108 0.2005 re
+f*
+0.498 0 0.482 rg
+319.482 465.419 29.9072 0.2005 re
+f*
+1 g
+349.389 465.419 3.8137 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 465.419 22.882 0.2005 re
+f*
+0 g
+292.184 465.62 24.287 0.2006 re
+f*
+1 g
+316.471 465.62 3.0108 0.2006 re
+f*
+0.498 0 0.482 rg
+319.482 465.62 29.7065 0.2006 re
+f*
+1 g
+349.189 465.62 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 465.62 22.4806 0.2006 re
+f*
+0 g
+292.786 465.82 23.8856 0.2006 re
+f*
+1 g
+316.672 465.82 2.8101 0.2006 re
+f*
+0.498 0 0.482 rg
+319.482 465.82 29.7065 0.2006 re
+f*
+1 g
+349.189 465.82 4.0144 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 465.82 21.8784 0.2006 re
+f*
+0 g
+293.389 466.021 23.2834 0.2006 re
+f*
+1 g
+316.672 466.021 3.0109 0.2006 re
+f*
+0.498 0 0.482 rg
+319.683 466.021 29.3049 0.2006 re
+f*
+1 g
+348.988 466.021 4.2152 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 466.021 21.2762 0.2006 re
+f*
+0 g
+293.79 466.222 23.0827 0.2005 re
+f*
+1 g
+316.873 466.222 2.8102 0.2005 re
+f*
+0.498 0 0.482 rg
+319.683 466.222 29.3049 0.2005 re
+f*
+1 g
+348.988 466.222 4.2152 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 466.222 20.6741 0.2005 re
+f*
+0 g
+294.392 466.422 22.6813 0.2006 re
+f*
+1 g
+317.074 466.422 2.6094 0.2006 re
+f*
+0.498 0 0.482 rg
+319.683 466.422 29.1043 0.2006 re
+f*
+1 g
+348.787 466.422 4.4158 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 466.422 20.0719 0.2006 re
+f*
+0 g
+295.195 466.623 21.8784 0.2005 re
+f*
+1 g
+317.074 466.623 2.81 0.2005 re
+f*
+0.498 0 0.482 rg
+319.884 466.623 28.7029 0.2005 re
+f*
+1 g
+348.586 466.623 4.6166 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 466.623 19.4698 0.2005 re
+f*
+0 g
+295.797 466.823 21.477 0.2006 re
+f*
+1 g
+317.274 466.823 2.6093 0.2006 re
+f*
+0.498 0 0.482 rg
+319.884 466.823 28.7029 0.2006 re
+f*
+1 g
+348.586 466.823 4.6166 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 466.823 18.8676 0.2006 re
+f*
+0 g
+296.399 467.024 20.8748 0.2006 re
+f*
+1 g
+317.274 467.024 2.8101 0.2006 re
+f*
+0.498 0 0.482 rg
+320.084 467.024 28.3014 0.2006 re
+f*
+1 g
+348.386 467.024 4.8173 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 467.024 18.2654 0.2006 re
+f*
+0 g
+297.002 467.224 20.4734 0.2005 re
+f*
+1 g
+317.475 467.224 2.6094 0.2005 re
+f*
+0.498 0 0.482 rg
+320.084 467.224 28.1007 0.2005 re
+f*
+1 g
+348.185 467.224 5.018 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 467.224 17.6633 0.2005 re
+f*
+0 g
+297.604 467.425 20.072 0.2005 re
+f*
+1 g
+317.676 467.425 2.6093 0.2005 re
+f*
+0.498 0 0.482 rg
+320.285 467.425 27.9 0.2005 re
+f*
+1 g
+348.185 467.425 5.018 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 467.425 17.0611 0.2005 re
+f*
+0 g
+298.206 467.625 19.6704 0.2006 re
+f*
+1 g
+317.876 467.625 2.4087 0.2006 re
+f*
+0.498 0 0.482 rg
+320.285 467.625 27.6992 0.2006 re
+f*
+1 g
+347.984 467.625 5.2188 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 467.625 16.2582 0.2006 re
+f*
+0 g
+299.009 467.826 18.8676 0.2006 re
+f*
+1 g
+317.876 467.826 2.6094 0.2006 re
+f*
+0.498 0 0.482 rg
+320.486 467.826 27.2979 0.2006 re
+f*
+1 g
+347.784 467.826 5.4194 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 467.826 15.6561 0.2006 re
+f*
+0 g
+299.611 468.027 18.4661 0.2005 re
+f*
+1 g
+318.077 468.027 2.6095 0.2005 re
+f*
+0.498 0 0.482 rg
+320.687 468.027 26.8963 0.2005 re
+f*
+1 g
+347.583 468.027 5.6202 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 468.027 14.8532 0.2005 re
+f*
+0 g
+300.414 468.227 17.864 0.2006 re
+f*
+1 g
+318.278 468.227 2.4087 0.2006 re
+f*
+0.498 0 0.482 rg
+320.687 468.227 26.8963 0.2006 re
+f*
+1 g
+347.583 468.227 5.6202 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 468.227 14.2511 0.2006 re
+f*
+0 g
+301.217 468.428 17.2619 0.2005 re
+f*
+1 g
+318.479 468.428 2.4086 0.2005 re
+f*
+0.498 0 0.482 rg
+320.887 468.428 26.495 0.2005 re
+f*
+1 g
+347.382 468.428 5.8209 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 468.428 13.4482 0.2005 re
+f*
+0 g
+301.819 468.628 16.6597 0.2006 re
+f*
+1 g
+318.479 468.628 2.6094 0.2006 re
+f*
+0.498 0 0.482 rg
+321.088 468.628 26.0935 0.2006 re
+f*
+1 g
+347.181 468.628 6.0216 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 468.628 12.6453 0.2006 re
+f*
+0 g
+302.622 468.829 16.0576 0.2006 re
+f*
+1 g
+318.679 468.829 2.4086 0.2006 re
+f*
+0.498 0 0.482 rg
+321.088 468.829 25.8927 0.2006 re
+f*
+1 g
+346.981 468.829 6.2224 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 468.829 11.8424 0.2006 re
+f*
+0 g
+303.425 469.029 15.4553 0.2005 re
+f*
+1 g
+318.88 469.029 2.4087 0.2005 re
+f*
+0.498 0 0.482 rg
+321.289 469.029 25.4914 0.2005 re
+f*
+1 g
+346.78 469.029 6.423 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 469.029 11.2403 0.2005 re
+f*
+0 g
+304.227 469.23 14.8532 0.2006 re
+f*
+1 g
+319.081 469.23 2.4087 0.2006 re
+f*
+0.498 0 0.482 rg
+321.489 469.23 25.0899 0.2006 re
+f*
+1 g
+346.579 469.23 6.6238 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 469.23 10.4374 0.2006 re
+f*
+0 g
+305.231 469.43 14.0504 0.2005 re
+f*
+1 g
+319.281 469.43 2.4087 0.2005 re
+f*
+0.498 0 0.482 rg
+321.69 469.43 24.8891 0.2005 re
+f*
+1 g
+346.579 469.43 6.6238 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 469.43 9.4338 0.2005 re
+f*
+0 g
+306.034 469.631 13.4482 0.2006 re
+f*
+1 g
+319.482 469.631 2.4086 0.2006 re
+f*
+0.498 0 0.482 rg
+321.891 469.631 24.4878 0.2006 re
+f*
+1 g
+346.379 469.631 6.8245 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 469.631 8.6309 0.2006 re
+f*
+0 g
+306.837 469.832 12.8461 0.2006 re
+f*
+1 g
+319.683 469.832 2.4086 0.2006 re
+f*
+0.498 0 0.482 rg
+322.092 469.832 24.0863 0.2006 re
+f*
+1 g
+346.178 469.832 7.0252 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 469.832 7.6273 0.2006 re
+f*
+0 g
+307.841 470.032 12.0431 0.2005 re
+f*
+1 g
+319.884 470.032 2.4087 0.2005 re
+f*
+0.498 0 0.482 rg
+322.292 470.032 23.6848 0.2005 re
+f*
+1 g
+345.977 470.032 7.226 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 470.032 6.8244 0.2005 re
+f*
+0 g
+308.844 470.233 11.2403 0.2006 re
+f*
+1 g
+320.084 470.233 2.4086 0.2006 re
+f*
+0.498 0 0.482 rg
+322.493 470.233 23.2835 0.2006 re
+f*
+1 g
+345.776 470.233 7.4266 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 470.233 5.6201 0.2006 re
+f*
+0 g
+309.848 470.433 10.4374 0.2005 re
+f*
+1 g
+320.285 470.433 2.4087 0.2005 re
+f*
+0.498 0 0.482 rg
+322.694 470.433 22.6812 0.2005 re
+f*
+1 g
+345.375 470.433 7.8281 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 470.433 4.6165 0.2005 re
+f*
+0 g
+311.052 470.634 9.4338 0.2006 re
+f*
+1 g
+320.486 470.634 2.4086 0.2006 re
+f*
+0.498 0 0.482 rg
+322.894 470.634 22.2799 0.2006 re
+f*
+1 g
+345.174 470.634 8.0288 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 470.634 3.6129 0.2006 re
+f*
+0 g
+312.256 470.834 8.4303 0.2005 re
+f*
+1 g
+320.687 470.834 2.4086 0.2005 re
+f*
+0.498 0 0.482 rg
+323.095 470.834 21.8783 0.2005 re
+f*
+1 g
+344.973 470.834 8.2296 0.2005 re
+f*
+0.498 0 0.482 rg
+353.203 470.834 2.4086 0.2005 re
+f*
+0 g
+313.461 471.035 7.6274 0.2006 re
+f*
+1 g
+321.088 471.035 2.2079 0.2006 re
+f*
+0.498 0 0.482 rg
+323.296 471.035 21.477 0.2006 re
+f*
+1 g
+344.773 471.035 8.4302 0.2006 re
+f*
+0.498 0 0.482 rg
+353.203 471.035 1.2043 0.2006 re
+f*
+0 g
+314.665 471.235 6.6237 0.2006 re
+f*
+1 g
+321.289 471.235 2.4086 0.2006 re
+f*
+0.498 0 0.482 rg
+323.697 471.235 20.8748 0.2006 re
+f*
+0 g
+316.271 471.436 5.2187 0.2005 re
+f*
+1 g
+321.489 471.436 2.4086 0.2005 re
+f*
+0.498 0 0.482 rg
+323.898 471.436 20.2727 0.2005 re
+f*
+0 g
+317.676 471.637 4.215 0.2006 re
+f*
+1 g
+321.891 471.637 2.208 0.2006 re
+f*
+0.498 0 0.482 rg
+324.099 471.637 19.8711 0.2006 re
+f*
+0 g
+319.482 471.837 2.6094 0.2006 re
+f*
+1 g
+322.092 471.837 2.4086 0.2006 re
+f*
+0.498 0 0.482 rg
+324.5 471.837 19.0683 0.2006 re
+f*
+0 g
+321.289 472.038 0.8029 0.2005 re
+f*
+1 g
+322.092 472.038 2.6093 0.2005 re
+f*
+0.498 0 0.482 rg
+324.701 472.038 18.6669 0.2005 re
+f*
+0.498 0 0.482 rg
+325.102 472.238 17.864 0.2006 re
+f*
+0.498 0 0.482 rg
+325.504 472.439 17.2619 0.2005 re
+f*
+0.498 0 0.482 rg
+325.905 472.639 16.459 0.2006 re
+f*
+0.498 0 0.482 rg
+326.307 472.84 15.6561 0.2006 re
+f*
+0.498 0 0.482 rg
+326.909 473.041 14.6526 0.2005 re
+f*
+0.498 0 0.482 rg
+327.511 473.241 13.4482 0.2006 re
+f*
+0.498 0 0.482 rg
+328.113 473.442 12.4447 0.2005 re
+f*
+0.498 0 0.482 rg
+328.715 473.642 11.2403 0.2006 re
+f*
+0.498 0 0.482 rg
+329.518 473.843 9.8352 0.2005 re
+f*
+0.498 0 0.482 rg
+330.321 474.043 8.2296 0.2006 re
+f*
+0.498 0 0.482 rg
+331.525 474.244 6.0216 0.2006 re
+f*
+0.498 0 0.482 rg
+333.533 474.445 2.2079 0.2005 re
+f*
+Q
+showpage
+pdfEndPage
+end
+%%Trailer
+cleartomark
+countdictstack
+exch sub { end } repeat
+restore
+%%EOF
Package: freeside
Architecture: any
Depends: freeside-lib
-Recommends: freeside-doc, freeside-ui-web, libterm-query-perl
-Suggests: freeside-passwd-server, freeside-signup-server, freeside-session-server, freeside-selfservice-server
+Recommends: freeside-doc, freeside-ui-web
+Suggests: freeside-selfservice-server
Description: Billing and administration package for ISPs.
Freeside is a billing and account administration package for ISPs. It stores
customer information in an SQL database, and will update UNIX passwd and
This package contains the libraries which implement the business logic and
backend functions of Freeside, a billing and account administration package
for ISPs. This package also contains the manual pages for the library API.
+ (? like a libmodule-perl package)
Package: freeside-ui-web
Architecture: all
-Depends: libstring-approx-perl, freeside-lib, libapache-mod-perl|apache-perl
+Depends: libhtml-mason-perl, libstring-approx-perl, freeside-lib, libapache-mod-perl|apache-perl
Suggests: libapache-mod-ssl|apache-ssl
Description: Easy-to-use web interface for Freeside
This package contains the web interface for Freeside, a billing and account
administration package for ISPs. This is what sales or support folks will
typically use to add new accounts, edit exiting accounts and so on.
-Package: freeside-passwd-server
-Architecture: all
-Depends: freeside-lib
-Description: Freeside password server
- This component of Freeside, a billing and account administration package for
- ISPs,
-
-Package: freeside-passwd-client
-Architecture: all
-Depends:
-Description:
- <rar>
-
-Package: freeside-signup-server
-Architecture: all
-Depends: freeside-lib
-Description:
- <rar>
-
-Package: freeside-signup-client
-Architecture: all
-Depends:
-Description:
- <rar>
-
-Package: freeside-signup-client-webui
-Architecture: all
-Depends: freeside-signup-client-lib, httpd
-Description:
- <rar>
-
-Package: freeside-session-server
+Package: freeside-selfservice-server
Architecture: all
-Depends: freeside-lib
+Depends: freeside-lib, libnet-ssh-perl, ssh
Description:
- <rar>
+ This package contains the server side of the customer self-service interface.
+ It is installed on a private backend machine, and opens an outgoing ssh
+ connection to one or more public web server(s).
-Package: freeside-session-client
+Package: freeside-selfservice-client
Architecture: all
-Depends: ssh
-Description:
- <rar>
-
-Package: freeside-selfservice-server
-Architecture: all
-Depends:
+Depends: libstorable-perl, libhttp-browserdetect-perl, libbusiness-creditcard-perl, ssh
Description:
- <rar>
-
+ This package contains the client side of the customer self-service interface.
+ It is typically installed on a public webserver and interfaces with
+ freeside-selfservice-server installed on a private backend machine.
package FS::part_export::myexport;
-use vars qw(@ISA);
+use vars qw(@ISA %info);
+use Tie::IxHash;
use FS::part_export;
@ISA = qw(FS::part_export);
+tie my %options, 'Tie::IxHash',
+ 'regular_option' => { label => 'Option description', default => 'value' },
+ 'select_option' => { label => 'Select option description',
+ type => 'select', options=>[qw(chocolate vanilla)],
+ default => 'vanilla',
+ },
+ 'textarea_option' => { label => 'Textarea option description',
+ type => 'textarea',
+ default => 'Default text.',
+ },
+ 'checkbox_option' => { label => 'Checkbox label', type => 'checkbox' },
+;
+
+%info = (
+ 'svc' => 'svc_acct',
+ #'svc' => [qw( svc_acct svc_forward )],
+ 'desc' =>
+ 'Export short description',
+ 'options' => \%options,
+ 'nodomain' => 'Y',
+ 'notes' => <<'END'
+HTML notes about this export.
+END
+
sub rebless { shift; }
sub _export_insert {
use strict;
use Getopt::Std;
-use Socket;
-use IO::Handle;
+use FS::SelfService qw(passwd);
use CGI;
use CGI::Carp qw(fatalsToBrowser);
-my $fs_passwdd_socket = "/usr/local/freeside/fs_passwdd_socket";
my $freeside_uid = scalar(getpwnam('freeside'));
$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
$cgi->param('username') =~ /^([^\n]{0,255}$)/ or die "Illegal username";
my $me = $1;
+$cgi->param('domain') =~ /^([^\n]{0,255}$)/ or die "Illegal domain";
+my $domain = $1;
+
$cgi->param('old_password') =~ /^([^\n]{0,255}$)/ or die "Illegal old_password";
my $old_password = $1;
die "New passwords don't match"
unless $new_password eq $cgi->param('new_password2');
-socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
-connect(SOCK, sockaddr_un($fs_passwdd_socket)) or die "connect: $!";
-print SOCK join("\n", $me, $old_password, $new_password, '', ''), "\n";
-SOCK->flush;
-my $error = <SOCK>;
-chomp $error;
+my $rv = passwd(
+ 'username' => $me,
+ 'domain' => $domain,
+ 'old_password' => $old_password,
+ 'new_password' => $new_password,
+);
+
+my $error = $rv->{error};
if ($error) {
die $error;
<tr><th align="right">Username</th>
<td><input type="text" name="username" size="18"></td>
</tr>
+ <tr><th align="right">Domain</th>
+ <td><input type="text" name="domain" size="18"></td>
+ </tr>
<tr><th align="right">Current password</th>
<td><input type="password" name="old_password" size="18"></td>
</tr>
WriteMakefile(
'NAME' => 'FS::SelfService',
'VERSION_FROM' => 'SelfService.pm', # finds $VERSION
- 'EXE_FILES' => [ 'freeside-selfservice-clientd' ],
+ 'EXE_FILES' => [ 'freeside-selfservice-clientd',
+ #'freeside-selfservice-xmlrpc-server',
+ ],
'INSTALLSCRIPT' => '/usr/local/sbin',
'INSTALLSITEBIN' => '/usr/local/sbin',
'PERM_RWX' => '750',
'PREREQ_PM' => {
- 'Storable' => 0,
+ 'Storable' => 2.09,
}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'SelfService.pm', # retrieve abstract from module
use FileHandle;
#use IO::Handle;
use IO::Select;
-use Storable qw(nstore_fd fd_retrieve);
+use Storable 2.09 qw(nstore_fd fd_retrieve);
$VERSION = '0.03';
'list_pkgs' => 'MyAccount/list_pkgs',
'order_pkg' => 'MyAccount/order_pkg',
'cancel_pkg' => 'MyAccount/cancel_pkg',
+ 'charge' => 'MyAccount/charge',
'signup_info' => 'Signup/signup_info',
'new_customer' => 'Signup/new_customer',
);
use Fcntl qw(:flock);
use POSIX qw(:sys_wait_h);
use Socket;
-use Storable qw(nstore_fd fd_retrieve);
+use Storable 2.09 qw(nstore_fd fd_retrieve);
use IO::Handle qw(_IONBF);
use IO::Select;
use IO::File;
my $tag = scalar(@ARGV) ? '.'.shift : '';
use vars qw( $Debug );
-$Debug = 2; #2 will turn on child logging, 3 will log packet contents,
- #including potentially compromising information
+$Debug = 2; #2 will turn on child logging
+ #3 will log packet contents,#including passwords
+ #4 will log receipts of all packets from server including
+ # keepalives (big!)
my $socket = "/usr/local/freeside/selfservice_socket$tag";
my $pid_file = "$socket.pid";
warn "Creating $lock_file\n" if $Debug;
open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!";
+close LOCKFILE;
warn "Creating $socket\n" if $Debug;
my $uaddr = sockaddr_un($socket);
#sub REAPER { $waitedpid = wait; $SIG{CHLD} = \&REAPER; }
#$SIG{CHLD} = \&REAPER;
+warn "enabling keep alives\n" if $Debug;
+nstore_fd( { _packet => '_enable_keepalive' } , \*STDOUT );
+
warn "entering main loop\n" if $Debug;
my %kids;
if ( $handle == \*STDIN ) {
- warn "receiving packet from server\n" if $Debug;
+ warn "receiving packet from server\n" if $Debug > 3;
my $packet = fd_retrieve(\*STDIN);
my $token = $packet->{'_token'};
+
+ if ( $token eq '_keepalive' ) {
+ $undisp = 1;
+ next;
+ }
+
warn "received packet from server with token $token\n".
( $Debug > 2
? join('', map { " $_=>$packet->{$_}\n" } keys %$packet )
sub _logmsg {
chomp( my $msg = shift );
my $log = new IO::File ">>$log_file";
+ die "can't open $log_file: $!" unless defined($log);
flock($log, LOCK_EX);
seek($log, 0, 2);
print $log "[client] [". scalar(localtime). "] [$$] $msg\n";
#broken on freebsd?
#flock(STDOUT, LOCK_EX) or die "FATAL: can't lock write stream: $!";
+ #open a new one for each kid to get a unique lock
+ open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!";
+
flock(LOCKFILE, LOCK_EX) or die "FATAL: can't lock $lock_file: $!";
}
<HTML><HEAD><TITLE>ISP Signup form</TITLE></HEAD>
<BODY BGCOLOR="#e8e8e8"><FONT SIZE=7>ISP Signup form</FONT><BR><BR>
<FONT SIZE="+1" COLOR="#ff0000"><%= $error %></FONT>
-<FORM ACTION="<%= $self_url %>" METHOD=POST>
+<FORM NAME="OneTrueForm" ACTION="<%= $self_url %>" METHOD=POST onSubmit="document.OneTrueForm.signup.disabled=true">
<INPUT TYPE="hidden" NAME="magic" VALUE="process">
<INPUT TYPE="hidden" NAME="ref" VALUE="<%= $referral_custnum %>">
<INPUT TYPE="hidden" NAME="ss" VALUE="">
}
%>
</TABLE>
-<BR><BR><INPUT TYPE="submit" VALUE="Signup">
+<BR><BR><INPUT TYPE="submit" NAME="signup" VALUE="Signup" >
</FORM></BODY></HTML>
+#!/usr/bin/perl -T
#!/usr/bin/perl -Tw
#
-# $Id: signup.cgi,v 1.29.2.21 2004-01-04 03:52:57 ivan Exp $
+# $Id: signup.cgi,v 1.29.2.22 2004-10-01 01:38:03 ivan Exp $
use strict;
use vars qw( @payby $cgi $locales $packages
//--></script>
<FONT SIZE=7>ISP Signup form</FONT><BR><BR>
<FONT SIZE="+1" COLOR="#ff0000"><%= $error %></FONT>
-<FORM ACTION="<%= $self_url %>" METHOD=POST>
+<FORM NAME="OneTrueForm" ACTION="<%= $self_url %>" METHOD=POST onSubmit="document.OneTrueForm.signup.disabled=true">
<INPUT TYPE="hidden" NAME="magic" VALUE="process">
<INPUT TYPE="hidden" NAME="ref" VALUE="<%= $referral_custnum %>">
<INPUT TYPE="hidden" NAME="ss" VALUE="">
}
%>
</TABLE>
-<BR><BR><INPUT TYPE="submit" VALUE="Signup">
+<BR><BR><INPUT TYPE="submit" NAME="signup" VALUE="Signup">
</FORM></BODY></HTML>
}
</SCRIPT>
<FORM>
-Select your state:
+Select your state from the map or dropdown:
+<MAP NAME=usmap>
+<area shape=poly COORDS="264,157,286,155,292,193,276,195,270,199,264,157" href="signup.cgi?init_popstate=AL">
+<area shape=poly COORDS="28,197,46,185,72,199,72,241,88,243,102,261,92,263,70,241,42,243,28,257,12,259,34,243,20,233,16,223,34,215,22,207,30,205,28,197" href="../states/Alaska.html">
+<area shape=poly COORDS="70,137,106,137,100,189,84,187,60,173,70,133,70,137,70,137" href="signup.cgi?init_popstate=AZ">
+<area shape=poly COORDS="250,153,242,179,220,177,218,171,216,145,252,143,250,155,250,153" href="signup.cgi?init_popstate=AR">
+<area shape=poly COORDS="10,79,38,81,30,109,62,151,56,173,40,169,20,145,4,101,10,75,26,79,10,79,10,79" href="signup.cgi?init_popstate=CA">
+<area shape=poly COORDS="108,103,158,107,154,141,104,137,110,101,128,103,108,103" href="signup.cgi?init_popstate=CO">
+<area shape=poly COORDS="374,107,405,105,405,123,372,125,374,107" href="signup.cgi?init_popstate=CT">
+<area shape=poly COORDS="370,143,402,145,405,157,362,157,370,143" href="signup.cgi?init_popstate=DE">
+<area shape=poly COORDS="275,193,325,187,327,197,341,219,341,233,335,237,317,215,315,205,307,195,293,203,275,193" href="signup.cgi?init_popstate=FL">
+<area shape=poly COORDS="297,153,283,155,297,191,321,189,321,169,297,153" href="signup.cgi?init_popstate=GA">
+<area shape=poly COORDS="98,233,142,263,156,251,162,239,164,229,136,231,94,221,100,235,98,233" href="signup.cgi?init_popstate=HI">
+<area shape=poly COORDS="68,21,76,21,72,35,80,47,80,55,84,65,100,69,94,93,56,83,66,51,70,19,68,21" href="signup.cgi?init_popstate=ID">
+<area shape=poly COORDS="242,91,258,89,266,123,256,139,234,109,248,87,242,91" href="signup.cgi?init_popstate=IL">
+<area shape=poly COORDS="261,95,265,123,265,131,285,117,277,91,261,95" href="signup.cgi?init_popstate=IN">
+<area shape=poly COORDS="198,87,206,111,232,109,240,99,240,91,232,79,198,87" href="signup.cgi?init_popstate=IA">
+<area shape=poly COORDS="158,111,158,135,214,139,214,127,208,113,158,111" href="signup.cgi?init_popstate=KS">
+<area shape=poly COORDS="263,133,275,129,289,115,303,121,307,129,299,135,251,141,269,131,263,133" href="signup.cgi?init_popstate=KY">
+<area shape=poly COORDS="222,179,246,179,244,197,258,193,262,213,226,209,224,177,222,179" href="signup.cgi?init_popstate=LA">
+<area shape=poly COORDS="363,37,373,59,373,47,387,31,377,9,365,15,363,37" href="signup.cgi?init_popstate=ME">
+<area shape=poly COORDS="376,159,405,159,405,175,374,177,376,159" href="signup.cgi?init_popstate=MD">
+<area shape=poly COORDS="378,74,380,88,404,88,404,72,378,74" href="signup.cgi?init_popstate=MA">
+<area shape=poly COORDS="265,73,269,83,265,93,293,91,295,71,281,53,271,53,267,69,265,73,265,73" href="signup.cgi?init_popstate=MI">
+<area shape=poly COORDS="194,31,222,33,242,35,224,51,222,63,222,73,234,79,196,85,194,31" href="signup.cgi?init_popstate=MN">
+<area shape=poly COORDS="265,159,271,199,257,201,259,195,241,197,251,155,265,159" href="signup.cgi?init_popstate=MS">
+<area shape=poly COORDS="206,113,234,111,256,139,248,147,214,145,208,111,206,113" href="signup.cgi?init_popstate=MO">
+<area shape=poly COORDS="78,23,148,31,146,67,84,63,78,35,80,19,78,23" href="signup.cgi?init_popstate=MT">
+<area shape=poly COORDS="146,85,148,103,158,105,164,109,206,109,198,85,144,87,146,85" href="signup.cgi?init_popstate=NE">
+<area shape=poly COORDS="40,83,76,87,64,151,32,109,40,83,40,83" href="signup.cgi?init_popstate=NV">
+<area shape=poly COORDS="298,11,330,9,330,25,298,25,298,11" href="signup.cgi?init_popstate=NH">
+<area shape=poly COORDS="372,127,404,125,405,141,368,139,376,125,372,127" href="signup.cgi?init_popstate=NJ">
+<area shape=poly COORDS="106,137,100,191,122,187,148,187,150,139,106,137,106,137" href="signup.cgi?init_popstate=NM">
+<area shape=poly COORDS="313,79,331,63,337,45,349,45,359,65,357,79,345,65,315,77,313,79,313,79" href="signup.cgi?init_popstate=NY">
+<area shape=poly COORDS="309,137,295,151,319,149,337,153,357,131,351,129,309,137,309,137" href="signup.cgi?init_popstate=NC">
+<area shape=poly COORDS="146,31,148,57,198,57,190,31,146,31,146,31" href="signup.cgi?init_popstate=ND">
+<area shape=poly COORDS="281,93,285,113,299,121,311,101,309,85,299,93,281,93,281,93" href="signup.cgi?init_popstate=OH">
+<area shape=poly COORDS="148,145,174,145,174,163,218,171,216,143,150,139,150,145,156,143,148,145,148,145" href="signup.cgi?init_popstate=OK">
+<area shape=poly COORDS="20,41,8,73,16,77,22,77,28,77,36,79,42,81,48,83,56,83,66,49,20,41,20,41" href="signup.cgi?init_popstate=OR">
+<area shape=poly COORDS="309,83,345,71,351,93,313,105,309,83,309,83" href="signup.cgi?init_popstate=PA">
+<area shape=poly COORDS="376,93,405,93,405,107,376,105,376,93" href="signup.cgi?init_popstate=RI">
+<area shape=poly COORDS="301,155,321,149,337,155,325,175,301,157,301,155,301,155" href="signup.cgi?init_popstate=SC">
+<area shape=poly COORDS="146,59,198,61,198,83,146,83,148,57,146,59,146,59" href="signup.cgi?init_popstate=SD">
+<area shape=poly COORDS="255,145,251,157,297,153,311,133,255,145,255,145" href="signup.cgi?init_popstate=TN">
+<area shape=poly COORDS="150,145,172,145,174,167,198,173,218,173,228,207,204,221,198,231,202,247,180,241,154,207,146,219,120,189,154,189,152,145,150,145,150,145" href="signup.cgi?init_popstate=TX">
+<area shape=poly COORDS="78,89,96,91,96,103,110,103,106,135,70,133,78,89,78,89" href="signup.cgi?init_popstate=UT">
+<area shape=poly COORDS="298,29,332,29,332,47,294,45,298,29" href="signup.cgi?init_popstate=VT">
+<area shape=poly COORDS="307,127,297,137,351,127,349,113,341,111,341,105,329,107,315,131,307,127,307,127" href="signup.cgi?init_popstate=VA">
+<area shape=poly COORDS="32,13,68,19,64,47,20,39,20,13,30,19,32,13,32,13" href="signup.cgi?init_popstate=WA">
+<area shape=poly COORDS="303,119,313,129,329,103,311,105,299,121,313,127,303,119,303,119" href="signup.cgi?init_popstate=WV">
+<area shape=poly COORDS="228,51,256,55,254,89,238,89,234,77,224,71,230,49,236,53,228,51,228,51" href="signup.cgi?init_popstate=WI">
+<area shape=poly COORDS="146,71,144,103,96,99,102,63,148,69,146,71,146,71" href="signup.cgi?init_popstate=WY">
+</MAP>
+<IMG SRC="map.gif" usemap=#usmap WIDTH=405 HEIGHT=270 border=0><BR>
<SELECT NAME="init_popstate" onChange="gotoURL(this.form.init_popstate)">
<OPTION VALUE="stateselect.html"></OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=AL">ALABAMA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=AK">ALASKA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=AS">AMERICAN SAMOA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=AZ">ARIZONA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=AR">ARKANSAS</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=CA">CALIFORNIA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=CO">COLORADO</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=CT">CONNECTICUT</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=DE">DELAWARE</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=DC">DISTRICT OF COLUMBIA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=FM">FEDERATED STATES OF MICRONESIA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=FL">FLORIDA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=GA">GEORGIA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=GU">GUAM</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=HI">HAWAII</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=ID">IDAHO</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=IL">ILLINOIS</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=IN">INDIANA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=IA">IOWA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=KS">KANSAS</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=KY">KENTUCKY</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=LA">LOUISIANA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=ME">MAINE</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=MH">MARSHALL ISLANDS</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=MD">MARYLAND</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=MA">MASSACHUSETTS</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=MI">MICHIGAN</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=MN">MINNESOTA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=MS">MISSISSIPPI</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=MO">MISSOURI</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=MT">MONTANA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=NE">NEBRASKA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=NV">NEVADA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=NH">NEW HAMPSHIRE</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=NJ">NEW JERSEY</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=NM">NEW MEXICO</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=NY">NEW YORK</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=NC">NORTH CAROLINA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=ND">NORTH DAKOTA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=MP">NORTHERN MARIANA ISLANDS</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=OH">OHIO</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=OK">OKLAHOMA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=OR">OREGON</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=PW">PALAU</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=PA">PENNSYLVANIA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=PR">PUERTO RICO</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=RI">RHODE ISLAND</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=SC">SOUTH CAROLINA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=SD">SOUTH DAKOTA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=TN">TENNESSEE</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=TX">TEXAS</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=UT">UTAH</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=VT">VERMONT</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=VI">VIRGIN ISLANDS</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=VA">VIRGINIA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=WA">WASHINGTON</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=WV">WEST VIRGINIA</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=WI">WISCONSIN</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=WY">WYOMING</OPTION>
-<OPTION VALUE="signup.cgi?init_popstate=AE">Armed Forces Africa</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=AL">Alabama</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=AK">Alaska</OPTION>
+<!--<OPTION VALUE="signup.cgi?init_popstate=AS">American Samoa</OPTION>-->
+<OPTION VALUE="signup.cgi?init_popstate=AZ">Arizona</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=AR">Arkansas</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=CA">California</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=CO">Colorado</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=CT">Connecticut</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=DE">Delaware</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=DC">District of Columbia</OPTION>
+<!--<OPTION VALUE="signup.cgi?init_popstate=FM">Federated States of Micronesia</OPTION>-->
+<OPTION VALUE="signup.cgi?init_popstate=FL">Florida</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=GA">Georgia</OPTION>
+<!--<OPTION VALUE="signup.cgi?init_popstate=GU">Guam</OPTION>-->
+<OPTION VALUE="signup.cgi?init_popstate=HI">Hawaii</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=ID">Idaho</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=IL">Illinois</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=IN">Indiana</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=IA">Iowa</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=KS">Kansas</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=KY">Kentucky</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=LA">Louisiana</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=ME">Maine</OPTION>
+<!--<OPTION VALUE="signup.cgi?init_popstate=MH">Marshall Islands</OPTION>-->
+<OPTION VALUE="signup.cgi?init_popstate=MD">Maryland</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=MA">Massachusetts</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=MI">Michigan</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=MN">Minnesota</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=MS">Mississippi</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=MO">Missouri</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=MT">Montana</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=NE">Nebraska</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=NV">Nevada</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=NH">New Hampshire</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=NJ">New Jersey</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=NM">New Mexico</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=NY">New York</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=NC">North Carolina</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=ND">North Dakota</OPTION>
+<!--<OPTION VALUE="signup.cgi?init_popstate=MP">Northern Mariana Islands</OPTION>-->
+<OPTION VALUE="signup.cgi?init_popstate=OH">Ohio</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=OK">Oklahoma</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=OR">Oregon</OPTION>
+<!--<OPTION VALUE="signup.cgi?init_popstate=PW">Palau</OPTION>-->
+<OPTION VALUE="signup.cgi?init_popstate=PA">Pennsylvania</OPTION>
+<!--<OPTION VALUE="signup.cgi?init_popstate=PR">Puerto Rico</OPTION>-->
+<OPTION VALUE="signup.cgi?init_popstate=RI">Rhode Island</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=SC">South Carolina</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=SD">South Dakota</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=TN">Tennessee</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=TX">Texas</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=UT">Utah</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=VT">Vermont</OPTION>
+<!--<OPTION VALUE="signup.cgi?init_popstate=VI">Virgin Islands</OPTION>-->
+<OPTION VALUE="signup.cgi?init_popstate=VA">Virginia</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=WA">Washington</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=WV">West Virginia</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=WI">Wisconsin</OPTION>
+<OPTION VALUE="signup.cgi?init_popstate=WY">Wyoming</OPTION>
+<!--<OPTION VALUE="signup.cgi?init_popstate=AE">Armed Forces Africa</OPTION>
<OPTION VALUE="signup.cgi?init_popstate=AA">Armed Forces Americas</OPTION>
<OPTION VALUE="signup.cgi?init_popstate=AE">Armed Forces Canada</OPTION>
<OPTION VALUE="signup.cgi?init_popstate=AE">Armed Forces Europe</OPTION>
<OPTION VALUE="signup.cgi?init_popstate=AE">Armed Forces Middle East</OPTION>
<OPTION VALUE="signup.cgi?init_popstate=AP">Armed Forces Pacific</OPTION>
+-->
</SELECT>
</FORM>
</BODY>
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# fs_signup_server
-#
-
-use strict;
-use vars qw($pid);
-use IO::Handle;
-use Storable qw(nstore_fd fd_retrieve);
-use Tie::RefHash;
-use Net::SSH qw(sshopen2);
-use FS::UID qw(adminsuidsetup);
-use FS::Conf;
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_main_county;
-use FS::cust_main;
-use FS::cust_bill;
-use FS::cust_pkg;
-use FS::Msgcat qw(gettext);
-
-use vars qw( $opt $Debug );
-
-$Debug = 2;
-
-my $user = shift or die &usage;
-&adminsuidsetup( $user );
-
-my $conf = new FS::Conf;
-
-if ($conf->exists('signup_server-quiet')) {
- $FS::cust_bill::quiet = 1;
- $FS::cust_pkg::quiet = 1;
-}
-
-#my @payby = qw(CARD PREPAY);
-my @payby = $conf->config('signup_server-payby');
-my $smtpmachine = $conf->config('smtpmachine');
-
-my $machine = shift or die &usage;
-
-my $agentnum = shift or die &usage;
-my $agent = qsearchs( 'agent', { 'agentnum' => $agentnum } ) or die &usage;
-my $pkgpart_href = $agent->pkgpart_hashref;
-
-my $refnum = shift or die &usage;
-
-#causing trouble for some folks
-#$SIG{CHLD} = sub { wait() };
-
-$SIG{HUP} = \&killssh;
-$SIG{INT} = \&killssh;
-$SIG{QUIT} = \&killssh;
-$SIG{TERM} = \&killssh;
-$SIG{PIPE} = \&killssh;
-sub killssh { kill 'TERM', $pid if $pid; exit; };
-
-my($fs_signupd)="/usr/local/sbin/fs_signupd";
-
-while (1) {
- my($reader,$writer)=(new IO::Handle, new IO::Handle);
- #seems to be broken - calling ->flush explicitly# $writer->autoflush(1);
- warn "[fs_signup_server] Connecting to $machine...\n" if $Debug;
- $pid = sshopen2($machine,$reader,$writer,$fs_signupd);
-
- my @pops = qsearch('svc_acct_pop',{} );
- my $init_data = {
-
- #'_protocol' => 'signup',
- #'_version' => '0.1',
- #'_packet' => 'init'
-
- 'cust_main_county' =>
- [ map { $_->hashref } qsearch('cust_main_county', {}) ],
-
- 'part_pkg' =>
- [
- #map { $_->hashref }
- map { { 'payby' => [ $_->payby ], %{$_->hashref} } }
- grep { $_->svcpart('svc_acct') && $pkgpart_href->{ $_->pkgpart } }
- qsearch( 'part_pkg', { 'disabled' => '' } )
- ],
-
- 'agentnum2part_pkg' =>
- {
- map {
- my $href = $_->pkgpart_hashref;
- $_->agentnum =>
- [
- map { { 'payby' => [ $_->payby ], %{$_->hashref} } }
- grep { $_->svcpart('svc_acct') && $href->{ $_->pkgpart } }
- qsearch( 'part_pkg', { 'disabled' => '' } )
- ];
- } qsearch('agent', {} )
- },
-
- 'svc_acct_pop' => [ map { $_->hashref } @pops ],
-
- 'security_phrase' => $conf->exists('security_phrase'),
-
- 'payby' => [ $conf->config('signup_server-payby') ],
-
- 'msgcat' => { map { $_=>gettext($_) } qw(
- passwords_dont_match invalid_card unknown_card_type not_a
- ) },
-
- 'statedefault' => $conf->config('statedefault') || 'CA',
-
- 'countrydefault' => $conf->config('countrydefault') || 'US',
-
- };
-
- warn "[fs_signup_server] Sending init data...\n" if $Debug;
- nstore_fd($init_data, $writer) or die "can't send init data: $!";
- $writer->flush;
-
- warn "[fs_signup_server] Entering main loop...\n" if $Debug;
- while (1) {
- warn "[fs_signup_server] Reading (waiting for) signup data...\n" if $Debug;
- my $signup_data = fd_retrieve($reader);
-
- if ( $Debug > 1 ) {
- warn join('',
- map { " $_ => ". $signup_data->{$_}. "\n" } keys %$signup_data );
- }
-
- warn "[fs_signup_server] Processing signup...\n" if $Debug;
-
- my $error = '';
-
- #things that aren't necessary in base class, but are for signup server
- #return "Passwords don't match"
- # if $hashref->{'_password'} ne $hashref->{'_password2'}
- $error ||= gettext('empty_password') unless $signup_data->{'_password'};
- $error ||= gettext('no_access_number_selected')
- unless $signup_data->{'popnum'} || !scalar(@pops);
-
- #shares some stuff with htdocs/edit/process/cust_main.cgi... take any
- # common that are still here and library them.
- my $cust_main = new FS::cust_main ( {
- #'custnum' => '',
- 'agentnum' => $signup_data->{agentnum} || $agentnum,
- 'refnum' => $refnum,
-
- map { $_ => $signup_data->{$_} } qw(
- last first ss company address1 address2 city county state zip country
- daytime night fax payby payinfo paydate payname referral_custnum comments
- ),
-
- } );
-
- $error ||= "Illegal payment type"
- unless grep { $_ eq $signup_data->{'payby'} } @payby;
-
- $cust_main->payinfo($cust_main->daytime)
- if $cust_main->payby eq 'LECB' && ! $cust_main->payinfo;
-
- my @invoicing_list = split( /\s*\,\s*/, $signup_data->{'invoicing_list'} );
-
- $signup_data->{'pkgpart'} =~ /^(\d+)$/ or '' =~ /^()$/;
- my $pkgpart = $1;
-
- my $part_pkg =
- qsearchs( 'part_pkg', { 'pkgpart' => $pkgpart } )
- or $error ||= "WARNING: unknown pkgpart: $pkgpart";
- my $svcpart = $part_pkg->svcpart('svc_acct') unless $error;
-
- my $cust_pkg = new FS::cust_pkg ( {
- #later#'custnum' => $custnum,
- 'pkgpart' => $signup_data->{'pkgpart'},
- } );
- $error ||= $cust_pkg->check;
-
- my $svc_acct = new FS::svc_acct ( {
- 'svcpart' => $svcpart,
- map { $_ => $signup_data->{$_} }
- qw( username _password sec_phrase popnum ),
- } );
-
- my $y = $svc_acct->setdefault; # arguably should be in new method
- $error ||= $y unless ref($y);
-
- $error ||= $svc_acct->check;
-
- use Tie::RefHash;
- tie my %hash, 'Tie::RefHash';
- %hash = ( $cust_pkg => [ $svc_acct ] );
- $error ||= $cust_main->insert( \%hash, \@invoicing_list ); #msgcat
-
- if ( ! $error && $conf->exists('signup_server-realtime') ) {
-
- warn "[fs_signup_server] Billing customer...\n" if $Debug;
-
- my $bill_error = $cust_main->bill;
- warn "[fs_signup_server] error billing new customer: $bill_error"
- if $bill_error;
-
- $cust_main->apply_payments;
- $cust_main->apply_credits;
-
- $bill_error = $cust_main->collect;
- warn "[fs_signup_server] error collecting from new customer: $bill_error"
- if $bill_error;
-
- if ( $cust_main->balance > 0 ) {
-
- #this makes sense. credit is "un-doing" the invoice
- $cust_main->credit( $cust_main->balance, 'signup server decline' );
- $cust_main->apply_credits;
-
- #should check list for errors...
- #$cust_main->suspend;
- $cust_main->cancel;
-
- $error = '_decline';
- }
- }
-
- warn "[fs_signup_server] Sending results...\n" if $Debug;
- print $writer $error, "\n";
-
- next if $error;
-
- if ( $conf->config('signup_server-email') ) {
- warn "[fs_signup_server] Sending email...\n" if $Debug;
-
- #false laziness w/FS::cust_bill::send & FS::cust_pay::delete
- use Mail::Header;
- use Mail::Internet 1.44;
- use Date::Format;
- my $from = $conf->config('invoice_from'); #??? as good as any
- $ENV{MAILADDRESS} = $from;
- my $header = new Mail::Header ( [
- "From: $from",
- "To: ". $conf->config('signup_server-email'),
- "Sender: $from",
- "Reply-To: $from",
- "Date: ". time2str("%a, %d %b %Y %X %z", time),
- "Subject: FREESIDE NOTIFICATION: Signup Server",
- ] );
- my $body = [
- "This is an automatic message from your Freeside installation\n",
- "informing you a customer has signed up via the signup server:\n",
- "\n",
- 'custnum : '. $cust_main->custnum. "\n",
- 'Name : '. $cust_main->last. ", ". $cust_main->first. "\n",
- 'Agent : '. $cust_main->agent->agent. "\n",
- 'Package : '. $part_pkg->pkg. ' - '. $part_pkg->comment. "\n",
- 'Signup Date : '. time2str('%C', time). "\n",
- 'Username : '. $svc_acct->username. "\n",
- #'Password : '. # config file to turn this on if noment insists
- 'Day phone : '. $cust_main->daytime. "\n",
- 'Night phone : '. $cust_main->night. "\n",
- 'Address : '. $cust_main->address1. "\n",
- ( $cust_main->address2
- ? ' '. $cust_main->address2. "\n"
- : '' ),
- ' '. $cust_main->city. ', '. $cust_main->state. ' '.
- $cust_main->zip. "\n",
- ( $cust_main->country eq 'US'
- ? ''
- : ' '. $cust_main->country. "\n" ),
- "\n",
- ];
- #if ( $cust_main->balance > 0 ) {
- # push @$body,
- # "This customer has an outstanding balance and has been suspended.\n";
- #}
- my $message = new Mail::Internet ( 'Header' => $header, 'Body' => $body );
- $!=0;
- $message->smtpsend( Host => $smtpmachine )
- or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
- or warn "[fs_signup_server] can't send email to ".
- $conf->config('signup_server-email').
- " via server $smtpmachine with SMTP: $!";
- #end-of-send mail
- }
-
- }
- close $writer;
- close $reader;
- warn "connection to $machine lost! waiting 60 seconds...\n";
- sleep 60;
- warn "reconnecting...\n";
-}
-
-sub usage {
- die "Usage:\n\n fs_signup_server user machine agentnum refnum\n";
-}
-
use strict;
use vars qw( $cgi $p );
+use Apache::ASP 2.55;
use CGI 2.47;
#use CGI::Carp qw(fatalsToBrowser);
use Date::Format;
use HTML::Entities;
use IO::Handle;
use IO::File;
+use Net::Whois::Raw qw(whois);
+if ( $] < 5.006 ) {
+ eval "use Net::Whois::Raw 0.32 qw(whois)";
+ die $@ if $@;
+}
+use Business::CreditCard;
use String::Approx qw(amatch);
-use HTML::Widgets::SelectLayers 0.02;
+use HTML::Widgets::SelectLayers 0.03;
use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name);
use FS::Record qw(qsearch qsearchs fields dbdef);
use FS::Conf;
use FS::CGI qw(header menubar popurl table itable ntable idiot eidiot
small_custview myexit http_header);
use FS::Msgcat qw(gettext geterror);
+use FS::Misc qw( send_email );
use FS::agent;
use FS::agent_type;
use FS::msgcat;
sub Script_OnStart {
- $Response->AddHeader('Pragma' => 'no-cache');
$Response->AddHeader('Cache-control' => 'no-cache');
# $Response->AddHeader('Expires' => 0);
$Response->{Expires} = -36288000;
my $ah = new HTML::Mason::ApacheHandler (
#interp => $interp,
#auto_send_headers => 0,
- comp_root=>'/var/www/freeside',
+ comp_root=>'%%%FREESIDE_DOCUMENT_ROOT%%%',
data_dir=>'/usr/local/etc/freeside/masondata',
#out_mode=>'stream',
);
use HTML::Entities;
use IO::Handle;
use IO::File;
+ use Net::Whois::Raw qw(whois);
+ if ( $] < 5.006 ) {
+ eval "use Net::Whois::Raw 0.32 qw(whois)";
+ die $@ if $@;
+ }
+ use Business::CreditCard;
use String::Approx qw(amatch);
- use HTML::Widgets::SelectLayers 0.02;
+ use HTML::Widgets::SelectLayers 0.03;
use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name);
use FS::Record qw(qsearch qsearchs fields dbdef);
use FS::Conf;
use FS::CGI qw(header menubar popurl table itable ntable idiot eidiot
small_custview myexit http_header);
use FS::Msgcat qw(gettext geterror);
+ use FS::Misc qw( send_email );
use FS::agent;
use FS::agent_type;
#eorar
my $headers = $r->headers_out;
- $headers->{'Pragma'} = $headers->{'Cache-control'} = 'no-cache';
+ $headers->{'Cache-control'} = 'no-cache';
#$r->no_cache(1);
$headers->{'Expires'} = '0';
) or die dbh->errstr;
} else {
- $sortby = \*pkgpart_sort;
+ $sortby = sub { $a->pkgpart <=> $b->pkgpart; };
}
+my $conf = new FS::Conf;
+my $taxclasses = $conf->exists('enable_taxclasses');
+
%>
<%= header("Package Definition Listing",menubar( 'Main Menu' => $p )) %>
<% unless ( $cgi->param('active') ) { %>
<% } %>
<%= $total %> package definitions
-<%
-if ( $cgi->param('showdisabled') ) {
- $cgi->param('showdisabled', 0);
- print qq!( <a href="!. $cgi->self_url. qq!">hide disabled packages</a> )!;
-} else {
- $cgi->param('showdisabled', 1);
- print qq!( <a href="!. $cgi->self_url. qq!">show disabled packages</a> )!;
-}
+<% if ( $cgi->param('showdisabled') ) { $cgi->param('showdisabled', 0); %>
+ ( <a href="<%= $cgi->self_url %>">hide disabled packages</a> )
+<% } else { $cgi->param('showdisabled', 1); %>
+ ( <a href="<%= $cgi->self_url %>">show disabled packages</a> )
+<% } %>
-my $colspan = $cgi->param('showdisabled') ? 2 : 3;
-print &table(), <<END;
+<% my $colspan = $cgi->param('showdisabled') ? 2 : 3; %>
+
+<%= &table() %>
<TR>
- <TH COLSPAN=$colspan>Package</TH>
+ <TH COLSPAN=<%= $colspan %>>Package</TH>
<TH>Comment</TH>
-END
-print ' <TH><FONT SIZE=-1>Customer<BR>packages</FONT></TH>'
- if $cgi->param('active');
-print <<END;
+<% if ( $cgi->param('active') ) { %>
+ <TH><FONT SIZE=-1>Customer<BR>packages</FONT></TH>
+<% } %>
<TH><FONT SIZE=-1>Freq.</FONT></TH>
+<% if ( $taxclasses ) { %>
+ <TH><FONT SIZE=-1>Taxclass</FONT></TH>
+<% } %>
<TH><FONT SIZE=-1>Plan</FONT></TH>
<TH><FONT SIZE=-1>Data</FONT></TH>
<TH>Service</TH>
<TH><FONT SIZE=-1>Quan.</FONT></TH>
+<% if ( dbdef->table('pkg_svc')->column('primary_svc') ) { %>
+ <TH><FONT SIZE=-1>Primary</FONT></TH>
+<% } %>
+
</TR>
-END
+<%
foreach my $part_pkg ( sort $sortby @part_pkg ) {
my($hashref)=$part_pkg->hashref;
my(@pkg_svc)=grep $_->getfield('quantity'),
$plandata = "Setup ". $hashref->{setup}.
"<BR>Recur ". $hashref->{recur};
}
- print <<END;
+%>
<TR>
- <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_pkg.cgi?$hashref->{pkgpart}">$hashref->{pkgpart}</A></TD>
-END
-
- unless ( $cgi->param('showdisabled') ) {
- print "<TD ROWSPAN=$rowspan>";
- print "DISABLED" if $hashref->{disabled};
- print '</TD>';
- }
-
- print <<END;
- <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_pkg.cgi?$hashref->{pkgpart}">$hashref->{pkg}</A></TD>
- <TD ROWSPAN=$rowspan>$hashref->{comment}</TD>
-END
- if ( $cgi->param('active') ) {
- print " <TD ROWSPAN=$rowspan>";
- print '<FONT COLOR="#00CC00"><B>'.
- $num_active_cust_pkg{$hashref->{'pkgpart'}}.
- qq!</B></FONT> <A HREF="${p}search/cust_pkg.cgi?magic=active;pkgpart=$hashref->{pkgpart}">active</A><BR>!;
+ <TD ROWSPAN=<%= $rowspan %>><A HREF="<%=$p%>edit/part_pkg.cgi?<%= $hashref->{pkgpart} %>"><%= $hashref->{pkgpart} %></A></TD>
+
+<% unless ( $cgi->param('showdisabled') ) { %>
+ <TD ROWSPAN=<%= $rowspan %>>
+ <% if ( $hashref->{disabled} ) { %>
+ DISABLED
+ <% } %>
+ </TD>
+<% } %>
- $suspended_sth->execute( $part_pkg->pkgpart ) or die $suspended_sth->errstr;
- my $num_suspended = $suspended_sth->fetchrow_arrayref->[0];
- print '<FONT COLOR="#FF9900"><B>'. $num_suspended.
- qq!</B></FONT> <A HREF="${p}search/cust_pkg.cgi?magic=suspended;pkgpart=$hashref->{pkgpart}">suspended</A><BR>!;
+ <TD ROWSPAN=<%= $rowspan %>><A HREF="<%=$p%>edit/part_pkg.cgi?<%= $hashref->{pkgpart} %>"><%= $hashref->{pkg} %></A></TD>
+ <TD ROWSPAN=<%= $rowspan %>><%= $hashref->{comment} %></TD>
+
+<% if ( $cgi->param('active') ) { %>
+ <TD ROWSPAN=<%= $rowspan %>>
+ <FONT COLOR="#00CC00"><B><%= $num_active_cust_pkg{$hashref->{'pkgpart'}} %></B></FONT> <A HREF="<%=$p%>search/cust_pkg.cgi?magic=active;pkgpart=<%= $hashref->{pkgpart} %>">active</A><BR>
+
+ <% $suspended_sth->execute( $part_pkg->pkgpart )
+ or die $suspended_sth->errstr;
+ my $num_suspended = $suspended_sth->fetchrow_arrayref->[0];
+ %>
+ <FONT COLOR="#FF9900"><B><%= $num_suspended %></B></FONT> <A HREF="<%=$p%>search/cust_pkg.cgi?magic=suspended;pkgpart=<%= $hashref->{pkgpart} %>">suspended</A><BR>
+
+ <% $canceled_sth->execute( $part_pkg->pkgpart )
+ or die $canceled_sth->errstr;
+ my $num_canceled = $canceled_sth->fetchrow_arrayref->[0];
+ %>
+ <FONT COLOR="#FF0000"><B><%= $num_canceled %></B></FONT> <A HREF="<%=$p%>search/cust_pkg.cgi?magic=canceled;pkgpart=<%= $hashref->{pkgpart} %>">canceled</A>
+ </TD>
+<% } %>
- $canceled_sth->execute( $part_pkg->pkgpart ) or die $canceled_sth->errstr;
- my $num_canceled = $canceled_sth->fetchrow_arrayref->[0];
- print '<FONT COLOR="#FF0000"><B>'. $num_canceled.
- qq!</B></FONT> <A HREF="${p}search/cust_pkg.cgi?magic=canceled;pkgpart=$hashref->{pkgpart}">canceled</A>!;
+ <TD ROWSPAN=<%= $rowspan %>><%= $hashref->{freq} %></TD>
+<% if ( $taxclasses ) { %>
+ <TD ROWSPAN=<%= $rowspan %>><%= $hashref->{taxclass} || ' ' %></TD>
+<% } %>
- print '</TD>';
- }
- print <<END;
- <TD ROWSPAN=$rowspan>$hashref->{freq}</TD>
- <TD ROWSPAN=$rowspan>$hashref->{plan}</TD>
- <TD ROWSPAN=$rowspan>$plandata</TD>
-END
+ <TD ROWSPAN=<%= $rowspan %>><%= $hashref->{plan} %></TD>
+ <TD ROWSPAN=<%= $rowspan %>><%= $plandata %></TD>
+<%
my($pkg_svc);
my($n)="";
foreach $pkg_svc ( @pkg_svc ) {
my($part_svc) = qsearchs('part_svc',{'svcpart'=> $svcpart });
print $n,qq!<TD><A HREF="${p}edit/part_svc.cgi?$svcpart">!,
$part_svc->getfield('svc'),"</A></TD><TD>",
- $pkg_svc->getfield('quantity'),"</TD></TR>\n";
+ $pkg_svc->getfield('quantity'),"</TD>";
+ if ( dbdef->table('pkg_svc')->column('primary_svc') ) {
+ print '<TD>';
+ print 'PRIMARY' if $pkg_svc->primary_svc =~ /^Y/i;
+ print '</TD>';
+ }
+ print "</TR>\n";
$n="<TR>";
}
+%>
- print "</TR>";
-}
-
-$colspan = $cgi->param('showdisabled') ? 8 : 9;
-print <<END;
+ </TR>
+<% } %>
</TABLE>
</BODY>
</HTML>
-END
-
-sub pkgpart_sort {
- $a->pkgpart <=> $b->pkgpart;
-}
-
-%>
<%
my $today = timelocal(0, 0, 0, (localtime(time))[3..5] );
- my %past;
- tie %past, 'Tie::IxHash',
+ my %after;
+ tie %after, 'Tie::IxHash',
'Today' => 0,
+ 'Yesterday' => 86400, # 60sec * 60min * 24hrs
'Past week' => 518400, # 60sec * 60min * 24hrs * 6days
'Past 30 days' => 2505600, # 60sec * 60min * 24hrs * 29days
- 'Past 60 days' => 5097600, # 60sec * 60min * 24hrs * 29days
- 'Past 90 days' => 7689600, # 60sec * 60min * 24hrs * 29days
+ 'Past 60 days' => 5097600, # 60sec * 60min * 24hrs * 59days
+ 'Past 90 days' => 7689600, # 60sec * 60min * 24hrs * 89days
'Past 6 months' => 15724800, # 60sec * 60min * 24hrs * 182days
'Past year' => 31486000, # 60sec * 60min * 24hrs * 364days
'Total' => $today,
;
+ my %before = (
+ 'Today' => 86400, # 60sec * 60min * 24hrs
+ 'Yesterday' => 0,
+ 'Past week' => 86400, # 60sec * 60min * 24hrs
+ 'Past 30 days' => 86400, # 60sec * 60min * 24hrs
+ 'Past 60 days' => 86400, # 60sec * 60min * 24hrs
+ 'Past 90 days' => 86400, # 60sec * 60min * 24hrs
+ 'Past 6 months' => 86400, # 60sec * 60min * 24hrs
+ 'Past year' => 86400, # 60sec * 60min * 24hrs
+ 'Total' => 86400, # 60sec * 60min * 24hrs
+ );
- my $sth = dbh->prepare("SELECT COUNT(*) FROM h_cust_main
- WHERE history_action = 'insert'
- AND refnum = ?
- AND history_date > ? ")
+ my $statement = "SELECT COUNT(*) FROM h_cust_main
+ WHERE history_action = 'insert'
+ AND refnum = ?
+ AND history_date >= ?
+ AND history_date < ?
+ ";
+ my $sth = dbh->prepare($statement)
or die dbh->errstr;
%>
<%= table() %>
<TR>
<TH COLSPAN=2 ROWSPAN=2>Advertising source</TH>
- <TH COLSPAN=<%= scalar(keys %past) %>>Customers</TH>
+ <TH COLSPAN=<%= scalar(keys %after) %>>Customers</TH>
</TR>
-<% for my $period ( keys %past ) { %>
+<% for my $period ( keys %after ) { %>
<TH><FONT SIZE=-1><%= $period %></FONT></TH>
<% } %>
</TR>
<%= $part_referral->refnum %></A></TD>
<TD><A HREF="<%= $p %>edit/part_referral.cgi?<%= $part_referral->refnum %>">
<%= $part_referral->referral %></A></TD>
- <% for my $period ( values %past ) {
- $sth->execute($part_referral->refnum, $today-$period)
- or die $sth->errstr;
+ <% for my $period ( keys %after ) {
+ $sth->execute( $part_referral->refnum,
+ $today-$after{$period},
+ $today+$before{$period},
+ ) or die $sth->errstr;
my $number = $sth->fetchrow_arrayref->[0];
%>
<TD ALIGN="right"><%= $number %></TD>
</TR>
<% } %>
+<%
+ $statement =~ s/AND refnum = \?//;
+ $sth = dbh->prepare($statement)
+ or die dbh->errstr;
+%>
+ <TR>
+ <TH COLSPAN=2>Total</TH>
+ <% for my $period ( keys %after ) {
+ $sth->execute( $today-$after{$period},
+ $today+$before{$period},
+ ) or die $sth->errstr;
+ my $number = $sth->fetchrow_arrayref->[0];
+ %>
+ <TD ALIGN="right"><%= $number %></TD>
+ <% } %>
+ </TR>
</TABLE>
</BODY>
</HTML>
qsearch('part_svc', \%search );
my $total = scalar(@part_svc);
+my %num_active_cust_svc = ();
+if ( $cgi->param('active') ) {
+ my $active_sth = dbh->prepare(
+ 'SELECT COUNT(*) FROM cust_svc WHERE svcpart = ?'
+ ) or die dbh->errstr;
+ foreach my $part_svc ( @part_svc ) {
+ $active_sth->execute($part_svc->svcpart) or die $active_sth->errstr;
+ $num_active_cust_svc{$part_svc->svcpart} =
+ $active_sth->fetchrow_arrayref->[0];
+ }
+ @part_svc = sort { $num_active_cust_svc{$b->svcpart} <=>
+ $num_active_cust_svc{$a->svcpart} } @part_svc;
+}
+
%>
<%= header('Service Definition Listing', menubar( 'Main Menu' => $p) ) %>
<TR>
<TH COLSPAN=<%= $cgi->param('showdisabled') ? 2 : 3 %>>Service</TH>
<TH>Table</TH>
+<% if ( $cgi->param('active') ) { %>
+ <TH><FONT SIZE=-1>Customer<BR>Services</FONT></TH>
+<% } %>
<TH>Export</TH>
<TH>Field</TH>
<TH COLSPAN=2>Modifier</TH>
<%= $hashref->{svc} %></A></TD>
<TD ROWSPAN=<%= $rowspan %>>
<%= $hashref->{svcdb} %></TD>
+<% if ( $cgi->param('active') ) { %>
+ <TD ROWSPAN=<%= $rowspan %>>
+ <FONT COLOR="#00CC00"><B><%= $num_active_cust_svc{$hashref->{svcpart}} %></B></FONT> <A HREF="<%=$p%>search/<%= $hashref->{svcdb} %>.cgi?svcpart=<%= $hashref->{svcpart} %>">active</A>
+ </TD>
+<% } %>
<TD ROWSPAN=<%= $rowspan %>><%= itable() %>
<%
# my @part_export =
--- /dev/null
+<pre>
+this is incomplete
+mostly it should be merged into signup.html and fs_signup/ieak.template
+
+- download and install the IEAK from
+ http://www.microsoft.com/windows/ieak/default.asp
+
+- Good examples may be found in
+ C:\Program Files\IEAK\toolkit\isp\server\ICW\signup\perl\signup08.pl
+ C:\Program Files\IEAK\toolkit\isp\server\ICW\reconfig\perl\reconfig04.pl
+ C:\Program Files\IEAK6\toolkit\isp\servless\basic\sample.ins
+ C:\Program Files\IEAK6\toolkit\isp\servless\advanced\4567.ins
+ C:\Program Files\IEAK6\toolkit\isp\servless\advanced\4568.ins
+ C:\Program Files\IEAK6\toolkit\isp\servless\advanced\7890.ins
+ C:\Program Files\IEAK6\toolkit\isp\servless\advanced\7891.ins
+
+- Full documentation on all the settings available in .INS files is
+ avaialble under Program Files | Microsoft IEAK 6 | IEAK Help
+ | Reference | Internet Settings (.ins) Files
+
+- Freeside will make the following substitutions before sending the file
+ to the user:
+
+ { $ac } - area code of selected POP
+ { $exch } - exchange of selected POP
+ { $loc } - local part of selected POP
+ { $username }
+ { $password }
+ { $email_name } - first and last name
+ { $pkg } - package name
+
+- Simple example follows:
+
+[Entry]
+Entry Name = IEAK Sample
+[Phone]
+Dial_As_Is = No
+Phone_Number = { $exch }{ $loc }
+Area_Code = { $ac }
+Country_Code = 1
+Country_Id = 1
+[Server]
+Type = PPP
+SW_Compress = Yes
+PW_Encrypt = Yes
+Negotiate_TCP/IP = Yes
+Disable_LCP = No
+[TCP/IP]
+Specity_IP_Address = No
+Specity_Server_Address = No
+IP_Header_Compress = Yes
+Gateway_On_Remote = Yes
+[User]
+Name = { $username }
+Passowrd = { $password }
+Display_Password = Yes
+[Internet_Mail]
+Email_Name = { $email_name }
+Email_Address = { $username }@example.com
+POP_Server = mail.example.com
+POP_Server_Port_Number = 110
+POP_Logon_Password = { $password }
+SMTP_Server = mail.example.com
+SMTP_Server_Port_Number = 25
+Install_Mail = 1
+[URL]
+Help_Page = http://www.ieaksample.net/helpdesk
+Home_Page = http://www.ieaksample.net
+Search_Page = http://www.ieaksample,net/search
+[Favorites]
+IEAK Sample \\ IEAK Sample Home Page.url = http://acme.ieaksample.net/
+[Branding]
+Window_Title = Internet Explorer from Acme Internet Services
+
+</pre>
<li><a href="http://search.cpan.org/search?dist=HTML-Parser">HTML-Parser</a>
<li><a href="http://search.cpan.org/search?dist=libnet">libnet</a>
<li><a href="http://search.cpan.org/search?dist=Locale-Codes">Locale-Codes</a>
- <li><a href="http://search.cpan.org/search?dist=Net-Whois">Net-Whois</a>
+ <li><a href="http://search.cpan.org/search?dist=Net-Whois-Raw">Net-Whois-Raw</a>
<li><a href="http://search.cpan.org/search?dist=libwww-perl">libwww-perl</a>
<li><a href="http://search.cpan.org/search?dist=Business-CreditCard">Business-CreditCard</a>
<!-- <li><a href="http://search.cpan.org/search?dist=Data-ShowTable">Data-ShowTable</a> -->
<li><a href="http://search.cpan.org/search?dist=HTML-Widgets-SelectLayers">HTML-Widgets-SelectLayers</a>
<li><a href="http://search.cpan.org/search?dist=Storable">Storable</a>
<!-- MyAccounts, maybe only for dev <li><a href="http://search.cpan.org/search?dist=Cache-Cache">Cache::Cache</a> -->
+ <li><a href="http://search.cpan.org/search?dist=Crypt-PasswdMD5">Crypt::PasswdMD5</a>
<li><a href="http://search.cpan.org/search?dist=ApacheDBI">Apache::DBI</a> <i>(optional but recommended for better webinterface performance)</i>
</ul>
</ul>
<font size="-1"><pre>
cp htetc/global.asa /usr/local/etc/freeside/asp-global/global.asa
</pre></font>
- <li>Configure Apache for the Global directory and to execute .cgi files using Apache::ASP. For example:
+ <li>Configure Apache for the Global directory and to execute .cgi files using Apache::ASP. For example, add something like the following to your Apache httpd.conf file, adjusting for your actual paths:
<font size="-1"><pre>
PerlModule Apache::ASP
<Directory /usr/local/apache/htdocs/freeside-asp>
$MLDBM::RemoveTaint = 1;
</Perl>
PerlSetVar Global /usr/local/etc/freeside/asp-global/
-PerlSetVar Debug 2
+PerlSetVar Debug 2
+PerlSetVar RequestBinaryRead Off
</Directory>
</pre></font>
</ul></td>
<li> set an appropriate <tt>data_dir</tt>, such as <tt>/usr/local/etc/freeside/masondata</tt>
</ul>
- <li>Configure Apache to use the <tt>handler.pl</tt> file and to execute .cgi files using HTML::Mason. For example:
+ <li>Configure Apache to use the <tt>handler.pl</tt> file and to execute .cgi files using HTML::Mason. For example, add something like the following to your Apache httpd.conf file, adjusting for your actual paths:
<font size="-1"><pre>
PerlModule HTML::Mason
<Directory /usr/local/apache/htdocs/freeside-mason>
</tr>
</table>
<ul>
-<li>Restrict access to this web interface - see the <a href="http://httpd.apache.org/docs/misc/FAQ.html#user-authentication">Apache documentation on user authentication</a>. For example, to configure user authentication with <a href="http://httpd.apache.org/docs/mod/mod_auth.html">mod_auth</a> (flat files):
+<li>Restrict access to this web interface - see the <a href="http://httpd.apache.org/docs/misc/FAQ.html#user-authentication">Apache documentation on user authentication</a>. For example, to configure user authentication with <a href="http://httpd.apache.org/docs/mod/mod_auth.html">mod_auth</a> (flat files), add something like the following to your Apache httpd.conf file, adjusting for your actual paths:
<pre>
<Directory /usr/local/apache/htdocs/freeside-asp>
AuthName Freeside
$ <a href="man/bin/freeside-adduser.html">freeside-adduser</a> -h /usr/local/etc/freeside/htpasswd <i>username</i></pre></font>
</ul>
<i>(using other auth types, add each user to your <a href="http://httpd.apache.org/docs/misc/FAQ.html#user-authentication">Apache authentication</a> and then run: <tt>freeside-adduser <b>username</b></tt></i>
- <li>As the freeside UNIX user, run <tt>bin/fs-setup <b>username</b></tt> (in the untar'ed freeside directory) to create the database tables, passing the username of a Freeside user you created above:
+ <li>As the freeside UNIX user, run <tt>freeside-setup <b>username</b></tt> to create the database tables, passing the username of a Freeside user you created above:
<pre>
$ su freeside
-$ cd <b>/path/to/freeside/</b>
-$ bin/fs-setup <b>username</b>
+$ freeside-setup <b>username</b>
</pre>
+ Alternately, use the -s option to enable shipping addresses: <tt>freeside-setup -s <b>username</b></tt>
<li>As the freeside UNIX user, run <tt>bin/populate-msgcat <b>username</b></tt> (in the untar'ed freeside directory) to populate the message catalog, passing the username of a Freeside user you created above:
<pre>
$ su freeside
<li>If migrating from less than 1.4.1, see these <a href="upgrade9.html">instructions</a> first.
<li>Back up your data and current Freeside installation.
<li>Install <a href="http://search.cpan.org/search?dist=Locale-SubCountry">Locale::SubCountry</a>
+ <li>Install <a href="http://search.cpan.org/search?dist=IPC-ShareLite">IPC::ShareLite</a>
+ <li>Install <a href="http://search.cpan.org/search?dist=HTML-Widgets-SelectLayers">HTML::Widgets::SelectLayers</a> 0.04.
+ <li>Install <a href="http://search.cpan.org/search?dist=DBIx-DBSchema">DBIx::DBSchema</a> 0.23.
+ <li>Install <a href="http://search.cpan.org/search?dist=DBD-Pg">DBD::Pg</a> 1.32.
+ <li>Install <a href="http://search.cpan.org/search?dist=Cache-Cache">Cache::Cache</a>.
+ <li>Install <a href="http://search.cpan.org/search?dist=Net-SSH">Net::SSH</a> 0.08.
+ <li>Install <a href="http://search.cpan.org/search?dist=Crypt-PasswdMD5">Crypt::PasswdMD5</a>
+ <li>Install <a href="http://search.cpan.org/search?dist=Net-Whois-Raw">Net::Whois::Raw</a>
<li>CGI.pm minimum version 2.47 is required. You will probably need to install a current CGI.pm from CPAN if you are using Perl 5.005 or earlier.
+ <li>File::Temp minimum version 0.14 is required. You will probably need to install a currrent File::Temp from CPAN if you are using Perl 5.6 or earlier.
+ <li>If using Apache::ASP, add <code>PerlSetVar RequestBinaryRead Off</code> to your Apache configuration and make sure you are using Apache::ASP minimum version 2.55.
<li>Run <code>make aspdocs</code> or <code>make masondocs</code>.
<li>Copy <code>aspdocs/</code> or <code>masondocs/</code> to your web server's document space.
<li>Run <code>make install-perl-modules</code>.
- <li>The signup server and password server are deprecated in 1.4.2. Their functionality has been incorperated into the self-service server. Edit or reinstall your init script appropriately, and set the "signup_server-default_agentnum" and "signup_server-default_refnum" configuration options appropriately. The FS::SignupClient interface is still available as a compatibility wrapper. You should be able to continue to use your current signup.cgi.
+ <li>The signup server and password server are deprecated in 1.4.2. Their functionality has been incorperated into the self-service server. Edit or reinstall your init script, and set the "signup_server-default_agentnum" and "signup_server-default_refnum" configuration options. The FS::SignupClient interface is still available as a compatibility wrapper, so you should be able to continue to use your current signup.cgi.
+ <li>Optional: To use typeset invoices, install tetex and ghostscript, and copy conf/invoice_latex, conf/invoice_latexnotes, and conf/invoice_latexfooter to /usr/local/etc/freeside/conf.<datasrc>/
<li>Restart Apache and freeside-queued.
</body>
eventnum int primary key,
invnum int not null,
eventpart int not null,
- _date int not null
+ _date int not null,
+ status varchar(80) not null,
+ statustext text
);
CREATE UNIQUE INDEX cust_bill_event1 ON cust_bill_event ( eventpart, invnum );
CREATE INDEX cust_bill_event2 ON cust_bill_event ( invnum );
print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $error, "</FONT>"
if $error;
-print qq!<FORM ACTION="${p1}process/cust_main.cgi" METHOD=POST NAME="form1">!,
+print qq!<FORM ACTION="${p1}process/cust_main.cgi" METHOD=POST NAME="form1" onSubmit="document.form1.submit.disabled=true">!,
qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!,
qq!Customer # !, ( $custnum ? "<B>$custnum</B>" : " (NEW)" ),
my $countrydefault = $conf->config('countrydefault') || 'US';
$cust_main->country( $countrydefault ) unless $cust_main->country;
-$cust_main->state( $conf->config('statedefault') || 'CA' )
- unless $cust_main->state || $cust_main->country ne 'US';
+my $statedefault = $conf->config('statedefault')
+ || ($countrydefault eq 'US' ? 'CA' : '');
+$cust_main->state( $statedefault )
+ unless $cust_main->state || $cust_main->country ne $countrydefault;
my($county_html, $state_html, $country_html) =
FS::cust_main_county::regionselector( $cust_main->county,
#false laziness with regular state
$cust_main->ship_country( $countrydefault ) unless $cust_main->ship_country;
- $cust_main->ship_state( $conf->config('statedefault') || 'CA' )
- unless $cust_main->ship_state || $cust_main->ship_country ne 'US';
+ $cust_main->ship_state( $statedefault )
+ unless $cust_main->ship_state
+ || $cust_main->ship_country ne $countrydefault;
my($ship_county_html, $ship_state_html, $ship_country_html) =
FS::cust_main_county::regionselector( $cust_main->ship_county,
$return .= ">$_";
}
$return .= qq!</SELECT>/<SELECT NAME="$prefix!. qq!_year" SIZE="1">!;
- for ( 2001 .. 2037 ) {
+ my @t = localtime;
+ my $thisYear = $t[5] + 1900;
+ for ( ($thisYear > $y && $y > 0 ? $y : $thisYear) .. 2037 ) {
$return .= "<OPTION";
$return .= " SELECTED" if $_ == $y;
$return .= ">$_";
my %payby = (
'CARD' => qq!Credit card<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD"). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="">!,
- 'CHEK' => qq!Electronic check<BR>${r}Account number <INPUT TYPE="text" NAME="CHEK_payinfo1" VALUE=""><BR>${r}ABA/Routing code <INPUT TYPE="text" NAME="CHEK_payinfo2" VALUE="" SIZE=10 MAXLENGTH=9><INPUT TYPE="hidden" NAME="CHEK_month" VALUE="12"><INPUT TYPE="hidden" NAME="CHEK_year" VALUE="2037"><BR>${r}Bank name <INPUT TYPE="text" NAME="CHEK_payname" VALUE="">!,
+ 'CHEK' => qq!Electronic check<BR>${r}Account number <INPUT TYPE="text" NAME="CHEK_payinfo1" VALUE=""><BR>${r}ABA/Routing number <INPUT TYPE="text" NAME="CHEK_payinfo2" VALUE="" SIZE=10 MAXLENGTH=9><INPUT TYPE="hidden" NAME="CHEK_month" VALUE="12"><INPUT TYPE="hidden" NAME="CHEK_year" VALUE="2037"><BR>${r}Bank name <INPUT TYPE="text" NAME="CHEK_payname" VALUE="">!,
'LECB' => qq!Phone bill billing<BR>${r}Phone number <INPUT TYPE="text" BANE="LECB_payinfo" VALUE="" MAXLENGTH=15 SIZE=16><INPUT TYPE="hidden" NAME="LECB_month" VALUE="12"><INPUT TYPE="hidden" NAME="LECB_year" VALUE="2037"><INPUT TYPE="hidden" NAME="LECB_payname" VALUE="">!,
'BILL' => qq!Billing<BR>P.O. <INPUT TYPE="text" NAME="BILL_payinfo" VALUE=""><BR><INPUT TYPE="hidden" NAME="BILL_month" VALUE="12"><INPUT TYPE="hidden" NAME="BILL_year" VALUE="2037">Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="">!,
'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE=""><BR>${r}Exp !. expselect("COMP"),
my %paybychecked = (
'CARD' => qq!Credit card<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="$payinfo" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD", $cust_main->paydate). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="$payname">!,
- 'CHEK' => qq!Electronic check<BR>${r}Account number <INPUT TYPE="text" NAME="CHEK_payinfo1" VALUE="$account"><BR>${r}ABA/Routing code <INPUT TYPE="text" NAME="CHEK_payinfo2" VALUE="$aba" SIZE=10 MAXLENGTH=9><INPUT TYPE="hidden" NAME="CHEK_month" VALUE="12"><INPUT TYPE="hidden" NAME="CHEK_year" VALUE="2037"><BR>${r}Bank name <INPUT TYPE="text" NAME="CHEK_payname" VALUE="$payname">!,
+ 'CHEK' => qq!Electronic check<BR>${r}Account number <INPUT TYPE="text" NAME="CHEK_payinfo1" VALUE="$account"><BR>${r}ABA/Routing number <INPUT TYPE="text" NAME="CHEK_payinfo2" VALUE="$aba" SIZE=10 MAXLENGTH=9><INPUT TYPE="hidden" NAME="CHEK_month" VALUE="12"><INPUT TYPE="hidden" NAME="CHEK_year" VALUE="2037"><BR>${r}Bank name <INPUT TYPE="text" NAME="CHEK_payname" VALUE="$payname">!,
'LECB' => qq!Phone bill billing<BR>${r}Phone number <INPUT TYPE="text" BANE="LECB_payinfo" VALUE="$payinfo" MAXLENGTH=15 SIZE=16><INPUT TYPE="hidden" NAME="LECB_month" VALUE="12"><INPUT TYPE="hidden" NAME="LECB_year" VALUE="2037"><INPUT TYPE="hidden" NAME="LECB_payname" VALUE="">!,
'BILL' => qq!Billing<BR>P.O. <INPUT TYPE="text" NAME="BILL_payinfo" VALUE="$payinfo"><BR><INPUT TYPE="hidden" NAME="BILL_month" VALUE="12"><INPUT TYPE="hidden" NAME="BILL_year" VALUE="2037">Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="$payname">!,
'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE="$payinfo"><BR>${r}Exp !. expselect("COMP", $cust_main->paydate),
my $otaker = $cust_main->otaker;
print qq!<INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">!,
- qq!<BR><INPUT TYPE="submit" VALUE="!,
+ qq!<BR><INPUT NAME="submit" TYPE="submit" VALUE="!,
$custnum ? "Apply Changes" : "Add Customer", qq!">!,
"</FORM></BODY></HTML>",
;
my $conf = new FS::Conf;
-my($link, $linknum, $paid, $payby, $payinfo, $quickpay);
+my($link, $linknum, $paid, $payby, $payinfo, $quickpay, $_date);
if ( $cgi->param('error') ) {
- $link = $cgi->param('link');
- $linknum = $cgi->param('linknum');
- $paid = $cgi->param('paid');
- $payby = $cgi->param('payby');
- $payinfo = $cgi->param('payinfo');
+ $link = $cgi->param('link');
+ $linknum = $cgi->param('linknum');
+ $paid = $cgi->param('paid');
+ $payby = $cgi->param('payby');
+ $payinfo = $cgi->param('payinfo');
$quickpay = $cgi->param('quickpay');
+ $_date = $cgi->param('_date') ? str2time($cgi->param('_date')) : time;
} elsif ($cgi->keywords) {
my($query) = $cgi->keywords;
$query =~ /^(\d+)$/;
- $link = 'invnum';
- $linknum = $1;
- $paid = '';
- $payby = 'BILL';
- $payinfo = "";
+ $link = 'invnum';
+ $linknum = $1;
+ $paid = '';
+ $payby = 'BILL';
+ $payinfo = "";
$quickpay = '';
+ $_date = time;
} elsif ( $cgi->param('custnum') =~ /^(\d+)$/ ) {
- $link = 'custnum';
- $linknum = $1;
- $paid = '';
- $payby = 'BILL';
- $payinfo = '';
+ $link = 'custnum';
+ $linknum = $1;
+ $paid = '';
+ $payby = 'BILL';
+ $payinfo = '';
$quickpay = $cgi->param('quickpay');
+ $_date = time;
} else {
die "illegal query ". $cgi->keywords;
}
-my $_date = time;
my $paybatch = "webui-$_date-$$-". rand() * 2**32;
-my $p1 = popurl(1);
-print header("Post payment", '');
+%>
+
+<%= header("Post payment", '') %>
+
+<% if ( $cgi->param('error') ) { %>
+<FONT SIZE="+1" COLOR="#ff0000">Error: <%= $cgi->param('error') %></FONT>
+<BR><BR>
+<% } %>
+
+<%= ntable("#cccccc",2) %>
-print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
- "</FONT><BR><BR>"
- if $cgi->param('error');
+<LINK REL="stylesheet" TYPE="text/css" HREF="../elements/calendar-win2k-2.css" TITLE="win2k-2">
+<SCRIPT TYPE="text/javascript" SRC="../elements/calendar_stripped.js"></SCRIPT>
+<SCRIPT TYPE="text/javascript" SRC="../elements/calendar-en.js"></SCRIPT>
+<SCRIPT TYPE="text/javascript" SRC="../elements/calendar-setup.js"></SCRIPT>
-print <<END, ntable("#cccccc",2);
- <FORM ACTION="${p1}process/cust_pay.cgi" METHOD=POST>
- <INPUT TYPE="hidden" NAME="link" VALUE="$link">
- <INPUT TYPE="hidden" NAME="linknum" VALUE="$linknum">
- <INPUT TYPE="hidden" NAME="quickpay" VALUE="$quickpay">
-END
+<FORM ACTION="<%= popurl(1) %>process/cust_pay.cgi" METHOD=POST>
+<INPUT TYPE="hidden" NAME="link" VALUE="<%= $link %>">
+<INPUT TYPE="hidden" NAME="linknum" VALUE="<%= $linknum %>">
+<INPUT TYPE="hidden" NAME="quickpay" VALUE="<%= $quickpay %>">
+<%
my $custnum;
if ( $link eq 'invnum' ) {
} elsif ( $link eq 'custnum' ) {
$custnum = $linknum;
}
+%>
-print small_custview($custnum, $conf->config('countrydefault'));
-
-print qq!<INPUT TYPE="hidden" NAME="_date" VALUE="$_date">!;
-print qq!<INPUT TYPE="hidden" NAME="payby" VALUE="$payby">!;
-
-print '<BR><BR>Payment'. ntable("#cccccc", 2).
- '<TR><TD ALIGN="right">Date</TD><TD BGCOLOR="#ffffff">'.
- time2str("%D",$_date). '</TD></TR>';
-
-print qq!<TR><TD ALIGN="right">Amount</TD><TD BGCOLOR="#ffffff">\$<INPUT TYPE="text" NAME="paid" VALUE="$paid" SIZE=8 MAXLENGTH=8></TD></TR>!;
-
-print qq!<TR><TD ALIGN="right">Payby</TD><TD BGCOLOR="#ffffff">$payby</TD></TR>!;
-
-#payinfo (check # now as payby="BILL" hardcoded.. what to do later?)
-print qq!<TR><TD ALIGN="right">Check #</TD><TD BGCOLOR="#ffffff"><INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo"></TD></TR>!;
-
-print qq!<TR><TD ALIGN="right">Auto-apply<BR>to invoices</TD><TD><SELECT NAME="apply"><OPTION VALUE="yes" SELECTED>yes<OPTION>no</SELECT></TD>!;
-
-print "</TABLE>";
-
-#paybatch
-print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="$paybatch">!;
+<%= small_custview($custnum, $conf->config('countrydefault')) %>
+
+<INPUT TYPE="hidden" NAME="payby" VALUE="<%= $payby %>">
+
+<BR><BR>
+Payment
+<%= ntable("#cccccc", 2) %>
+<TR>
+ <TD ALIGN="right">Date</TD>
+ <TD COLSPAN=2>
+ <INPUT TYPE="text" NAME="_date" ID="_date_text" VALUE="<%= time2str("%m/%d/%Y %r",$_date) %>">
+ <IMG SRC="../images/calendar.png" ID="_date_button" STYLE="cursor: pointer" TITLE="Select date">
+ </TD>
+</TR>
+<SCRIPT TYPE="text/javascript">
+ Calendar.setup({
+ inputField: "_date_text",
+ ifFormat: "%m/%d/%Y",
+ button: "_date_button",
+ align: "BR"
+ });
+</SCRIPT>
+<TR>
+ <TD ALIGN="right">Amount</TD>
+ <TD BGCOLOR="#ffffff" ALIGN="right">$</TD>
+ <TD><INPUT TYPE="text" NAME="paid" VALUE="<%= $paid %>" SIZE=8 MAXLENGTH=8></TD>
+</TR>
+<TR>
+ <TD ALIGN="right">Check #</TD>
+ <TD COLSPAN=2><INPUT TYPE="text" NAME="payinfo" VALUE="<%= $payinfo %>" SIZE=10></TD>
+</TR>
+<TR>
+ <TD ALIGN="right">Auto-apply<BR>to invoices</TD>
+ <TD COLSPAN=2><SELECT NAME="apply"><OPTION VALUE="yes" SELECTED>yes<OPTION>no</SELECT></TD>
+</TR>
+
+</TABLE>
+
+<INPUT TYPE="hidden" NAME="paybatch" VALUE="<%= $paybatch %>">
-print <<END;
<BR>
<INPUT TYPE="submit" VALUE="Post payment">
</FORM>
</BODY>
</HTML>
-END
-
-%>
foreach my $option ( keys %{$exports->{$layer}{options}} ) {
my $optinfo = $exports->{$layer}{options}{$option};
+ die "Retreived non-ref export info option from $layer export: $optinfo"
+ unless ref($optinfo);
my $label = $optinfo->{label};
my $type = defined($optinfo->{type}) ? $optinfo->{type} : 'text';
my $value = $cgi->param($option)
print '>';
print '</TD></TR></TABLE>';
-my $thead = "\n\n". ntable('#cccccc', 2). <<END;
-<TR><TH BGCOLOR="#dcdcdc"><FONT SIZE=-1>Quan.</FONT></TH><TH BGCOLOR="#dcdcdc">Service</TH></TR>
-END
+my $thead = "\n\n". ntable('#cccccc', 2).
+ '<TR><TH BGCOLOR="#dcdcdc"><FONT SIZE=-1>Quan.</FONT></TH>';
+$thead .= '<TH BGCOLOR="#dcdcdc"><FONT SIZE=-1>Primary</FONT></TH>'
+ if dbdef->table('pkg_svc')->column('primary_svc');
+$thead .= '<TH BGCOLOR="#dcdcdc">Service</TH></TR>';
#unless ( $cgi->param('clone') ) {
#dunno why...
'pkgpart' => $pkgpart,
'svcpart' => $svcpart,
} ) || new FS::pkg_svc ( {
- 'pkgpart' => $pkgpart,
- 'svcpart' => $svcpart,
- 'quantity' => 0,
+ 'pkgpart' => $pkgpart,
+ 'svcpart' => $svcpart,
+ 'quantity' => 0,
+ 'primary_svc' => '',
});
#? #next unless $pkg_svc;
print '<TR>'; # if $count == 0 ;
print qq!<TD><INPUT TYPE="text" NAME="pkg_svc$svcpart" SIZE=4 MAXLENGTH=3 VALUE="!,
$cgi->param("pkg_svc$svcpart") || $pkg_svc->quantity || 0,
- qq!"></TD><TD><A HREF="part_svc.cgi?!,$part_svc->svcpart,
+ qq!"></TD>!;
+ if ( dbdef->table('pkg_svc')->column('primary_svc') ) {
+ print qq!<TD><INPUT TYPE="radio" NAME="pkg_svc_primary" VALUE="$svcpart"!;
+ print ' CHECKED' if $pkg_svc->primary_svc =~ /^Y/i;
+ print '></TD>';
+ }
+ print qq!<TD><A HREF="part_svc.cgi?!,$part_svc->svcpart,
qq!">!, $part_svc->getfield('svc'), "</A></TD></TR>";
# print "</TABLE></TD><TD>$thead" if ++$count == int(scalar(@part_svc) / 2);
$count+=1;
push @fixups, 'taxclass'; #hidden
}
+my @form_radio = ();
+if ( dbdef->table('pkg_svc')->column('primary_svc') ) {
+ push @form_radio, 'pkg_svc_primary';
+}
my $widget = new HTML::Widgets::SelectLayers(
'selected_layer' => $part_pkg->plan,
'form_action' => 'process/part_pkg.cgi',
'form_text' => [ qw(pkg comment freq clone pkgnum pkgpart), @fixups ],
'form_checkbox' => [ qw(setuptax recurtax disabled) ],
- 'form_select' => [ @form_select ],
+ 'form_radio' => \@form_radio,
+ 'form_select' => \@form_select,
'fixup_callback' => sub {
#my $ = @_;
my $html = '';
-<!-- mason kludge -->
-<%
- my $part_svc;
- my $clone = '';
- if ( $cgi->param('error') ) { #error
- $part_svc = new FS::part_svc ( {
- map { $_, scalar($cgi->param($_)) } fields('part_svc')
- } );
- } elsif ( $cgi->param('clone') && $cgi->param('clone') =~ /^(\d+)$/ ) {#clone
- #$cgi->param('clone') =~ /^(\d+)$/ or die "malformed query: $query";
- $part_svc = qsearchs('part_svc', { 'svcpart'=>$1 } )
- or die "unknown svcpart: $1";
- $clone = $part_svc->svcpart;
- $part_svc->svcpart('');
- } elsif ( $cgi->keywords ) { #edit
- my($query) = $cgi->keywords;
- $query =~ /^(\d+)$/ or die "malformed query: $query";
- $part_svc=qsearchs('part_svc', { 'svcpart'=>$1 } )
- or die "unknown svcpart: $1";
- } else { #adding
- $part_svc = new FS::part_svc {};
- }
- my $action = $part_svc->svcpart ? 'Edit' : 'Add';
- my $hashref = $part_svc->hashref;
+<%
+my $part_svc;
+my $clone = '';
+my $error = '';
+if ( $cgi->param('magic') eq 'process' ) {
+
+ my $svcpart = $cgi->param('svcpart');
+ my $old = qsearchs('part_svc', { 'svcpart' => $svcpart }) if $svcpart;
+
+ $cgi->param( 'svc_acct__usergroup',
+ join(',', $cgi->param('svc_acct__usergroup') ) );
+
+ my $new = new FS::part_svc ( {
+ map {
+ $_, scalar($cgi->param($_));
+ # } qw(svcpart svc svcdb)
+ } ( fields('part_svc'),
+ map { my $svcdb = $_;
+ my @fields = fields($svcdb);
+ push @fields, 'usergroup' if $svcdb eq 'svc_acct'; #kludge
+ map { ( $svcdb.'__'.$_, $svcdb.'__'.$_.'_flag' ) } @fields;
+ } grep defined( $FS::Record::dbdef->table($_) ),
+ qw( svc_acct svc_domain svc_forward svc_www svc_broadband )
+ )
+ } );
+
+ my %exportnums =
+ map { $_->exportnum => ( $cgi->param('exportnum'.$_->exportnum) || '') }
+ qsearch('part_export', {} );
+
+ if ( $svcpart ) {
+ $error = $new->replace($old, '1.3-COMPAT', [ 'usergroup' ], \%exportnums );
+ } else {
+ $error = $new->insert( [ 'usergroup' ], \%exportnums );
+ $svcpart = $new->getfield('svcpart');
+ }
+
+ unless ( $error ) { #no error, redirect
+ #print $cgi->redirect(popurl(3)."browse/part_svc.cgi");
+ print $cgi->redirect("${p}browse/part_svc.cgi");
+ myexit;
+ }
+
+ $part_svc = $new; #??
+ #$part_svc = new FS::part_svc ( {
+ # map { $_, scalar($cgi->param($_)) } fields('part_svc')
+ #} );
+
+} elsif ( $cgi->param('clone') && $cgi->param('clone') =~ /^(\d+)$/ ) {#clone
+ #$cgi->param('clone') =~ /^(\d+)$/ or die "malformed query: $query";
+ $part_svc = qsearchs('part_svc', { 'svcpart'=>$1 } )
+ or die "unknown svcpart: $1";
+ $clone = $part_svc->svcpart;
+ $part_svc->svcpart('');
+} elsif ( $cgi->keywords ) { #edit
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/ or die "malformed query: $query";
+ $part_svc=qsearchs('part_svc', { 'svcpart'=>$1 } )
+ or die "unknown svcpart: $1";
+} else { #adding
+ $part_svc = new FS::part_svc {};
+}
+
+my $action = $part_svc->svcpart ? 'Edit' : 'Add';
+my $hashref = $part_svc->hashref;
# my $p_svcdb = $part_svc->svcdb || 'svc_acct';
#" onLoad=\"visualize()\""
%>
-
+<!-- mason kludge -->
<%= header("$action Service Definition",
menubar( 'Main Menu' => $p,
'View all service definitions' => "${p}browse/part_svc.cgi"
)
%>
-<% if ( $cgi->param('error') ) { %>
-<FONT SIZE="+1" COLOR="#ff0000">Error: <%= $cgi->param('error') %></FONT>
+<% if ( $error ) { %>
+<FONT SIZE="+1" COLOR="#ff0000">Error: <%= $error %></FONT>
<% } %>
<FORM NAME="dummy">
<BR><BR>
Service <INPUT TYPE="text" NAME="svc" VALUE="<%= $hashref->{svc} %>"><BR>
Disable new orders <INPUT TYPE="checkbox" NAME="disabled" VALUE="Y"<%= $hashref->{disabled} eq 'Y' ? ' CHECKED' : '' %>><BR>
+<INPUT TYPE="hidden" NAME="magic" VALUE="process">
<INPUT TYPE="hidden" NAME="svcpart" VALUE="<%= $hashref->{svcpart} %>">
<BR>
Services are items you offer to your customers.
<%
#these might belong somewhere else for other user interfaces
#pry need to eventually create stuff that's shared amount UIs
+my $conf = new FS::Conf;
my %defs = (
'svc_acct' => {
'dir' => 'Home directory',
'quota' => '',
'_password' => 'Password',
'gid' => 'GID (when blank, defaults to UID)',
- 'shell' => 'Shell (all service definitions should have a default or fixed shell that is present in the <b>shells</b> configuration file)',
+ 'shell' => {
+ desc =>'Shell (all service definitions should have a default or fixed shell that is present in the <b>shells</b> configuration file)',
+ type =>'select',
+ select_list => [ $conf->config('shells') ],
+ },
'finger' => 'GECOS',
'domsvc' => {
desc =>'svcnum from svc_domain',
'selected_layer' => $hashref->{svcdb} || 'svc_acct',
'options' => \%svcdb,
'form_name' => 'dummy',
- 'form_action' => 'process/part_svc.cgi',
- 'form_text' => [ qw( svc svcpart ) ],
+ #'form_action' => 'process/part_svc.cgi',
+ 'form_action' => 'part_svc.cgi', #self
+ 'form_text' => [ qw( magic svc svcpart ) ],
'form_checkbox' => [ 'disabled' ],
'layer_callback' => sub {
my $layer = shift;
$part_svc->svcpart($clone) if $clone; #haha, undone below
foreach my $field (@fields) {
my $part_svc_column = $part_svc->part_svc_column($field);
- my $value = $cgi->param('error')
+ my $value = $error
? $cgi->param("${layer}__${field}")
: $part_svc_column->columnvalue;
- my $flag = $cgi->param('error')
+ my $flag = $error
? $cgi->param("${layer}__${field}_flag")
: $part_svc_column->columnflag;
my $def = $defs{$layer}{$field};
if ( $def->{type} eq 'select' ) {
$html .= qq!<SELECT NAME="${layer}__${field}">!;
$html .= '<OPTION> </OPTION>' unless $value;
- foreach my $record ( qsearch( $def->{select_table}, {} ) ) {
- my $rvalue = $record->getfield($def->{select_key});
- $html .= qq!<OPTION VALUE="$rvalue"!.
- ( $rvalue==$value ? ' SELECTED>' : '>' ).
- $record->getfield($def->{select_label}). '</OPTION>';
- }
+ if ( $def->{select_table} ) {
+ foreach my $record ( qsearch( $def->{select_table}, {} ) ) {
+ my $rvalue = $record->getfield($def->{select_key});
+ $html .= qq!<OPTION VALUE="$rvalue"!.
+ ( $rvalue==$value ? ' SELECTED>' : '>' ).
+ $record->getfield($def->{select_label}). '</OPTION>';
+ } #next $record
+ } else { # select_list
+ foreach my $item ( @{$def->{select_list}} ) {
+ $html .= qq!<OPTION VALUE="$item"!.
+ ( $item eq $value ? ' SELECTED>' : '>' ).
+ $item. '</OPTION>';
+ } #next $item
+ } #endif
$html .= '</SELECT>';
} elsif ( $def->{type} eq 'radius_usergroup_selector' ) {
$html .= FS::svc_acct::radius_usergroup_selector(
$cgi->param('error', $error);
print $cgi->redirect(popurl(2). "REAL_cust_pkg.cgi?". $cgi->query_string );
} else {
- print $cgi->redirect(popurl(3). "view/cust_pkg.cgi?". $pkgnum);
+ my $custnum = $new->custnum;
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum".
+ "#cust_pkg$pkgnum" );
}
%>
if defined $cgi->param( $payby. '_paycvv' );
}
-$cgi->param('otaker', &getotaker );
-
my @invoicing_list = split( /\s*\,\s*/, $cgi->param('invoicing_list') );
push @invoicing_list, 'POST' if $cgi->param('invoicing_list_POST');
$cgi->param('invoicing_list', join(',', @invoicing_list) );
my($query) = $cgi->keywords;
$query =~ /^(\d+)$/ or die "Illegal taxnum!";
my $taxnum = $1;
-my $cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum})
- or die ("Unknown taxnum!");
+my $cust_main_county = qsearchs('cust_main_county', { 'taxnum' => $taxnum } )
+ or die "Unknown taxnum $taxnum";
#really should do this in a .pm & start transaction
or die "Illegal link: ". $cgi->param('link');
my $link = $1;
+my $_date = str2time($cgi->param('_date'));
+
my $new = new FS::cust_pay ( {
$link => $linknum,
+ _date => $_date,
map {
$_, scalar($cgi->param($_));
- } qw(paid _date payby payinfo paybatch)
+ } qw(paid payby payinfo paybatch)
#} fields('cust_pay')
} );
} fields('part_pkg')
} );
-#warn "setuptax: ". $new->setuptax;
-#warn "recurtax: ". $new->recurtax;
-
-#most of the stuff below should move to part_pkg.pm
-
-foreach my $part_svc ( qsearch('part_svc', {} ) ) {
- my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0;
- unless ( $quantity =~ /^(\d+)$/ ) {
- $cgi->param('error', "Illegal quantity" );
- print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string );
- myexit();
- }
-}
-
-local $SIG{HUP} = 'IGNORE';
-local $SIG{INT} = 'IGNORE';
-local $SIG{QUIT} = 'IGNORE';
-local $SIG{TERM} = 'IGNORE';
-local $SIG{TSTP} = 'IGNORE';
-local $SIG{PIPE} = 'IGNORE';
-
-local $FS::UID::AutoCommit = 0;
+my %pkg_svc = map { $_ => $cgi->param("pkg_svc$_") }
+ map { $_->svcpart }
+ qsearch('part_svc', {} );
my $error;
+my $custnum = '';
if ( $pkgpart ) {
- $error = $new->replace($old);
+ $error = $new->replace( $old, 'pkg_svc' => \%pkg_svc,
+ 'primary_svc' => $cgi->param('pkg_svc_primary'),
+ );
} else {
- $error = $new->insert;
- $pkgpart=$new->pkgpart;
+ $error = $new->insert( 'pkg_svc' => \%pkg_svc,
+ 'primary_svc' => $cgi->param('pkg_svc_primary'),
+ 'cust_pkg' => $cgi->param('pkgnum'),
+ 'custnum_ref' => \$custnum,
+ );
+ $pkgpart = $new->pkgpart;
}
if ( $error ) {
- $dbh->rollback;
$cgi->param('error', $error );
print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string );
- myexit();
-}
-
-foreach my $part_svc (qsearch('part_svc',{})) {
- my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0;
- my $old_pkg_svc = qsearchs('pkg_svc', {
- 'pkgpart' => $pkgpart,
- 'svcpart' => $part_svc->svcpart,
- } );
- my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0;
- next unless $old_quantity != $quantity; #!here
- my $new_pkg_svc = new FS::pkg_svc( {
- 'pkgpart' => $pkgpart,
- 'svcpart' => $part_svc->svcpart,
- 'quantity' => $quantity,
- } );
- if ( $old_pkg_svc ) {
- my $myerror = $new_pkg_svc->replace($old_pkg_svc);
- if ( $myerror ) {
- $dbh->rollback;
- die $myerror;
- }
- } else {
- my $myerror = $new_pkg_svc->insert;
- if ( $myerror ) {
- $dbh->rollback;
- die $myerror;
- }
- }
-}
-
-unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) {
- $dbh->commit or die $dbh->errstr;
- print $cgi->redirect(popurl(3). "browse/part_pkg.cgi");
+} elsif ( $custnum ) {
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum");
} else {
- my($old_cust_pkg) = qsearchs( 'cust_pkg', { 'pkgnum' => $1 } );
- my %hash = $old_cust_pkg->hash;
- $hash{'pkgpart'} = $pkgpart;
- my($new_cust_pkg) = new FS::cust_pkg \%hash;
- my $myerror = $new_cust_pkg->replace($old_cust_pkg);
- if ( $myerror ) {
- $dbh->rollback;
- die "Error modifying cust_pkg record: $myerror\n";
- }
-
- $dbh->commit or die $dbh->errstr;
- print $cgi->redirect(popurl(3). "view/cust_main.cgi?". $new_cust_pkg->custnum);
+ print $cgi->redirect(popurl(3). "browse/part_pkg.cgi");
}
%>
+++ /dev/null
-<%
-
-my $svcpart = $cgi->param('svcpart');
-
-my $old = qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart;
-
-$cgi->param( 'svc_acct__usergroup',
- join(',', $cgi->param('svc_acct__usergroup') ) );
-
-my $new = new FS::part_svc ( {
- map {
- $_, scalar($cgi->param($_));
-# } qw(svcpart svc svcdb)
- } ( fields('part_svc'),
- map { my $svcdb = $_;
- my @fields = fields($svcdb);
- push @fields, 'usergroup' if $svcdb eq 'svc_acct'; #kludge
- map { ( $svcdb.'__'.$_, $svcdb.'__'.$_.'_flag' ) } @fields;
- } grep defined( $FS::Record::dbdef->table($_) ),
- qw( svc_acct svc_domain svc_acct_sm svc_forward svc_www )
- )
-} );
-
-my $error;
-if ( $svcpart ) {
- $error = $new->replace($old, '1.3-COMPAT', [ 'usergroup' ] );
-} else {
- $error = $new->insert( [ 'usergroup' ] );
- $svcpart=$new->getfield('svcpart');
-}
-
-if ( $error ) {
- $cgi->param('error', $error);
- print $cgi->redirect(popurl(2). "part_svc.cgi?". $cgi->query_string );
-} else {
-
- #false laziness w/ edit/process/agent_type.cgi
- foreach my $part_export (qsearch('part_export',{})) {
- my $exportnum = $part_export->exportnum;
- my $export_svc = qsearchs('export_svc', {
- 'exportnum' => $part_export->exportnum,
- 'svcpart' => $new->svcpart,
- } );
- if ( $export_svc && ! $cgi->param("exportnum". $part_export->exportnum) ) {
- $error = $export_svc->delete;
- die $error if $error;
- } elsif ( $cgi->param("exportnum". $part_export->exportnum)
- && ! $export_svc ) {
- $export_svc = new FS::export_svc ( {
- 'exportnum' => $part_export->exportnum,
- 'svcpart' => $new->svcpart,
- } );
- $error = $export_svc->insert;
- die $error if $error;
- }
-
- }
-
- print $cgi->redirect(popurl(3)."browse/part_svc.cgi");
-}
-
-%>
<%
eidiot($error);
} else {
- print $cgi->redirect(popurl(3). "view/cust_pkg.cgi?". $cust_pkg[0]->pkgnum );
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum".
+ "#cust_pkg". $cust_pkg[0]->pkgnum );
}
%>
my $action = $svc_forward->svcnum ? 'Edit' : 'Add';
my %email;
+
+#starting with those currently attached
+foreach my $method (qw( srcsvc_acct dstsvc_acct )) {
+ my $svc_acct = $svc_forward->$method();
+ $email{$svc_acct->svcnum} = $svc_acct->email if $svc_acct;
+}
+
if ($pkgnum) {
#find all possible user svcnums (and emails)
- #starting with those currently attached
- if ( $svc_forward->srcsvc ) {
- my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_forward->srcsvc } );
- $email{$svc_forward->srcsvc} = $svc_acct->email;
- }
- if ( $svc_forward->dstsvc ) {
- my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_forward->dstsvc } );
- $email{$svc_forward->dstsvc} = $svc_acct->email;
- }
-
#and including the rest for this customer
my($u_part_svc,@u_acct_svcparts);
foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
}
}
-} elsif ( $action eq 'Edit' ) {
-
- my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$svc_forward->srcsvc});
- $email{$svc_forward->srcsvc} = $svc_acct->email;
-
- $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svc_forward->dstsvc});
- $email{$svc_forward->dstsvc} = $svc_acct->email;
-
-} else {
+} elsif ( $action eq 'Add' ) {
die "\$action eq Add, but \$pkgnum is null!\n";
}
$svc_forward->dstsvc,
$svc_forward->dst,
);
+my $src = $svc_forward->dbdef_table->column('src') ? $svc_forward->src : '';
#display
Service #<%= $svcnum ? "<B>$svcnum</B>" : " (NEW)" %><BR>
Service: <B><%= $part_svc->svc %></B><BR><BR>
-<FORM NAME="dummy">
+<FORM ACTION="process/svc_forward.cgi" METHOD="POST">
+<INPUT TYPE="hidden" NAME="svcnum" VALUE="<%= $svcnum %>">
+<INPUT TYPE="hidden" NAME="pkgnum" VALUE="<%= $pkgnum %>">
+<INPUT TYPE="hidden" NAME="svcpart" VALUE="<%= $svcpart %>">
+
+<SCRIPT TYPE="text/javascript">
+function srcchanged(what) {
+ if ( what.options[what.selectedIndex].value == 0 ) {
+ what.form.src.disabled = false;
+ what.form.src.style.backgroundColor = "white";
+ } else {
+ what.form.src.disabled = true;
+ what.form.src.style.backgroundColor = "lightgrey";
+ }
+}
+function dstchanged(what) {
+ if ( what.options[what.selectedIndex].value == 0 ) {
+ what.form.dst.disabled = false;
+ what.form.dst.style.backgroundColor = "white";
+ } else {
+ what.form.dst.disabled = true;
+ what.form.dst.style.backgroundColor = "lightgrey";
+ }
+}
+</SCRIPT>
<%= ntable("#cccccc",2) %>
-<TR><TD ALIGN="right">Email to</TD><TD><SELECT NAME="srcsvc" SIZE=1>
+<TR><TD ALIGN="right">Email to</TD>
+<TD><SELECT NAME="srcsvc" SIZE=1 onChange="srcchanged(this)">
<% foreach $_ (keys %email) { %>
<OPTION<%= $_ eq $srcsvc ? " SELECTED" : "" %> VALUE="<%= $_ %>"><%= $email{$_} %></OPTION>
<% } %>
-</SELECT></TD></TR>
-
-<%
- tie my %tied_email, 'Tie::IxHash',
- '' => 'SELECT DESTINATION',
- %email,
- '0' => '(other email address)';
- my $widget = new HTML::Widgets::SelectLayers(
- 'selected_layer' => $dstsvc,
- 'options' => \%tied_email,
- 'form_name' => 'dummy',
- 'form_action' => 'process/svc_forward.cgi',
- 'form_select' => ['srcsvc'],
- 'html_between' => '</TD></TR></TABLE>',
- 'layer_callback' => sub {
- my $layer = shift;
- my $html = qq!<INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">!.
- qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!.
- qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!.
- qq!<INPUT TYPE="hidden" NAME="dstsvc" VALUE="$layer">!;
- if ( $layer eq '0' ) {
- $html .= ntable("#cccccc",2).
- '<TR><TD ALIGN="right">Destination email</TD>'.
- qq!<TD><INPUT TYPE="text" NAME="dst" VALUE="$dst"></TD>!.
- '</TR></TABLE>';
- }
- $html .= '<BR><INPUT TYPE="submit" VALUE="Submit">';
- $html;
- },
- );
-%>
+<% if ( $svc_forward->dbdef_table->column('src') ) { %>
+ <OPTION <%= $src ? 'SELECTED' : '' %> VALUE="0">(other email address)</OPTION>
+<% } %>
+</SELECT>
+<% if ( $svc_forward->dbdef_table->column('src') ) { %>
+<INPUT TYPE="text" NAME="src" VALUE="<%= $src %>" <%= ( $src || !scalar(%email) ) ? '' : 'DISABLED STYLE="background-color: lightgrey"' %>>
+<% } %>
+</TD></TR>
<TR><TD ALIGN="right">Forwards to</TD>
-<TD><%= $widget->html %>
+<TD><SELECT NAME="dstsvc" SIZE=1 onChange="dstchanged(this)">
+<% foreach $_ (keys %email) { %>
+ <OPTION<%= $_ eq $dstsvc ? " SELECTED" : "" %> VALUE="<%= $_ %>"><%= $email{$_} %></OPTION>
+<% } %>
+<OPTION <%= $dst ? 'SELECTED' : '' %> VALUE="0">(other email address)</OPTION>
+</SELECT>
+<INPUT TYPE="text" NAME="dst" VALUE="<%= $dst %>" <%= ( $dst || !scalar(%email) ) ? '' : 'DISABLED STYLE="background-color: lightgrey"' %>>
+</TD></TR>
+ </TABLE>
+<BR><INPUT TYPE="submit" VALUE="Submit">
+</FORM>
</BODY>
</HTML>
<!-- mason kludge -->
<%
+my $conf = new FS::Conf;
+
my( $svcnum, $pkgnum, $svcpart, $part_svc, $svc_www );
if ( $cgi->param('error') ) {
$svc_www = new FS::svc_www ( {
}
my $action = $svc_www->svcnum ? 'Edit' : 'Add';
-my( %username, %arec );
+my( %svc_acct, %arec );
if ($pkgnum) {
- my($u_part_svc,@u_acct_svcparts);
- foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
- push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
+ my @u_acct_svcparts;
+ foreach my $svcpart (
+ map { $_->svcpart } qsearch( 'part_svc', { 'svcdb' => 'svc_acct' } )
+ ) {
+ next if $conf->exists('svc_www-usersvc_svcpart')
+ && ! grep { $svcpart == $_ }
+ $conf->config('svc_www-usersvc_svcpart');
+ push @u_acct_svcparts, $svcpart;
}
my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
my($i_cust_svc);
foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
- $username{$svc_acct->getfield('svcnum')}=$svc_acct->getfield('username');
+ $svc_acct{$svc_acct->getfield('svcnum')}=
+ $svc_acct->cust_svc->part_svc->svc. ': '. $svc_acct->email;
}
}
}
push @d_acct_svcparts,$d_part_svc->getfield('svcpart');
}
- foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
- my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
- my($acct_svcpart);
- foreach $acct_svcpart (@d_acct_svcparts) {
- my($i_cust_svc);
- foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
- my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
- my $domain_rec;
- foreach $domain_rec ( qsearch('domain_record',{
- 'svcnum' => $svc_domain->svcnum,
- 'rectype' => 'A' } ),
- qsearch('domain_record',{
- 'svcnum' => $svc_domain->svcnum,
- 'rectype' => 'CNAME'
- } ) ) {
- $arec{$domain_rec->recnum} =
- $domain_rec->reczone eq '@'
- ? $svc_domain->domain
- : $domain_rec->reczone. '.'. $svc_domain->domain;
+ foreach $i_cust_pkg ( qsearch( 'cust_pkg', { 'custnum' => $custnum } ) ) {
+ my $cust_pkgnum = $i_cust_pkg->pkgnum;
+
+ foreach my $acct_svcpart (@d_acct_svcparts) {
+
+ foreach my $i_cust_svc (
+ qsearch( 'cust_svc', { 'pkgnum' => $cust_pkgnum,
+ 'svcpart' => $acct_svcpart } )
+ ) {
+ my $svc_domain =
+ qsearchs( 'svc_domain', { 'svcnum' => $i_cust_svc->svcnum } );
+
+ my $extra_sql = "AND ( rectype = 'A' OR rectype = 'CNAME' )";
+ unless ( $conf->exists('svc_www-enable_subdomains') ) {
+ $extra_sql .= " AND ( reczone = '\@' OR reczone = '".
+ $svc_domain->domain. ".' )";
+ }
+
+ foreach my $domain_rec (
+ qsearch( 'domain_record',
+ {
+ 'svcnum' => $svc_domain->svcnum,
+ },
+ '',
+ $extra_sql,
+ )
+ ) {
+ $arec{$domain_rec->recnum} = $domain_rec->zone;
+ }
+
+ if ( $conf->exists('svc_www-enable_subdomains') ) {
+ $arec{'www.'. $svc_domain->domain} = 'www.'. $svc_domain->domain
+ unless qsearchs( 'domain_record', {
+ svcnum => $svc_domain->svcnum,
+ reczone => 'www',
+ } )
+ || qsearchs( 'domain_record', {
+ svcnum => $svc_domain->svcnum,
+ reczone => 'www.'.$svc-domain->domain.'.',
+ } );
}
+
$arec{'@.'. $svc_domain->domain} = $svc_domain->domain
- unless qsearchs('domain_record', { svcnum => $svc_domain->svcnum,
- reczone => '@', } );
- $arec{'www.'. $svc_domain->domain} = 'www.'. $svc_domain->domain
- unless qsearchs('domain_record', { svcnum => $svc_domain->svcnum,
- reczone => 'www', } );
+ unless qsearchs('domain_record', {
+ svcnum => $svc_domain->svcnum,
+ reczone => '@',
+ } )
+ || qsearchs('domain_record', {
+ svcnum => $svc_domain->svcnum,
+ reczone => $svc_domain->domain.'.',
+ } );
+
}
+
}
}
print "</SELECT></TD></TR>";
print '<TR><TD ALIGN="right">Username</TD><TD><SELECT NAME="usersvc" SIZE=1>';
-foreach $_ (keys %username) {
+foreach $_ (keys %svc_acct) {
print "<OPTION", ($_ eq $usersvc) ? " SELECTED" : "",
- qq! VALUE="$_">$username{$_}!;
+ qq! VALUE="$_">$svc_acct{$_}!;
}
print "</SELECT></TD></TR>";
Calendar._TT["SEL_DATE"] = "Select date";
Calendar._TT["DRAG_TO_MOVE"] = "Drag to move";
Calendar._TT["PART_TODAY"] = " (today)";
-Calendar._TT["MON_FIRST"] = "Display Monday first";
-Calendar._TT["SUN_FIRST"] = "Display Sunday first";
+
+// the following is to inform that "%s" is to be the first day of week
+// %s will be replaced with the day name.
+Calendar._TT["DAY_FIRST"] = "Display %s first";
+
+// This may be locale-dependent. It specifies the week-end days, as an array
+// of comma-separated numbers. The numbers are from 0 to 6: 0 means Sunday, 1
+// means Monday, etc.
+Calendar._TT["WEEKEND"] = "0,6";
+
Calendar._TT["CLOSE"] = "Close";
Calendar._TT["TODAY"] = "Today";
Calendar._TT["TIME_PART"] = "(Shift-)Click or drag to change value";
Calendar._TT["TT_DATE_FORMAT"] = "%a, %b %e";
Calendar._TT["WK"] = "wk";
+Calendar._TT["TIME"] = "Time:";
* than modifying calendar.js itself).
*/
-// $Id: calendar-setup.js,v 1.1.2.2 2003-11-07 10:53:36 ivan Exp $
+// $Id: calendar-setup.js,v 1.1.2.3 2004-09-22 11:04:48 ivan Exp $
/**
* This function "patches" an input field (or other element) to use a calendar
* ifFormat | date format that will be stored in the input field
* daFormat | the date format that will be used to display the date in displayArea
* singleClick | (true/false) wether the calendar is in single click mode or not (default: true)
- * mondayFirst | (true/false) if true Monday is the first day of week, Sunday otherwise (default: true)
- * align | alignment (default: "Bl"); if you don't know what's this see the calendar documentation
+ * firstDay | numeric: 0 to 6. "0" means display Sunday first, "1" means display Monday first, etc.
+ * align | alignment (default: "Br"); if you don't know what's this see the calendar documentation
* range | array with 2 elements. Default: [1900, 2999] -- the range of years available
* weekNumbers | (true/false) if it's true (default) the calendar will display week numbers
* flat | null or element ID; if not null the calendar will be a flat calendar having the parent with the given ID
* date | the date that the calendar will be initially displayed to
* showsTime | default: false; if true the calendar will include a time selector
* timeFormat | the time format; can be "12" or "24", default is "12"
+ * electric | if true (default) then given fields/date areas are updated for each move; otherwise they're updated only on close
+ * step | configures the step of the years in drop-down boxes; default: 2
+ * position | configures the calendar absolute position; default: null
+ * cache | if "true" (but default: "false") it will reuse the same calendar object, where possible
+ * showOthers | if "true" (but default: "false") it will show days from other months too
*
* None of them is required, they all have default values. However, if you
* pass none of "inputField", "displayArea" or "button" you'll get a warning
param_default("singleClick", true);
param_default("disableFunc", null);
param_default("dateStatusFunc", params["disableFunc"]); // takes precedence if both are defined
- param_default("mondayFirst", true);
- param_default("align", "Bl");
+ param_default("firstDay", 0); // defaults to "Sunday" first
+ param_default("align", "Br");
param_default("range", [1900, 2999]);
param_default("weekNumbers", true);
param_default("flat", null);
param_default("date", null);
param_default("showsTime", false);
param_default("timeFormat", "24");
+ param_default("electric", true);
+ param_default("step", 2);
+ param_default("position", null);
+ param_default("cache", false);
+ param_default("showOthers", false);
var tmp = ["inputField", "displayArea", "button"];
for (var i in tmp) {
}
function onSelect(cal) {
- if (cal.params.flat) {
- if (typeof cal.params.flatCallback == "function") {
- cal.params.flatCallback(cal);
- } else {
+ var p = cal.params;
+ var update = (cal.dateClicked || p.electric);
+ if (update && p.flat) {
+ if (typeof p.flatCallback == "function")
+ p.flatCallback(cal);
+ else
alert("No flatCallback given -- doing nothing.");
- }
return false;
}
- if (cal.params.inputField) {
- cal.params.inputField.value = cal.date.print(cal.params.ifFormat);
+ if (update && p.inputField) {
+ p.inputField.value = cal.date.print(p.ifFormat);
+ if (typeof p.inputField.onchange == "function")
+ p.inputField.onchange();
}
- if (cal.params.displayArea) {
- cal.params.displayArea.innerHTML = cal.date.print(cal.params.daFormat);
- }
- if (cal.params.singleClick && cal.dateClicked) {
+ if (update && p.displayArea)
+ p.displayArea.innerHTML = cal.date.print(p.daFormat);
+ if (update && p.singleClick && cal.dateClicked)
cal.callCloseHandler();
- }
- if (typeof cal.params.onUpdate == "function") {
- cal.params.onUpdate(cal);
- }
+ if (update && typeof p.onUpdate == "function")
+ p.onUpdate(cal);
};
if (params.flat != null) {
- params.flat = document.getElementById(params.flat);
+ if (typeof params.flat == "string")
+ params.flat = document.getElementById(params.flat);
if (!params.flat) {
alert("Calendar.setup:\n Flat specified but can't find parent.");
return false;
}
- var cal = new Calendar(params.mondayFirst, params.date, params.onSelect || onSelect);
+ var cal = new Calendar(params.firstDay, params.date, params.onSelect || onSelect);
cal.showsTime = params.showsTime;
cal.time24 = (params.timeFormat == "24");
cal.params = params;
var dateFmt = params.inputField ? params.ifFormat : params.daFormat;
var mustCreate = false;
var cal = window.calendar;
- if (!window.calendar) {
- window.calendar = cal = new Calendar(params.mondayFirst,
+ if (!(cal && params.cache)) {
+ window.calendar = cal = new Calendar(params.firstDay,
params.date,
params.onSelect || onSelect,
params.onClose || function(cal) { cal.hide(); });
cal.weekNumbers = params.weekNumbers;
mustCreate = true;
} else {
+ if (params.date)
+ cal.setDate(params.date);
cal.hide();
}
+ cal.showsOtherMonths = params.showOthers;
+ cal.yearStep = params.step;
cal.setRange(params.range[0], params.range[1]);
cal.params = params;
cal.setDateStatusHandler(params.dateStatusFunc);
cal.create();
cal.parseDate(dateEl.value || dateEl.innerHTML);
cal.refresh();
- cal.showAtElement(params.displayArea || params.inputField, params.align);
+ if (!params.position)
+ cal.showAtElement(params.button || params.displayArea || params.inputField, params.align);
+ else
+ cal.showAt(params.position[0], params.position[1]);
return false;
};
};
text-align: right;
padding: 2px 4px 2px 2px;
}
+.calendar tbody .day.othermonth {
+ font-size: 80%;
+ color: #aaa;
+}
+.calendar tbody .day.othermonth.oweekend {
+ color: #faa;
+}
.calendar table .wn {
padding: 2px 3px 2px 2px;
/* Combo boxes (menus that display months/years for direct selection) */
-.combo {
+.calendar .combo {
position: absolute;
display: none;
width: 4em;
border-bottom: 1px solid #000;
border-left: 1px solid #fff;
background: #e4d8e0;
- font-size: smaller;
+ font-size: 90%;
padding: 1px;
}
-.combo .label,
-.combo .label-IEfix {
+.calendar .combo .label,
+.calendar .combo .label-IEfix {
text-align: center;
padding: 1px;
}
-.combo .label-IEfix {
+.calendar .combo .label-IEfix {
width: 4em;
}
-.combo .active {
+.calendar .combo .active {
background: #d4c8d0;
padding: 0px;
border-top: 1px solid #000;
border-left: 1px solid #000;
}
-.combo .hilite {
+.calendar .combo .hilite {
background: #408;
color: #fea;
}
/* Copyright Mihai Bazon, 2002, 2003 | http://dynarch.com/mishoo/
* ------------------------------------------------------------------
*
- * The DHTML Calendar, version 0.9.5 "Your favorite time, bis"
+ * The DHTML Calendar, version 0.9.6 "Keep cool but don't freeze"
*
* Details and latest version at:
* http://dynarch.com/mishoo/calendar.epl
* Read the entire license text here: http://www.gnu.org/licenses/lgpl.html
*/
-// $Id: calendar.js,v 1.1.2.2 2003-11-07 10:53:36 ivan Exp $
+// $Id: calendar.js,v 1.1.2.3 2004-09-22 11:04:48 ivan Exp $
/** The Calendar object constructor. */
-Calendar = function (mondayFirst, dateStr, onSelected, onClose) {
+Calendar = function (firstDayOfWeek, dateStr, onSelected, onClose) {
// member variables
this.activeDiv = null;
this.currentDateEl = null;
this.ttDateFormat = Calendar._TT["TT_DATE_FORMAT"];
this.isPopup = true;
this.weekNumbers = true;
- this.mondayFirst = mondayFirst;
+ this.firstDayOfWeek = firstDayOfWeek; // 0 for Sunday, 1 for Monday, etc.
+ this.showsOtherMonths = false;
this.dateStr = dateStr;
this.ar_days = null;
this.showsTime = false;
this.time24 = true;
+ this.yearStep = 2;
// HTML elements
this.table = null;
this.element = null;
Calendar.is_ie = ( /msie/i.test(navigator.userAgent) &&
!/opera/i.test(navigator.userAgent) );
+Calendar.is_ie5 = ( Calendar.is_ie && /msie 5\.0/i.test(navigator.userAgent) );
+
/// detect Opera browser
Calendar.is_opera = /opera/i.test(navigator.userAgent);
ST = el.scrollTop;
var r = { x: el.offsetLeft - SL, y: el.offsetTop - ST };
if (el.offsetParent) {
- var tmp = Calendar.getAbsolutePos(el.offsetParent);
+ var tmp = this.getAbsolutePos(el.offsetParent);
r.x += tmp.x;
r.y += tmp.y;
}
s.display = "block";
if (cd.navtype < 0)
s.left = cd.offsetLeft + "px";
- else
- s.left = (cd.offsetLeft + cd.offsetWidth - mc.offsetWidth) + "px";
+ else {
+ var mcw = mc.offsetWidth;
+ if (typeof mcw == "undefined")
+ // Konqueror brain-dead techniques
+ mcw = 50;
+ s.left = (cd.offsetLeft + cd.offsetWidth - mcw) + "px";
+ }
s.top = (cd.offsetTop + cd.offsetHeight) + "px";
};
yr.style.display = "none";
}
yr = yr.nextSibling;
- Y += fwd ? 2 : -2;
+ Y += fwd ? cal.yearStep : -cal.yearStep;
}
if (show) {
var s = yc.style;
s.display = "block";
if (cd.navtype < 0)
s.left = cd.offsetLeft + "px";
- else
- s.left = (cd.offsetLeft + cd.offsetWidth - yc.offsetWidth) + "px";
+ else {
+ var ycw = yc.offsetWidth;
+ if (typeof ycw == "undefined")
+ // Konqueror brain-dead techniques
+ ycw = 50;
+ s.left = (cd.offsetLeft + cd.offsetWidth - ycw) + "px";
+ }
s.top = (cd.offsetTop + cd.offsetHeight) + "px";
}
};
break;
while (count-- > 0)
if (decrease) {
- if (!(--i in range))
+ if (--i < 0)
i = range.length - 1;
- } else if (!(++i in range))
+ } else if ( ++i >= range.length )
i = 0;
var newval = range[i];
el.firstChild.data = newval;
cal.dragging = false;
with (Calendar) {
removeEvent(document, "mousemove", calDragIt);
- removeEvent(document, "mouseover", stopEvent);
removeEvent(document, "mouseup", calDragEnd);
tableMouseUp(ev);
}
cal.activeDiv = el;
Calendar._C = cal;
if (el.navtype != 300) with (Calendar) {
- if (el.navtype == 50)
+ if (el.navtype == 50) {
el._current = el.firstChild.data;
+ addEvent(document, "mousemove", tableMouseOver);
+ } else
+ addEvent(document, Calendar.is_ie5 ? "mousemove" : "mouseover", tableMouseOver);
addClass(el, "hilite active");
- addEvent(document, "mouseover", tableMouseOver);
- addEvent(document, "mousemove", tableMouseOver);
addEvent(document, "mouseup", tableMouseUp);
} else if (cal.isPopup) {
cal._dragStart(ev);
}
if (el.ttip) {
if (el.ttip.substr(0, 1) == "_") {
- var date = null;
- with (el.calendar.date) {
- date = new Date(getFullYear(), getMonth(), el.caldate);
- }
- el.ttip = date.print(el.calendar.ttDateFormat) + el.ttip.substr(1);
+ el.ttip = el.caldate.print(el.calendar.ttDateFormat) + el.ttip.substr(1);
}
el.calendar.tooltips.firstChild.data = el.ttip;
}
if (!closing) {
cal.currentDateEl = el;
}
- cal.date.setDate(el.caldate);
+ cal.date = new Date(el.caldate);
date = cal.date;
newdate = true;
// a date was clicked
- cal.dateClicked = true;
+ if (!(cal.dateClicked = !el.otherMonth))
+ cal._init(cal.firstDayOfWeek, date);
} else {
if (el.navtype == 200) {
Calendar.removeClass(el, "hilite");
}
break;
case 100:
- cal.setMondayFirst(!cal.mondayFirst);
+ cal.setFirstDayOfWeek(el.fdow);
return;
case 50:
var range = el._range;
if (range[i] == current)
break;
if (ev && ev.shiftKey) {
- if (!(--i in range))
+ if (--i < 0)
i = range.length - 1;
- } else if (!(++i in range))
+ } else if ( ++i >= range.length )
i = 0;
var newval = range[i];
el.firstChild.data = newval;
cell = Calendar.createElement("td", row);
cell.className = "time";
cell.colSpan = 2;
- cell.innerHTML = " ";
+ cell.innerHTML = Calendar._TT["TIME"] || " ";
cell = Calendar.createElement("td", row);
cell.className = "time";
div.appendChild(yr);
}
- this._init(this.mondayFirst, this.date);
+ this._init(this.firstDayOfWeek, this.date);
parent.appendChild(this.element);
};
Calendar.cellClick(cal._nav_now);
break;
case 27: // KEY esc
- act && cal.hide();
+ act && cal.callCloseHandler();
break;
case 37: // KEY left
case 38: // KEY up
}
Calendar.removeClass(el, "selected");
Calendar.addClass(ne, "selected");
- cal.date.setDate(ne.caldate);
+ cal.date = new Date(ne.caldate);
cal.callHandler();
cal.currentDateEl = ne;
}
};
/**
- * (RE)Initializes the calendar to the given date and style (if mondayFirst is
- * true it makes Monday the first day of week, otherwise the weeks start on
- * Sunday.
+ * (RE)Initializes the calendar to the given date and firstDayOfWeek
*/
-Calendar.prototype._init = function (mondayFirst, date) {
+Calendar.prototype._init = function (firstDayOfWeek, date) {
var today = new Date();
+ this.table.style.visibility = "hidden";
var year = date.getFullYear();
if (year < this.minYear) {
year = this.minYear;
year = this.maxYear;
date.setFullYear(year);
}
- this.mondayFirst = mondayFirst;
+ this.firstDayOfWeek = firstDayOfWeek;
this.date = new Date(date);
var month = date.getMonth();
var mday = date.getDate();
var no_days = date.getMonthDays();
+
+ // calendar voodoo for computing the first day that would actually be
+ // displayed in the calendar, even if it's from the previous month.
+ // WARNING: this is magic. ;-)
date.setDate(1);
- var wday = date.getDay();
- var MON = mondayFirst ? 1 : 0;
- var SAT = mondayFirst ? 5 : 6;
- var SUN = mondayFirst ? 6 : 0;
- if (mondayFirst) {
- wday = (wday > 0) ? (wday - 1) : 6;
- }
- var iday = 1;
+ var day1 = (date.getDay() - this.firstDayOfWeek) % 7;
+ if (day1 < 0)
+ day1 += 7;
+ date.setDate(-day1);
+ date.setDate(date.getDate() + 1);
+
var row = this.tbody.firstChild;
var MN = Calendar._SMN[month];
- var hasToday = ((today.getFullYear() == year) && (today.getMonth() == month));
- var todayDate = today.getDate();
- var week_number = date.getWeekNumber();
var ar_days = new Array();
- for (var i = 0; i < 6; ++i) {
- if (iday > no_days) {
- row.className = "emptyrow";
- row = row.nextSibling;
- continue;
- }
+ var weekend = Calendar._TT["WEEKEND"];
+ for (var i = 0; i < 6; ++i, row = row.nextSibling) {
var cell = row.firstChild;
if (this.weekNumbers) {
cell.className = "day wn";
- cell.firstChild.data = week_number;
+ cell.firstChild.data = date.getWeekNumber();
cell = cell.nextSibling;
}
- ++week_number;
row.className = "daysrow";
- for (var j = 0; j < 7; ++j) {
+ var hasdays = false;
+ for (var j = 0; j < 7; ++j, cell = cell.nextSibling, date.setDate(date.getDate() + 1)) {
+ var iday = date.getDate();
+ var wday = date.getDay();
cell.className = "day";
- if ((!i && j < wday) || iday > no_days) {
- // cell.className = "emptycell";
- cell.innerHTML = " ";
- cell.disabled = true;
- cell = cell.nextSibling;
- continue;
+ var current_month = (date.getMonth() == month);
+ if (!current_month) {
+ if (this.showsOtherMonths) {
+ cell.className += " othermonth";
+ cell.otherMonth = true;
+ } else {
+ cell.className = "emptycell";
+ cell.innerHTML = " ";
+ cell.disabled = true;
+ continue;
+ }
+ } else {
+ cell.otherMonth = false;
+ hasdays = true;
}
cell.disabled = false;
cell.firstChild.data = iday;
if (typeof this.getDateStatus == "function") {
- date.setDate(iday);
var status = this.getDateStatus(date, year, month, iday);
if (status === true) {
cell.className += " disabled";
}
if (!cell.disabled) {
ar_days[ar_days.length] = cell;
- cell.caldate = iday;
+ cell.caldate = new Date(date);
cell.ttip = "_";
- if (iday == mday) {
+ if (current_month && iday == mday) {
cell.className += " selected";
this.currentDateEl = cell;
}
- if (hasToday && (iday == todayDate)) {
+ if (date.getFullYear() == today.getFullYear() &&
+ date.getMonth() == today.getMonth() &&
+ iday == today.getDate()) {
cell.className += " today";
cell.ttip += Calendar._TT["PART_TODAY"];
}
- if (wday == SAT || wday == SUN) {
- cell.className += " weekend";
+ if (weekend.indexOf(wday.toString()) != -1) {
+ cell.className += cell.otherMonth ? " oweekend" : " weekend";
}
}
- ++iday;
- ((++wday) ^ 7) || (wday = 0);
- cell = cell.nextSibling;
}
- row = row.nextSibling;
+ if (!(hasdays || this.showsOtherMonths))
+ row.className = "emptyrow";
}
this.ar_days = ar_days;
this.title.firstChild.data = Calendar._MN[month] + ", " + year;
this.onSetTime();
+ this.table.style.visibility = "visible";
// PROFILE
// this.tooltips.firstChild.data = "Generated in " + ((new Date()) - today) + " ms";
};
*/
Calendar.prototype.setDate = function (date) {
if (!date.equalsTo(this.date)) {
- this._init(this.mondayFirst, date);
+ this._init(this.firstDayOfWeek, date);
}
};
* should * change.
*/
Calendar.prototype.refresh = function () {
- this._init(this.mondayFirst, this.date);
+ this._init(this.firstDayOfWeek, this.date);
};
-/** Modifies the "mondayFirst" parameter (EU/US style). */
-Calendar.prototype.setMondayFirst = function (mondayFirst) {
- this._init(mondayFirst, this.date);
+/** Modifies the "firstDayOfWeek" parameter (pass 0 for Synday, 1 for Monday, etc.). */
+Calendar.prototype.setFirstDayOfWeek = function (firstDayOfWeek) {
+ this._init(firstDayOfWeek, this.date);
this._displayWeekdays();
};
this.showAt(p.x, p.y + el.offsetHeight);
return true;
}
+ function fixPosition(box) {
+ if (box.x < 0)
+ box.x = 0;
+ if (box.y < 0)
+ box.y = 0;
+ var cp = document.createElement("div");
+ var s = cp.style;
+ s.position = "absolute";
+ s.right = s.bottom = s.width = s.height = "0px";
+ document.body.appendChild(cp);
+ var br = Calendar.getAbsolutePos(cp);
+ document.body.removeChild(cp);
+ if (Calendar.is_ie) {
+ br.y += document.body.scrollTop;
+ br.x += document.body.scrollLeft;
+ } else {
+ br.y += window.scrollY;
+ br.x += window.scrollX;
+ }
+ var tmp = box.x + box.width - br.x;
+ if (tmp > 0) box.x -= tmp;
+ tmp = box.y + box.height - br.y;
+ if (tmp > 0) box.y -= tmp;
+ };
this.element.style.display = "block";
Calendar.continuation_for_the_fucking_khtml_browser = function() {
var w = self.element.offsetWidth;
case "r": p.x += el.offsetWidth - w; break;
case "l": break; // already there
}
+ p.width = w;
+ p.height = h + 40;
+ self.monthsCombo.style.display = "none";
+ fixPosition(p);
self.showAt(p.x, p.y);
};
if (Calendar.is_khtml)
if (!fmt) {
fmt = this.dateFormat;
}
- var b = [];
- fmt.replace(/(%.)/g, function(str, par) {
- return b[b.length] = par;
- });
+ var b = fmt.match(/%./g);
var i = 0, j = 0;
var hr = 0;
var min = 0;
for (i = 0; i < a.length; ++i) {
- if (b[i] == "%a" || b[i] == "%A") {
+ if (!a[i])
continue;
- }
- if (b[i] == "%d" || b[i] == "%e") {
+ switch (b[i]) {
+ case "%d":
+ case "%e":
d = parseInt(a[i], 10);
- }
- if (b[i] == "%m") {
+ break;
+
+ case "%m":
m = parseInt(a[i], 10) - 1;
- }
- if (b[i] == "%Y" || b[i] == "%y") {
+ break;
+
+ case "%Y":
+ case "%y":
y = parseInt(a[i], 10);
(y < 100) && (y += (y > 29) ? 1900 : 2000);
- }
- if (b[i] == "%b" || b[i] == "%B") {
+ break;
+
+ case "%b":
+ case "%B":
for (j = 0; j < 12; ++j) {
if (Calendar._MN[j].substr(0, a[i].length).toLowerCase() == a[i].toLowerCase()) { m = j; break; }
}
- } else if (/%[HIkl]/.test(b[i])) {
+ break;
+
+ case "%H":
+ case "%I":
+ case "%k":
+ case "%l":
hr = parseInt(a[i], 10);
- } else if (/%[pP]/.test(b[i])) {
+ break;
+
+ case "%P":
+ case "%p":
if (/pm/i.test(a[i]) && hr < 12)
hr += 12;
- } else if (b[i] == "%M") {
+ break;
+
+ case "%M":
min = parseInt(a[i], 10);
+ break;
}
}
if (y != 0 && m != -1 && d != 0) {
/** Internal function; it displays the bar with the names of the weekday. */
Calendar.prototype._displayWeekdays = function () {
- var MON = this.mondayFirst ? 0 : 1;
- var SUN = this.mondayFirst ? 6 : 0;
- var SAT = this.mondayFirst ? 5 : 6;
+ var fdow = this.firstDayOfWeek;
var cell = this.firstdayname;
+ var weekend = Calendar._TT["WEEKEND"];
for (var i = 0; i < 7; ++i) {
cell.className = "day name";
- if (!i) {
- cell.ttip = this.mondayFirst ? Calendar._TT["SUN_FIRST"] : Calendar._TT["MON_FIRST"];
+ var realday = (i + fdow) % 7;
+ if (i) {
+ cell.ttip = Calendar._TT["DAY_FIRST"].replace("%s", Calendar._DN[realday]);
cell.navtype = 100;
cell.calendar = this;
+ cell.fdow = realday;
Calendar._add_evs(cell);
}
- if (i == SUN || i == SAT) {
+ if (weekend.indexOf(realday.toString()) != -1) {
Calendar.addClass(cell, "weekend");
}
- cell.firstChild.data = Calendar._SDN[i + 1 - MON];
+ cell.firstChild.data = Calendar._SDN[(i + fdow) % 7];
cell = cell.nextSibling;
}
};
this.yOffs = posY - parseInt(st.top);
with (Calendar) {
addEvent(document, "mousemove", calDragIt);
- addEvent(document, "mouseover", stopEvent);
addEvent(document, "mouseup", calDragEnd);
}
};
/** Returns the number of day in the year. */
Date.prototype.getDayOfYear = function() {
var now = new Date(this.getFullYear(), this.getMonth(), this.getDate(), 0, 0, 0);
- var then = new Date(this.getFullYear(), 0, 1, 0, 0, 0);
+ var then = new Date(this.getFullYear(), 0, 0, 0, 0, 0);
var time = now - then;
return Math.floor(time / Date.DAY);
};
/** Returns the number of the week in year, as defined in ISO 8601. */
Date.prototype.getWeekNumber = function() {
- var now = new Date(this.getFullYear(), this.getMonth(), this.getDate(), 0, 0, 0);
- var then = new Date(this.getFullYear(), 0, 1, 0, 0, 0);
- var time = now - then;
- var day = then.getDay(); // 0 means Sunday
- if (day == 0) day = 7;
- (day > 4) && (day -= 4) || (day += 3);
- return Math.round(((time / Date.DAY) + day) / 7);
+ var d = new Date(this.getFullYear(), this.getMonth(), this.getDate(), 0, 0, 0);
+ var DoW = d.getDay();
+ d.setDate(d.getDate() - (DoW + 6) % 7 + 3); // Nearest Thu
+ var ms = d.valueOf(); // GMT
+ d.setMonth(0);
+ d.setDate(4); // Thu in Week 1
+ return Math.round((ms - d.valueOf()) / (7 * 864e5)) + 1;
};
/** Checks dates equality (ignores time) */
s["%y"] = ('' + y).substr(2, 2); // year without the century (range 00 to 99)
s["%Y"] = y; // year with the century
s["%%"] = "%"; // a literal '%' character
- var re = Date._msh_formatRegexp;
- if (typeof re == "undefined") {
- var tmp = "";
- for (var i in s)
- tmp += tmp ? ("|" + i) : i;
- Date._msh_formatRegexp = re = new RegExp("(" + tmp + ")", 'g');
- }
- return str.replace(re, function(match, par) { return s[par]; });
+
+ var re = /%./g;
+ if (!Calendar.is_ie5)
+ return str.replace(re, function (par) { return s[par] || par; });
+
+ var a = str.match(re);
+ for (var i = 0; i < a.length; i++) {
+ var tmp = s[a[i]];
+ if (tmp) {
+ re = new RegExp(a[i], 'g');
+ str = str.replace(re, tmp);
+ }
+ }
+
+ return str;
+};
+
+Date.prototype.__msh_oldSetFullYear = Date.prototype.setFullYear;
+Date.prototype.setFullYear = function(y) {
+ var d = new Date(this);
+ d.__msh_oldSetFullYear(y);
+ if (d.getMonth() != this.getMonth())
+ this.setDate(28);
+ this.__msh_oldSetFullYear(y);
};
// END: DATE OBJECT PATCHES
+
// global object that remembers the calendar
window.calendar = null;
/* Copyright Mihai Bazon, 2002, 2003 | http://dynarch.com/mishoo/
* ------------------------------------------------------------------
*
- * The DHTML Calendar, version 0.9.5 "Your favorite time, bis"
+ * The DHTML Calendar, version 0.9.6 "Keep cool but don't freeze"
*
* Details and latest version at:
* http://dynarch.com/mishoo/calendar.epl
* This script is distributed under the GNU Lesser General Public License.
* Read the entire license text here: http://www.gnu.org/licenses/lgpl.html
*/
- Calendar=function(mondayFirst,dateStr,onSelected,onClose){this.activeDiv=null;this.currentDateEl=null;this.getDateStatus=null;this.timeout=null;this.onSelected=onSelected||null;this.onClose=onClose||null;this.dragging=false;this.hidden=false;this.minYear=1970;this.maxYear=2050;this.dateFormat=Calendar._TT["DEF_DATE_FORMAT"];this.ttDateFormat=Calendar._TT["TT_DATE_FORMAT"];this.isPopup=true;this.weekNumbers=true;this.mondayFirst=mondayFirst;this.dateStr=dateStr;this.ar_days=null;this.showsTime=false;this.time24=true;this.table=null;this.element=null;this.tbody=null;this.firstdayname=null;this.monthsCombo=null;this.yearsCombo=null;this.hilitedMonth=null;this.activeMonth=null;this.hilitedYear=null;this.activeYear=null;this.dateClicked=false;if(typeof Calendar._SDN=="undefined"){if(typeof Calendar._SDN_len=="undefined")Calendar._SDN_len=3;var ar=new Array();for(var i=8;i>0;){ar[--i]=Calendar._DN[i].substr(0,Calendar._SDN_len);}Calendar._SDN=ar;if(typeof Calendar._SMN_len=="undefined")Calendar._SMN_len=3;ar=new Array();for(var i=12;i>0;){ar[--i]=Calendar._MN[i].substr(0,Calendar._SMN_len);}Calendar._SMN=ar;}};Calendar._C=null;Calendar.is_ie=(/msie/i.test(navigator.userAgent)&&!/opera/i.test(navigator.userAgent));Calendar.is_opera=/opera/i.test(navigator.userAgent);Calendar.is_khtml=/Konqueror|Safari|KHTML/i.test(navigator.userAgent);Calendar.getAbsolutePos=function(el){var SL=0,ST=0;var is_div=/^div$/i.test(el.tagName);if(is_div&&el.scrollLeft)SL=el.scrollLeft;if(is_div&&el.scrollTop)ST=el.scrollTop;var r={x:el.offsetLeft-SL,y:el.offsetTop-ST};if(el.offsetParent){var tmp=Calendar.getAbsolutePos(el.offsetParent);r.x+=tmp.x;r.y+=tmp.y;}return r;};Calendar.isRelated=function(el,evt){var related=evt.relatedTarget;if(!related){var type=evt.type;if(type=="mouseover"){related=evt.fromElement;}else if(type=="mouseout"){related=evt.toElement;}}while(related){if(related==el){return true;}related=related.parentNode;}return false;};Calendar.removeClass=function(el,className){if(!(el&&el.className)){return;}var cls=el.className.split(" ");var ar=new Array();for(var i=cls.length;i>0;){if(cls[--i]!=className){ar[ar.length]=cls[i];}}el.className=ar.join(" ");};Calendar.addClass=function(el,className){Calendar.removeClass(el,className);el.className+=" "+className;};Calendar.getElement=function(ev){if(Calendar.is_ie){return window.event.srcElement;}else{return ev.currentTarget;}};Calendar.getTargetElement=function(ev){if(Calendar.is_ie){return window.event.srcElement;}else{return ev.target;}};Calendar.stopEvent=function(ev){ev||(ev=window.event);if(Calendar.is_ie){ev.cancelBubble=true;ev.returnValue=false;}else{ev.preventDefault();ev.stopPropagation();}return false;};Calendar.addEvent=function(el,evname,func){if(el.attachEvent){el.attachEvent("on"+evname,func);}else if(el.addEventListener){el.addEventListener(evname,func,true);}else{el["on"+evname]=func;}};Calendar.removeEvent=function(el,evname,func){if(el.detachEvent){el.detachEvent("on"+evname,func);}else if(el.removeEventListener){el.removeEventListener(evname,func,true);}else{el["on"+evname]=null;}};Calendar.createElement=function(type,parent){var el=null;if(document.createElementNS){el=document.createElementNS("http://www.w3.org/1999/xhtml",type);}else{el=document.createElement(type);}if(typeof parent!="undefined"){parent.appendChild(el);}return el;};Calendar._add_evs=function(el){with(Calendar){addEvent(el,"mouseover",dayMouseOver);addEvent(el,"mousedown",dayMouseDown);addEvent(el,"mouseout",dayMouseOut);if(is_ie){addEvent(el,"dblclick",dayMouseDblClick);el.setAttribute("unselectable",true);}}};Calendar.findMonth=function(el){if(typeof el.month!="undefined"){return el;}else if(typeof el.parentNode.month!="undefined"){return el.parentNode;}return null;};Calendar.findYear=function(el){if(typeof el.year!="undefined"){return el;}else if(typeof el.parentNode.year!="undefined"){return el.parentNode;}return null;};Calendar.showMonthsCombo=function(){var cal=Calendar._C;if(!cal){return false;}var cal=cal;var cd=cal.activeDiv;var mc=cal.monthsCombo;if(cal.hilitedMonth){Calendar.removeClass(cal.hilitedMonth,"hilite");}if(cal.activeMonth){Calendar.removeClass(cal.activeMonth,"active");}var mon=cal.monthsCombo.getElementsByTagName("div")[cal.date.getMonth()];Calendar.addClass(mon,"active");cal.activeMonth=mon;var s=mc.style;s.display="block";if(cd.navtype<0)s.left=cd.offsetLeft+"px";else s.left=(cd.offsetLeft+cd.offsetWidth-mc.offsetWidth)+"px";s.top=(cd.offsetTop+cd.offsetHeight)+"px";};Calendar.showYearsCombo=function(fwd){var cal=Calendar._C;if(!cal){return false;}var cal=cal;var cd=cal.activeDiv;var yc=cal.yearsCombo;if(cal.hilitedYear){Calendar.removeClass(cal.hilitedYear,"hilite");}if(cal.activeYear){Calendar.removeClass(cal.activeYear,"active");}cal.activeYear=null;var Y=cal.date.getFullYear()+(fwd?1:-1);var yr=yc.firstChild;var show=false;for(var i=12;i>0;--i){if(Y>=cal.minYear&&Y<=cal.maxYear){yr.firstChild.data=Y;yr.year=Y;yr.style.display="block";show=true;}else{yr.style.display="none";}yr=yr.nextSibling;Y+=fwd?2:-2;}if(show){var s=yc.style;s.display="block";if(cd.navtype<0)s.left=cd.offsetLeft+"px";else s.left=(cd.offsetLeft+cd.offsetWidth-yc.offsetWidth)+"px";s.top=(cd.offsetTop+cd.offsetHeight)+"px";}};Calendar.tableMouseUp=function(ev){var cal=Calendar._C;if(!cal){return false;}if(cal.timeout){clearTimeout(cal.timeout);}var el=cal.activeDiv;if(!el){return false;}var target=Calendar.getTargetElement(ev);ev||(ev=window.event);Calendar.removeClass(el,"active");if(target==el||target.parentNode==el){Calendar.cellClick(el,ev);}var mon=Calendar.findMonth(target);var date=null;if(mon){date=new Date(cal.date);if(mon.month!=date.getMonth()){date.setMonth(mon.month);cal.setDate(date);cal.dateClicked=false;cal.callHandler();}}else{var year=Calendar.findYear(target);if(year){date=new Date(cal.date);if(year.year!=date.getFullYear()){date.setFullYear(year.year);cal.setDate(date);cal.dateClicked=false;cal.callHandler();}}}with(Calendar){removeEvent(document,"mouseup",tableMouseUp);removeEvent(document,"mouseover",tableMouseOver);removeEvent(document,"mousemove",tableMouseOver);cal._hideCombos();_C=null;return stopEvent(ev);}};Calendar.tableMouseOver=function(ev){var cal=Calendar._C;if(!cal){return;}var el=cal.activeDiv;var target=Calendar.getTargetElement(ev);if(target==el||target.parentNode==el){Calendar.addClass(el,"hilite active");Calendar.addClass(el.parentNode,"rowhilite");}else{if(typeof el.navtype=="undefined"||(el.navtype!=50&&(el.navtype==0||Math.abs(el.navtype)>2)))Calendar.removeClass(el,"active");Calendar.removeClass(el,"hilite");Calendar.removeClass(el.parentNode,"rowhilite");}ev||(ev=window.event);if(el.navtype==50&&target!=el){var pos=Calendar.getAbsolutePos(el);var w=el.offsetWidth;var x=ev.clientX;var dx;var decrease=true;if(x>pos.x+w){dx=x-pos.x-w;decrease=false;}else dx=pos.x-x;if(dx<0)dx=0;var range=el._range;var current=el._current;var count=Math.floor(dx/10)%range.length;for(var i=range.length;--i>=0;)if(range[i]==current)break;while(count-->0)if(decrease){if(!(--i in range))i=range.length-1;}else if(!(++i in range))i=0;var newval=range[i];el.firstChild.data=newval;cal.onUpdateTime();}var mon=Calendar.findMonth(target);if(mon){if(mon.month!=cal.date.getMonth()){if(cal.hilitedMonth){Calendar.removeClass(cal.hilitedMonth,"hilite");}Calendar.addClass(mon,"hilite");cal.hilitedMonth=mon;}else if(cal.hilitedMonth){Calendar.removeClass(cal.hilitedMonth,"hilite");}}else{if(cal.hilitedMonth){Calendar.removeClass(cal.hilitedMonth,"hilite");}var year=Calendar.findYear(target);if(year){if(year.year!=cal.date.getFullYear()){if(cal.hilitedYear){Calendar.removeClass(cal.hilitedYear,"hilite");}Calendar.addClass(year,"hilite");cal.hilitedYear=year;}else if(cal.hilitedYear){Calendar.removeClass(cal.hilitedYear,"hilite");}}else if(cal.hilitedYear){Calendar.removeClass(cal.hilitedYear,"hilite");}}return Calendar.stopEvent(ev);};Calendar.tableMouseDown=function(ev){if(Calendar.getTargetElement(ev)==Calendar.getElement(ev)){return Calendar.stopEvent(ev);}};Calendar.calDragIt=function(ev){var cal=Calendar._C;if(!(cal&&cal.dragging)){return false;}var posX;var posY;if(Calendar.is_ie){posY=window.event.clientY+document.body.scrollTop;posX=window.event.clientX+document.body.scrollLeft;}else{posX=ev.pageX;posY=ev.pageY;}cal.hideShowCovered();var st=cal.element.style;st.left=(posX-cal.xOffs)+"px";st.top=(posY-cal.yOffs)+"px";return Calendar.stopEvent(ev);};Calendar.calDragEnd=function(ev){var cal=Calendar._C;if(!cal){return false;}cal.dragging=false;with(Calendar){removeEvent(document,"mousemove",calDragIt);removeEvent(document,"mouseover",stopEvent);removeEvent(document,"mouseup",calDragEnd);tableMouseUp(ev);}cal.hideShowCovered();};Calendar.dayMouseDown=function(ev){var el=Calendar.getElement(ev);if(el.disabled){return false;}var cal=el.calendar;cal.activeDiv=el;Calendar._C=cal;if(el.navtype!=300)with(Calendar){if(el.navtype==50)el._current=el.firstChild.data;addClass(el,"hilite active");addEvent(document,"mouseover",tableMouseOver);addEvent(document,"mousemove",tableMouseOver);addEvent(document,"mouseup",tableMouseUp);}else if(cal.isPopup){cal._dragStart(ev);}if(el.navtype==-1||el.navtype==1){if(cal.timeout)clearTimeout(cal.timeout);cal.timeout=setTimeout("Calendar.showMonthsCombo()",250);}else if(el.navtype==-2||el.navtype==2){if(cal.timeout)clearTimeout(cal.timeout);cal.timeout=setTimeout((el.navtype>0)?"Calendar.showYearsCombo(true)":"Calendar.showYearsCombo(false)",250);}else{cal.timeout=null;}return Calendar.stopEvent(ev);};Calendar.dayMouseDblClick=function(ev){Calendar.cellClick(Calendar.getElement(ev),ev||window.event);if(Calendar.is_ie){document.selection.empty();}};Calendar.dayMouseOver=function(ev){var el=Calendar.getElement(ev);if(Calendar.isRelated(el,ev)||Calendar._C||el.disabled){return false;}if(el.ttip){if(el.ttip.substr(0,1)=="_"){var date=null;with(el.calendar.date){date=new Date(getFullYear(),getMonth(),el.caldate);}el.ttip=date.print(el.calendar.ttDateFormat)+el.ttip.substr(1);}el.calendar.tooltips.firstChild.data=el.ttip;}if(el.navtype!=300){Calendar.addClass(el,"hilite");if(el.caldate){Calendar.addClass(el.parentNode,"rowhilite");}}return Calendar.stopEvent(ev);};Calendar.dayMouseOut=function(ev){with(Calendar){var el=getElement(ev);if(isRelated(el,ev)||_C||el.disabled){return false;}removeClass(el,"hilite");if(el.caldate){removeClass(el.parentNode,"rowhilite");}el.calendar.tooltips.firstChild.data=_TT["SEL_DATE"];return stopEvent(ev);}};Calendar.cellClick=function(el,ev){var cal=el.calendar;var closing=false;var newdate=false;var date=null;if(typeof el.navtype=="undefined"){Calendar.removeClass(cal.currentDateEl,"selected");Calendar.addClass(el,"selected");closing=(cal.currentDateEl==el);if(!closing){cal.currentDateEl=el;}cal.date.setDate(el.caldate);date=cal.date;newdate=true;cal.dateClicked=true;}else{if(el.navtype==200){Calendar.removeClass(el,"hilite");cal.callCloseHandler();return;}date=(el.navtype==0)?new Date():new Date(cal.date);cal.dateClicked=false;var year=date.getFullYear();var mon=date.getMonth();function setMonth(m){var day=date.getDate();var max=date.getMonthDays(m);if(day>max){date.setDate(max);}date.setMonth(m);};switch(el.navtype){case 400:Calendar.removeClass(el,"hilite");var text=Calendar._TT["ABOUT"];if(typeof text!="undefined"){text+=cal.showsTime?Calendar._TT["ABOUT_TIME"]:"";}else{text="Help and about box text is not translated into this language.\n"+"If you know this language and you feel generous please update\n"+"the corresponding file in \"lang\" subdir to match calendar-en.js\n"+"and send it back to <mishoo@infoiasi.ro> to get it into the distribution ;-)\n\n"+"Thank you!\n"+"http://dynarch.com/mishoo/calendar.epl\n";}alert(text);return;case-2:if(year>cal.minYear){date.setFullYear(year-1);}break;case-1:if(mon>0){setMonth(mon-1);}else if(year-->cal.minYear){date.setFullYear(year);setMonth(11);}break;case 1:if(mon<11){setMonth(mon+1);}else if(year<cal.maxYear){date.setFullYear(year+1);setMonth(0);}break;case 2:if(year<cal.maxYear){date.setFullYear(year+1);}break;case 100:cal.setMondayFirst(!cal.mondayFirst);return;case 50:var range=el._range;var current=el.firstChild.data;for(var i=range.length;--i>=0;)if(range[i]==current)break;if(ev&&ev.shiftKey){if(!(--i in range))i=range.length-1;}else if(!(++i in range))i=0;var newval=range[i];el.firstChild.data=newval;cal.onUpdateTime();return;case 0:if((typeof cal.getDateStatus=="function")&&cal.getDateStatus(date,date.getFullYear(),date.getMonth(),date.getDate())){return false;}break;}if(!date.equalsTo(cal.date)){cal.setDate(date);newdate=true;}}if(newdate){cal.callHandler();}if(closing){Calendar.removeClass(el,"hilite");cal.callCloseHandler();}};Calendar.prototype.create=function(_par){var parent=null;if(!_par){parent=document.getElementsByTagName("body")[0];this.isPopup=true;}else{parent=_par;this.isPopup=false;}this.date=this.dateStr?new Date(this.dateStr):new Date();var table=Calendar.createElement("table");this.table=table;table.cellSpacing=0;table.cellPadding=0;table.calendar=this;Calendar.addEvent(table,"mousedown",Calendar.tableMouseDown);var div=Calendar.createElement("div");this.element=div;div.className="calendar";if(this.isPopup){div.style.position="absolute";div.style.display="none";}div.appendChild(table);var thead=Calendar.createElement("thead",table);var cell=null;var row=null;var cal=this;var hh=function(text,cs,navtype){cell=Calendar.createElement("td",row);cell.colSpan=cs;cell.className="button";if(navtype!=0&&Math.abs(navtype)<=2)cell.className+=" nav";Calendar._add_evs(cell);cell.calendar=cal;cell.navtype=navtype;if(text.substr(0,1)!="&"){cell.appendChild(document.createTextNode(text));}else{cell.innerHTML=text;}return cell;};row=Calendar.createElement("tr",thead);var title_length=6;(this.isPopup)&&--title_length;(this.weekNumbers)&&++title_length;hh("?",1,400).ttip=Calendar._TT["INFO"];this.title=hh("",title_length,300);this.title.className="title";if(this.isPopup){this.title.ttip=Calendar._TT["DRAG_TO_MOVE"];this.title.style.cursor="move";hh("×",1,200).ttip=Calendar._TT["CLOSE"];}row=Calendar.createElement("tr",thead);row.className="headrow";this._nav_py=hh("«",1,-2);this._nav_py.ttip=Calendar._TT["PREV_YEAR"];this._nav_pm=hh("‹",1,-1);this._nav_pm.ttip=Calendar._TT["PREV_MONTH"];this._nav_now=hh(Calendar._TT["TODAY"],this.weekNumbers?4:3,0);this._nav_now.ttip=Calendar._TT["GO_TODAY"];this._nav_nm=hh("›",1,1);this._nav_nm.ttip=Calendar._TT["NEXT_MONTH"];this._nav_ny=hh("»",1,2);this._nav_ny.ttip=Calendar._TT["NEXT_YEAR"];row=Calendar.createElement("tr",thead);row.className="daynames";if(this.weekNumbers){cell=Calendar.createElement("td",row);cell.className="name wn";cell.appendChild(document.createTextNode(Calendar._TT["WK"]));}for(var i=7;i>0;--i){cell=Calendar.createElement("td",row);cell.appendChild(document.createTextNode(""));if(!i){cell.navtype=100;cell.calendar=this;Calendar._add_evs(cell);}}this.firstdayname=(this.weekNumbers)?row.firstChild.nextSibling:row.firstChild;this._displayWeekdays();var tbody=Calendar.createElement("tbody",table);this.tbody=tbody;for(i=6;i>0;--i){row=Calendar.createElement("tr",tbody);if(this.weekNumbers){cell=Calendar.createElement("td",row);cell.appendChild(document.createTextNode(""));}for(var j=7;j>0;--j){cell=Calendar.createElement("td",row);cell.appendChild(document.createTextNode(""));cell.calendar=this;Calendar._add_evs(cell);}}if(this.showsTime){row=Calendar.createElement("tr",tbody);row.className="time";cell=Calendar.createElement("td",row);cell.className="time";cell.colSpan=2;cell.innerHTML=" ";cell=Calendar.createElement("td",row);cell.className="time";cell.colSpan=this.weekNumbers?4:3;(function(){function makeTimePart(className,init,range_start,range_end){var part=Calendar.createElement("span",cell);part.className=className;part.appendChild(document.createTextNode(init));part.calendar=cal;part.ttip=Calendar._TT["TIME_PART"];part.navtype=50;part._range=[];if(typeof range_start!="number")part._range=range_start;else{for(var i=range_start;i<=range_end;++i){var txt;if(i<10&&range_end>=10)txt='0'+i;else txt=''+i;part._range[part._range.length]=txt;}}Calendar._add_evs(part);return part;};var hrs=cal.date.getHours();var mins=cal.date.getMinutes();var t12=!cal.time24;var pm=(hrs>12);if(t12&&pm)hrs-=12;var H=makeTimePart("hour",hrs,t12?1:0,t12?12:23);var span=Calendar.createElement("span",cell);span.appendChild(document.createTextNode(":"));span.className="colon";var M=makeTimePart("minute",mins,0,59);var AP=null;cell=Calendar.createElement("td",row);cell.className="time";cell.colSpan=2;if(t12)AP=makeTimePart("ampm",pm?"pm":"am",["am","pm"]);else cell.innerHTML=" ";cal.onSetTime=function(){var hrs=this.date.getHours();var mins=this.date.getMinutes();var pm=(hrs>12);if(pm&&t12)hrs-=12;H.firstChild.data=(hrs<10)?("0"+hrs):hrs;M.firstChild.data=(mins<10)?("0"+mins):mins;if(t12)AP.firstChild.data=pm?"pm":"am";};cal.onUpdateTime=function(){var date=this.date;var h=parseInt(H.firstChild.data,10);if(t12){if(/pm/i.test(AP.firstChild.data)&&h<12)h+=12;else if(/am/i.test(AP.firstChild.data)&&h==12)h=0;}var d=date.getDate();var m=date.getMonth();var y=date.getFullYear();date.setHours(h);date.setMinutes(parseInt(M.firstChild.data,10));date.setFullYear(y);date.setMonth(m);date.setDate(d);this.dateClicked=false;this.callHandler();};})();}else{this.onSetTime=this.onUpdateTime=function(){};}var tfoot=Calendar.createElement("tfoot",table);row=Calendar.createElement("tr",tfoot);row.className="footrow";cell=hh(Calendar._TT["SEL_DATE"],this.weekNumbers?8:7,300);cell.className="ttip";if(this.isPopup){cell.ttip=Calendar._TT["DRAG_TO_MOVE"];cell.style.cursor="move";}this.tooltips=cell;div=Calendar.createElement("div",this.element);this.monthsCombo=div;div.className="combo";for(i=0;i<Calendar._MN.length;++i){var mn=Calendar.createElement("div");mn.className=Calendar.is_ie?"label-IEfix":"label";mn.month=i;mn.appendChild(document.createTextNode(Calendar._SMN[i]));div.appendChild(mn);}div=Calendar.createElement("div",this.element);this.yearsCombo=div;div.className="combo";for(i=12;i>0;--i){var yr=Calendar.createElement("div");yr.className=Calendar.is_ie?"label-IEfix":"label";yr.appendChild(document.createTextNode(""));div.appendChild(yr);}this._init(this.mondayFirst,this.date);parent.appendChild(this.element);};Calendar._keyEvent=function(ev){if(!window.calendar){return false;}(Calendar.is_ie)&&(ev=window.event);var cal=window.calendar;var act=(Calendar.is_ie||ev.type=="keypress");if(ev.ctrlKey){switch(ev.keyCode){case 37:act&&Calendar.cellClick(cal._nav_pm);break;case 38:act&&Calendar.cellClick(cal._nav_py);break;case 39:act&&Calendar.cellClick(cal._nav_nm);break;case 40:act&&Calendar.cellClick(cal._nav_ny);break;default:return false;}}else switch(ev.keyCode){case 32:Calendar.cellClick(cal._nav_now);break;case 27:act&&cal.hide();break;case 37:case 38:case 39:case 40:if(act){var date=cal.date.getDate()-1;var el=cal.currentDateEl;var ne=null;var prev=(ev.keyCode==37)||(ev.keyCode==38);switch(ev.keyCode){case 37:(--date>=0)&&(ne=cal.ar_days[date]);break;case 38:date-=7;(date>=0)&&(ne=cal.ar_days[date]);break;case 39:(++date<cal.ar_days.length)&&(ne=cal.ar_days[date]);break;case 40:date+=7;(date<cal.ar_days.length)&&(ne=cal.ar_days[date]);break;}if(!ne){if(prev){Calendar.cellClick(cal._nav_pm);}else{Calendar.cellClick(cal._nav_nm);}date=(prev)?cal.date.getMonthDays():1;el=cal.currentDateEl;ne=cal.ar_days[date-1];}Calendar.removeClass(el,"selected");Calendar.addClass(ne,"selected");cal.date.setDate(ne.caldate);cal.callHandler();cal.currentDateEl=ne;}break;case 13:if(act){cal.callHandler();cal.hide();}break;default:return false;}return Calendar.stopEvent(ev);};Calendar.prototype._init=function(mondayFirst,date){var today=new Date();var year=date.getFullYear();if(year<this.minYear){year=this.minYear;date.setFullYear(year);}else if(year>this.maxYear){year=this.maxYear;date.setFullYear(year);}this.mondayFirst=mondayFirst;this.date=new Date(date);var month=date.getMonth();var mday=date.getDate();var no_days=date.getMonthDays();date.setDate(1);var wday=date.getDay();var MON=mondayFirst?1:0;var SAT=mondayFirst?5:6;var SUN=mondayFirst?6:0;if(mondayFirst){wday=(wday>0)?(wday-1):6;}var iday=1;var row=this.tbody.firstChild;var MN=Calendar._SMN[month];var hasToday=((today.getFullYear()==year)&&(today.getMonth()==month));var todayDate=today.getDate();var week_number=date.getWeekNumber();var ar_days=new Array();for(var i=0;i<6;++i){if(iday>no_days){row.className="emptyrow";row=row.nextSibling;continue;}var cell=row.firstChild;if(this.weekNumbers){cell.className="day wn";cell.firstChild.data=week_number;cell=cell.nextSibling;}++week_number;row.className="daysrow";for(var j=0;j<7;++j){cell.className="day";if((!i&&j<wday)||iday>no_days){cell.innerHTML=" ";cell.disabled=true;cell=cell.nextSibling;continue;}cell.disabled=false;cell.firstChild.data=iday;if(typeof this.getDateStatus=="function"){date.setDate(iday);var status=this.getDateStatus(date,year,month,iday);if(status===true){cell.className+=" disabled";cell.disabled=true;}else{if(/disabled/i.test(status))cell.disabled=true;cell.className+=" "+status;}}if(!cell.disabled){ar_days[ar_days.length]=cell;cell.caldate=iday;cell.ttip="_";if(iday==mday){cell.className+=" selected";this.currentDateEl=cell;}if(hasToday&&(iday==todayDate)){cell.className+=" today";cell.ttip+=Calendar._TT["PART_TODAY"];}if(wday==SAT||wday==SUN){cell.className+=" weekend";}}++iday;((++wday)^ 7)||(wday=0);cell=cell.nextSibling;}row=row.nextSibling;}this.ar_days=ar_days;this.title.firstChild.data=Calendar._MN[month]+", "+year;this.onSetTime();};Calendar.prototype.setDate=function(date){if(!date.equalsTo(this.date)){this._init(this.mondayFirst,date);}};Calendar.prototype.refresh=function(){this._init(this.mondayFirst,this.date);};Calendar.prototype.setMondayFirst=function(mondayFirst){this._init(mondayFirst,this.date);this._displayWeekdays();};Calendar.prototype.setDateStatusHandler=Calendar.prototype.setDisabledHandler=function(unaryFunction){this.getDateStatus=unaryFunction;};Calendar.prototype.setRange=function(a,z){this.minYear=a;this.maxYear=z;};Calendar.prototype.callHandler=function(){if(this.onSelected){this.onSelected(this,this.date.print(this.dateFormat));}};Calendar.prototype.callCloseHandler=function(){if(this.onClose){this.onClose(this);}this.hideShowCovered();};Calendar.prototype.destroy=function(){var el=this.element.parentNode;el.removeChild(this.element);Calendar._C=null;window.calendar=null;};Calendar.prototype.reparent=function(new_parent){var el=this.element;el.parentNode.removeChild(el);new_parent.appendChild(el);};Calendar._checkCalendar=function(ev){if(!window.calendar){return false;}var el=Calendar.is_ie?Calendar.getElement(ev):Calendar.getTargetElement(ev);for(;el!=null&&el!=calendar.element;el=el.parentNode);if(el==null){window.calendar.callCloseHandler();return Calendar.stopEvent(ev);}};Calendar.prototype.show=function(){var rows=this.table.getElementsByTagName("tr");for(var i=rows.length;i>0;){var row=rows[--i];Calendar.removeClass(row,"rowhilite");var cells=row.getElementsByTagName("td");for(var j=cells.length;j>0;){var cell=cells[--j];Calendar.removeClass(cell,"hilite");Calendar.removeClass(cell,"active");}}this.element.style.display="block";this.hidden=false;if(this.isPopup){window.calendar=this;Calendar.addEvent(document,"keydown",Calendar._keyEvent);Calendar.addEvent(document,"keypress",Calendar._keyEvent);Calendar.addEvent(document,"mousedown",Calendar._checkCalendar);}this.hideShowCovered();};Calendar.prototype.hide=function(){if(this.isPopup){Calendar.removeEvent(document,"keydown",Calendar._keyEvent);Calendar.removeEvent(document,"keypress",Calendar._keyEvent);Calendar.removeEvent(document,"mousedown",Calendar._checkCalendar);}this.element.style.display="none";this.hidden=true;this.hideShowCovered();};Calendar.prototype.showAt=function(x,y){var s=this.element.style;s.left=x+"px";s.top=y+"px";this.show();};Calendar.prototype.showAtElement=function(el,opts){var self=this;var p=Calendar.getAbsolutePos(el);if(!opts||typeof opts!="string"){this.showAt(p.x,p.y+el.offsetHeight);return true;}this.element.style.display="block";Calendar.continuation_for_the_fucking_khtml_browser=function(){var w=self.element.offsetWidth;var h=self.element.offsetHeight;self.element.style.display="none";var valign=opts.substr(0,1);var halign="l";if(opts.length>1){halign=opts.substr(1,1);}switch(valign){case "T":p.y-=h;break;case "B":p.y+=el.offsetHeight;break;case "C":p.y+=(el.offsetHeight-h)/2;break;case "t":p.y+=el.offsetHeight-h;break;case "b":break;}switch(halign){case "L":p.x-=w;break;case "R":p.x+=el.offsetWidth;break;case "C":p.x+=(el.offsetWidth-w)/2;break;case "r":p.x+=el.offsetWidth-w;break;case "l":break;}self.showAt(p.x,p.y);};if(Calendar.is_khtml)setTimeout("Calendar.continuation_for_the_fucking_khtml_browser()",10);else Calendar.continuation_for_the_fucking_khtml_browser();};Calendar.prototype.setDateFormat=function(str){this.dateFormat=str;};Calendar.prototype.setTtDateFormat=function(str){this.ttDateFormat=str;};Calendar.prototype.parseDate=function(str,fmt){var y=0;var m=-1;var d=0;var a=str.split(/\W+/);if(!fmt){fmt=this.dateFormat;}var b=[];fmt.replace(/(%.)/g,function(str,par){return b[b.length]=par;});var i=0,j=0;var hr=0;var min=0;for(i=0;i<a.length;++i){if(b[i]=="%a"||b[i]=="%A"){continue;}if(b[i]=="%d"||b[i]=="%e"){d=parseInt(a[i],10);}if(b[i]=="%m"){m=parseInt(a[i],10)-1;}if(b[i]=="%Y"||b[i]=="%y"){y=parseInt(a[i],10);(y<100)&&(y+=(y>29)?1900:2000);}if(b[i]=="%b"||b[i]=="%B"){for(j=0;j<12;++j){if(Calendar._MN[j].substr(0,a[i].length).toLowerCase()==a[i].toLowerCase()){m=j;break;}}}else if(/%[HIkl]/.test(b[i])){hr=parseInt(a[i],10);}else if(/%[pP]/.test(b[i])){if(/pm/i.test(a[i])&&hr<12)hr+=12;}else if(b[i]=="%M"){min=parseInt(a[i],10);}}if(y!=0&&m!=-1&&d!=0){this.setDate(new Date(y,m,d,hr,min,0));return;}y=0;m=-1;d=0;for(i=0;i<a.length;++i){if(a[i].search(/[a-zA-Z]+/)!=-1){var t=-1;for(j=0;j<12;++j){if(Calendar._MN[j].substr(0,a[i].length).toLowerCase()==a[i].toLowerCase()){t=j;break;}}if(t!=-1){if(m!=-1){d=m+1;}m=t;}}else if(parseInt(a[i],10)<=12&&m==-1){m=a[i]-1;}else if(parseInt(a[i],10)>31&&y==0){y=parseInt(a[i],10);(y<100)&&(y+=(y>29)?1900:2000);}else if(d==0){d=a[i];}}if(y==0){var today=new Date();y=today.getFullYear();}if(m!=-1&&d!=0){this.setDate(new Date(y,m,d,hr,min,0));}};Calendar.prototype.hideShowCovered=function(){var self=this;Calendar.continuation_for_the_fucking_khtml_browser=function(){function getVisib(obj){var value=obj.style.visibility;if(!value){if(document.defaultView&&typeof(document.defaultView.getComputedStyle)=="function"){if(!Calendar.is_khtml)value=document.defaultView. getComputedStyle(obj,"").getPropertyValue("visibility");else value='';}else if(obj.currentStyle){value=obj.currentStyle.visibility;}else value='';}return value;};var tags=new Array("applet","iframe","select");var el=self.element;var p=Calendar.getAbsolutePos(el);var EX1=p.x;var EX2=el.offsetWidth+EX1;var EY1=p.y;var EY2=el.offsetHeight+EY1;for(var k=tags.length;k>0;){var ar=document.getElementsByTagName(tags[--k]);var cc=null;for(var i=ar.length;i>0;){cc=ar[--i];p=Calendar.getAbsolutePos(cc);var CX1=p.x;var CX2=cc.offsetWidth+CX1;var CY1=p.y;var CY2=cc.offsetHeight+CY1;if(self.hidden||(CX1>EX2)||(CX2<EX1)||(CY1>EY2)||(CY2<EY1)){if(!cc.__msh_save_visibility){cc.__msh_save_visibility=getVisib(cc);}cc.style.visibility=cc.__msh_save_visibility;}else{if(!cc.__msh_save_visibility){cc.__msh_save_visibility=getVisib(cc);}cc.style.visibility="hidden";}}}};if(Calendar.is_khtml)setTimeout("Calendar.continuation_for_the_fucking_khtml_browser()",10);else Calendar.continuation_for_the_fucking_khtml_browser();};Calendar.prototype._displayWeekdays=function(){var MON=this.mondayFirst?0:1;var SUN=this.mondayFirst?6:0;var SAT=this.mondayFirst?5:6;var cell=this.firstdayname;for(var i=0;i<7;++i){cell.className="day name";if(!i){cell.ttip=this.mondayFirst?Calendar._TT["SUN_FIRST"]:Calendar._TT["MON_FIRST"];cell.navtype=100;cell.calendar=this;Calendar._add_evs(cell);}if(i==SUN||i==SAT){Calendar.addClass(cell,"weekend");}cell.firstChild.data=Calendar._SDN[i+1-MON];cell=cell.nextSibling;}};Calendar.prototype._hideCombos=function(){this.monthsCombo.style.display="none";this.yearsCombo.style.display="none";};Calendar.prototype._dragStart=function(ev){if(this.dragging){return;}this.dragging=true;var posX;var posY;if(Calendar.is_ie){posY=window.event.clientY+document.body.scrollTop;posX=window.event.clientX+document.body.scrollLeft;}else{posY=ev.clientY+window.scrollY;posX=ev.clientX+window.scrollX;}var st=this.element.style;this.xOffs=posX-parseInt(st.left);this.yOffs=posY-parseInt(st.top);with(Calendar){addEvent(document,"mousemove",calDragIt);addEvent(document,"mouseover",stopEvent);addEvent(document,"mouseup",calDragEnd);}};Date._MD=new Array(31,28,31,30,31,30,31,31,30,31,30,31);Date.SECOND=1000;Date.MINUTE=60*Date.SECOND;Date.HOUR=60*Date.MINUTE;Date.DAY=24*Date.HOUR;Date.WEEK=7*Date.DAY;Date.prototype.getMonthDays=function(month){var year=this.getFullYear();if(typeof month=="undefined"){month=this.getMonth();}if(((0==(year%4))&&((0!=(year%100))||(0==(year%400))))&&month==1){return 29;}else{return Date._MD[month];}};Date.prototype.getDayOfYear=function(){var now=new Date(this.getFullYear(),this.getMonth(),this.getDate(),0,0,0);var then=new Date(this.getFullYear(),0,1,0,0,0);var time=now-then;return Math.floor(time/Date.DAY);};Date.prototype.getWeekNumber=function(){var now=new Date(this.getFullYear(),this.getMonth(),this.getDate(),0,0,0);var then=new Date(this.getFullYear(),0,1,0,0,0);var time=now-then;var day=then.getDay();if(day==0)day=7;(day>4)&&(day-=4)||(day+=3);return Math.round(((time/Date.DAY)+day)/7);};Date.prototype.equalsTo=function(date){return((this.getFullYear()==date.getFullYear())&&(this.getMonth()==date.getMonth())&&(this.getDate()==date.getDate())&&(this.getHours()==date.getHours())&&(this.getMinutes()==date.getMinutes()));};Date.prototype.print=function(str){var m=this.getMonth();var d=this.getDate();var y=this.getFullYear();var wn=this.getWeekNumber();var w=this.getDay();var s={};var hr=this.getHours();var pm=(hr>=12);var ir=(pm)?(hr-12):hr;var dy=this.getDayOfYear();if(ir==0)ir=12;var min=this.getMinutes();var sec=this.getSeconds();s["%a"]=Calendar._SDN[w];s["%A"]=Calendar._DN[w];s["%b"]=Calendar._SMN[m];s["%B"]=Calendar._MN[m];s["%C"]=1+Math.floor(y/100);s["%d"]=(d<10)?("0"+d):d;s["%e"]=d;s["%H"]=(hr<10)?("0"+hr):hr;s["%I"]=(ir<10)?("0"+ir):ir;s["%j"]=(dy<100)?((dy<10)?("00"+dy):("0"+dy)):dy;s["%k"]=hr;s["%l"]=ir;s["%m"]=(m<9)?("0"+(1+m)):(1+m);s["%M"]=(min<10)?("0"+min):min;s["%n"]="\n";s["%p"]=pm?"PM":"AM";s["%P"]=pm?"pm":"am";s["%s"]=Math.floor(this.getTime()/1000);s["%S"]=(sec<10)?("0"+sec):sec;s["%t"]="\t";s["%U"]=s["%W"]=s["%V"]=(wn<10)?("0"+wn):wn;s["%u"]=w+1;s["%w"]=w;s["%y"]=(''+y).substr(2,2);s["%Y"]=y;s["%%"]="%";var re=Date._msh_formatRegexp;if(typeof re=="undefined"){var tmp="";for(var i in s)tmp+=tmp?("|"+i):i;Date._msh_formatRegexp=re=new RegExp("("+tmp+")",'g');}return str.replace(re,function(match,par){return s[par];});};window.calendar=null;
\ No newline at end of file
+ Calendar=function(firstDayOfWeek,dateStr,onSelected,onClose){this.activeDiv=null;this.currentDateEl=null;this.getDateStatus=null;this.timeout=null;this.onSelected=onSelected||null;this.onClose=onClose||null;this.dragging=false;this.hidden=false;this.minYear=1970;this.maxYear=2050;this.dateFormat=Calendar._TT["DEF_DATE_FORMAT"];this.ttDateFormat=Calendar._TT["TT_DATE_FORMAT"];this.isPopup=true;this.weekNumbers=true;this.firstDayOfWeek=firstDayOfWeek;this.showsOtherMonths=false;this.dateStr=dateStr;this.ar_days=null;this.showsTime=false;this.time24=true;this.yearStep=2;this.table=null;this.element=null;this.tbody=null;this.firstdayname=null;this.monthsCombo=null;this.yearsCombo=null;this.hilitedMonth=null;this.activeMonth=null;this.hilitedYear=null;this.activeYear=null;this.dateClicked=false;if(typeof Calendar._SDN=="undefined"){if(typeof Calendar._SDN_len=="undefined")Calendar._SDN_len=3;var ar=new Array();for(var i=8;i>0;){ar[--i]=Calendar._DN[i].substr(0,Calendar._SDN_len);}Calendar._SDN=ar;if(typeof Calendar._SMN_len=="undefined")Calendar._SMN_len=3;ar=new Array();for(var i=12;i>0;){ar[--i]=Calendar._MN[i].substr(0,Calendar._SMN_len);}Calendar._SMN=ar;}};Calendar._C=null;Calendar.is_ie=(/msie/i.test(navigator.userAgent)&&!/opera/i.test(navigator.userAgent));Calendar.is_ie5=(Calendar.is_ie&&/msie 5\.0/i.test(navigator.userAgent));Calendar.is_opera=/opera/i.test(navigator.userAgent);Calendar.is_khtml=/Konqueror|Safari|KHTML/i.test(navigator.userAgent);Calendar.getAbsolutePos=function(el){var SL=0,ST=0;var is_div=/^div$/i.test(el.tagName);if(is_div&&el.scrollLeft)SL=el.scrollLeft;if(is_div&&el.scrollTop)ST=el.scrollTop;var r={x:el.offsetLeft-SL,y:el.offsetTop-ST};if(el.offsetParent){var tmp=this.getAbsolutePos(el.offsetParent);r.x+=tmp.x;r.y+=tmp.y;}return r;};Calendar.isRelated=function(el,evt){var related=evt.relatedTarget;if(!related){var type=evt.type;if(type=="mouseover"){related=evt.fromElement;}else if(type=="mouseout"){related=evt.toElement;}}while(related){if(related==el){return true;}related=related.parentNode;}return false;};Calendar.removeClass=function(el,className){if(!(el&&el.className)){return;}var cls=el.className.split(" ");var ar=new Array();for(var i=cls.length;i>0;){if(cls[--i]!=className){ar[ar.length]=cls[i];}}el.className=ar.join(" ");};Calendar.addClass=function(el,className){Calendar.removeClass(el,className);el.className+=" "+className;};Calendar.getElement=function(ev){if(Calendar.is_ie){return window.event.srcElement;}else{return ev.currentTarget;}};Calendar.getTargetElement=function(ev){if(Calendar.is_ie){return window.event.srcElement;}else{return ev.target;}};Calendar.stopEvent=function(ev){ev||(ev=window.event);if(Calendar.is_ie){ev.cancelBubble=true;ev.returnValue=false;}else{ev.preventDefault();ev.stopPropagation();}return false;};Calendar.addEvent=function(el,evname,func){if(el.attachEvent){el.attachEvent("on"+evname,func);}else if(el.addEventListener){el.addEventListener(evname,func,true);}else{el["on"+evname]=func;}};Calendar.removeEvent=function(el,evname,func){if(el.detachEvent){el.detachEvent("on"+evname,func);}else if(el.removeEventListener){el.removeEventListener(evname,func,true);}else{el["on"+evname]=null;}};Calendar.createElement=function(type,parent){var el=null;if(document.createElementNS){el=document.createElementNS("http://www.w3.org/1999/xhtml",type);}else{el=document.createElement(type);}if(typeof parent!="undefined"){parent.appendChild(el);}return el;};Calendar._add_evs=function(el){with(Calendar){addEvent(el,"mouseover",dayMouseOver);addEvent(el,"mousedown",dayMouseDown);addEvent(el,"mouseout",dayMouseOut);if(is_ie){addEvent(el,"dblclick",dayMouseDblClick);el.setAttribute("unselectable",true);}}};Calendar.findMonth=function(el){if(typeof el.month!="undefined"){return el;}else if(typeof el.parentNode.month!="undefined"){return el.parentNode;}return null;};Calendar.findYear=function(el){if(typeof el.year!="undefined"){return el;}else if(typeof el.parentNode.year!="undefined"){return el.parentNode;}return null;};Calendar.showMonthsCombo=function(){var cal=Calendar._C;if(!cal){return false;}var cal=cal;var cd=cal.activeDiv;var mc=cal.monthsCombo;if(cal.hilitedMonth){Calendar.removeClass(cal.hilitedMonth,"hilite");}if(cal.activeMonth){Calendar.removeClass(cal.activeMonth,"active");}var mon=cal.monthsCombo.getElementsByTagName("div")[cal.date.getMonth()];Calendar.addClass(mon,"active");cal.activeMonth=mon;var s=mc.style;s.display="block";if(cd.navtype<0)s.left=cd.offsetLeft+"px";else{var mcw=mc.offsetWidth;if(typeof mcw=="undefined")mcw=50;s.left=(cd.offsetLeft+cd.offsetWidth-mcw)+"px";}s.top=(cd.offsetTop+cd.offsetHeight)+"px";};Calendar.showYearsCombo=function(fwd){var cal=Calendar._C;if(!cal){return false;}var cal=cal;var cd=cal.activeDiv;var yc=cal.yearsCombo;if(cal.hilitedYear){Calendar.removeClass(cal.hilitedYear,"hilite");}if(cal.activeYear){Calendar.removeClass(cal.activeYear,"active");}cal.activeYear=null;var Y=cal.date.getFullYear()+(fwd?1:-1);var yr=yc.firstChild;var show=false;for(var i=12;i>0;--i){if(Y>=cal.minYear&&Y<=cal.maxYear){yr.firstChild.data=Y;yr.year=Y;yr.style.display="block";show=true;}else{yr.style.display="none";}yr=yr.nextSibling;Y+=fwd?cal.yearStep:-cal.yearStep;}if(show){var s=yc.style;s.display="block";if(cd.navtype<0)s.left=cd.offsetLeft+"px";else{var ycw=yc.offsetWidth;if(typeof ycw=="undefined")ycw=50;s.left=(cd.offsetLeft+cd.offsetWidth-ycw)+"px";}s.top=(cd.offsetTop+cd.offsetHeight)+"px";}};Calendar.tableMouseUp=function(ev){var cal=Calendar._C;if(!cal){return false;}if(cal.timeout){clearTimeout(cal.timeout);}var el=cal.activeDiv;if(!el){return false;}var target=Calendar.getTargetElement(ev);ev||(ev=window.event);Calendar.removeClass(el,"active");if(target==el||target.parentNode==el){Calendar.cellClick(el,ev);}var mon=Calendar.findMonth(target);var date=null;if(mon){date=new Date(cal.date);if(mon.month!=date.getMonth()){date.setMonth(mon.month);cal.setDate(date);cal.dateClicked=false;cal.callHandler();}}else{var year=Calendar.findYear(target);if(year){date=new Date(cal.date);if(year.year!=date.getFullYear()){date.setFullYear(year.year);cal.setDate(date);cal.dateClicked=false;cal.callHandler();}}}with(Calendar){removeEvent(document,"mouseup",tableMouseUp);removeEvent(document,"mouseover",tableMouseOver);removeEvent(document,"mousemove",tableMouseOver);cal._hideCombos();_C=null;return stopEvent(ev);}};Calendar.tableMouseOver=function(ev){var cal=Calendar._C;if(!cal){return;}var el=cal.activeDiv;var target=Calendar.getTargetElement(ev);if(target==el||target.parentNode==el){Calendar.addClass(el,"hilite active");Calendar.addClass(el.parentNode,"rowhilite");}else{if(typeof el.navtype=="undefined"||(el.navtype!=50&&(el.navtype==0||Math.abs(el.navtype)>2)))Calendar.removeClass(el,"active");Calendar.removeClass(el,"hilite");Calendar.removeClass(el.parentNode,"rowhilite");}ev||(ev=window.event);if(el.navtype==50&&target!=el){var pos=Calendar.getAbsolutePos(el);var w=el.offsetWidth;var x=ev.clientX;var dx;var decrease=true;if(x>pos.x+w){dx=x-pos.x-w;decrease=false;}else dx=pos.x-x;if(dx<0)dx=0;var range=el._range;var current=el._current;var count=Math.floor(dx/10)%range.length;for(var i=range.length;--i>=0;)if(range[i]==current)break;while(count-->0)if(decrease){if(--i<0)i=range.length-1;}else if(++i>=range.length)i=0;var newval=range[i];el.firstChild.data=newval;cal.onUpdateTime();}var mon=Calendar.findMonth(target);if(mon){if(mon.month!=cal.date.getMonth()){if(cal.hilitedMonth){Calendar.removeClass(cal.hilitedMonth,"hilite");}Calendar.addClass(mon,"hilite");cal.hilitedMonth=mon;}else if(cal.hilitedMonth){Calendar.removeClass(cal.hilitedMonth,"hilite");}}else{if(cal.hilitedMonth){Calendar.removeClass(cal.hilitedMonth,"hilite");}var year=Calendar.findYear(target);if(year){if(year.year!=cal.date.getFullYear()){if(cal.hilitedYear){Calendar.removeClass(cal.hilitedYear,"hilite");}Calendar.addClass(year,"hilite");cal.hilitedYear=year;}else if(cal.hilitedYear){Calendar.removeClass(cal.hilitedYear,"hilite");}}else if(cal.hilitedYear){Calendar.removeClass(cal.hilitedYear,"hilite");}}return Calendar.stopEvent(ev);};Calendar.tableMouseDown=function(ev){if(Calendar.getTargetElement(ev)==Calendar.getElement(ev)){return Calendar.stopEvent(ev);}};Calendar.calDragIt=function(ev){var cal=Calendar._C;if(!(cal&&cal.dragging)){return false;}var posX;var posY;if(Calendar.is_ie){posY=window.event.clientY+document.body.scrollTop;posX=window.event.clientX+document.body.scrollLeft;}else{posX=ev.pageX;posY=ev.pageY;}cal.hideShowCovered();var st=cal.element.style;st.left=(posX-cal.xOffs)+"px";st.top=(posY-cal.yOffs)+"px";return Calendar.stopEvent(ev);};Calendar.calDragEnd=function(ev){var cal=Calendar._C;if(!cal){return false;}cal.dragging=false;with(Calendar){removeEvent(document,"mousemove",calDragIt);removeEvent(document,"mouseup",calDragEnd);tableMouseUp(ev);}cal.hideShowCovered();};Calendar.dayMouseDown=function(ev){var el=Calendar.getElement(ev);if(el.disabled){return false;}var cal=el.calendar;cal.activeDiv=el;Calendar._C=cal;if(el.navtype!=300)with(Calendar){if(el.navtype==50){el._current=el.firstChild.data;addEvent(document,"mousemove",tableMouseOver);}else addEvent(document,Calendar.is_ie5?"mousemove":"mouseover",tableMouseOver);addClass(el,"hilite active");addEvent(document,"mouseup",tableMouseUp);}else if(cal.isPopup){cal._dragStart(ev);}if(el.navtype==-1||el.navtype==1){if(cal.timeout)clearTimeout(cal.timeout);cal.timeout=setTimeout("Calendar.showMonthsCombo()",250);}else if(el.navtype==-2||el.navtype==2){if(cal.timeout)clearTimeout(cal.timeout);cal.timeout=setTimeout((el.navtype>0)?"Calendar.showYearsCombo(true)":"Calendar.showYearsCombo(false)",250);}else{cal.timeout=null;}return Calendar.stopEvent(ev);};Calendar.dayMouseDblClick=function(ev){Calendar.cellClick(Calendar.getElement(ev),ev||window.event);if(Calendar.is_ie){document.selection.empty();}};Calendar.dayMouseOver=function(ev){var el=Calendar.getElement(ev);if(Calendar.isRelated(el,ev)||Calendar._C||el.disabled){return false;}if(el.ttip){if(el.ttip.substr(0,1)=="_"){el.ttip=el.caldate.print(el.calendar.ttDateFormat)+el.ttip.substr(1);}el.calendar.tooltips.firstChild.data=el.ttip;}if(el.navtype!=300){Calendar.addClass(el,"hilite");if(el.caldate){Calendar.addClass(el.parentNode,"rowhilite");}}return Calendar.stopEvent(ev);};Calendar.dayMouseOut=function(ev){with(Calendar){var el=getElement(ev);if(isRelated(el,ev)||_C||el.disabled){return false;}removeClass(el,"hilite");if(el.caldate){removeClass(el.parentNode,"rowhilite");}el.calendar.tooltips.firstChild.data=_TT["SEL_DATE"];return stopEvent(ev);}};Calendar.cellClick=function(el,ev){var cal=el.calendar;var closing=false;var newdate=false;var date=null;if(typeof el.navtype=="undefined"){Calendar.removeClass(cal.currentDateEl,"selected");Calendar.addClass(el,"selected");closing=(cal.currentDateEl==el);if(!closing){cal.currentDateEl=el;}cal.date=new Date(el.caldate);date=cal.date;newdate=true;if(!(cal.dateClicked=!el.otherMonth))cal._init(cal.firstDayOfWeek,date);}else{if(el.navtype==200){Calendar.removeClass(el,"hilite");cal.callCloseHandler();return;}date=(el.navtype==0)?new Date():new Date(cal.date);cal.dateClicked=false;var year=date.getFullYear();var mon=date.getMonth();function setMonth(m){var day=date.getDate();var max=date.getMonthDays(m);if(day>max){date.setDate(max);}date.setMonth(m);};switch(el.navtype){case 400:Calendar.removeClass(el,"hilite");var text=Calendar._TT["ABOUT"];if(typeof text!="undefined"){text+=cal.showsTime?Calendar._TT["ABOUT_TIME"]:"";}else{text="Help and about box text is not translated into this language.\n"+"If you know this language and you feel generous please update\n"+"the corresponding file in \"lang\" subdir to match calendar-en.js\n"+"and send it back to <mishoo@infoiasi.ro> to get it into the distribution ;-)\n\n"+"Thank you!\n"+"http://dynarch.com/mishoo/calendar.epl\n";}alert(text);return;case-2:if(year>cal.minYear){date.setFullYear(year-1);}break;case-1:if(mon>0){setMonth(mon-1);}else if(year-->cal.minYear){date.setFullYear(year);setMonth(11);}break;case 1:if(mon<11){setMonth(mon+1);}else if(year<cal.maxYear){date.setFullYear(year+1);setMonth(0);}break;case 2:if(year<cal.maxYear){date.setFullYear(year+1);}break;case 100:cal.setFirstDayOfWeek(el.fdow);return;case 50:var range=el._range;var current=el.firstChild.data;for(var i=range.length;--i>=0;)if(range[i]==current)break;if(ev&&ev.shiftKey){if(--i<0)i=range.length-1;}else if(++i>=range.length)i=0;var newval=range[i];el.firstChild.data=newval;cal.onUpdateTime();return;case 0:if((typeof cal.getDateStatus=="function")&&cal.getDateStatus(date,date.getFullYear(),date.getMonth(),date.getDate())){return false;}break;}if(!date.equalsTo(cal.date)){cal.setDate(date);newdate=true;}}if(newdate){cal.callHandler();}if(closing){Calendar.removeClass(el,"hilite");cal.callCloseHandler();}};Calendar.prototype.create=function(_par){var parent=null;if(!_par){parent=document.getElementsByTagName("body")[0];this.isPopup=true;}else{parent=_par;this.isPopup=false;}this.date=this.dateStr?new Date(this.dateStr):new Date();var table=Calendar.createElement("table");this.table=table;table.cellSpacing=0;table.cellPadding=0;table.calendar=this;Calendar.addEvent(table,"mousedown",Calendar.tableMouseDown);var div=Calendar.createElement("div");this.element=div;div.className="calendar";if(this.isPopup){div.style.position="absolute";div.style.display="none";}div.appendChild(table);var thead=Calendar.createElement("thead",table);var cell=null;var row=null;var cal=this;var hh=function(text,cs,navtype){cell=Calendar.createElement("td",row);cell.colSpan=cs;cell.className="button";if(navtype!=0&&Math.abs(navtype)<=2)cell.className+=" nav";Calendar._add_evs(cell);cell.calendar=cal;cell.navtype=navtype;if(text.substr(0,1)!="&"){cell.appendChild(document.createTextNode(text));}else{cell.innerHTML=text;}return cell;};row=Calendar.createElement("tr",thead);var title_length=6;(this.isPopup)&&--title_length;(this.weekNumbers)&&++title_length;hh("?",1,400).ttip=Calendar._TT["INFO"];this.title=hh("",title_length,300);this.title.className="title";if(this.isPopup){this.title.ttip=Calendar._TT["DRAG_TO_MOVE"];this.title.style.cursor="move";hh("×",1,200).ttip=Calendar._TT["CLOSE"];}row=Calendar.createElement("tr",thead);row.className="headrow";this._nav_py=hh("«",1,-2);this._nav_py.ttip=Calendar._TT["PREV_YEAR"];this._nav_pm=hh("‹",1,-1);this._nav_pm.ttip=Calendar._TT["PREV_MONTH"];this._nav_now=hh(Calendar._TT["TODAY"],this.weekNumbers?4:3,0);this._nav_now.ttip=Calendar._TT["GO_TODAY"];this._nav_nm=hh("›",1,1);this._nav_nm.ttip=Calendar._TT["NEXT_MONTH"];this._nav_ny=hh("»",1,2);this._nav_ny.ttip=Calendar._TT["NEXT_YEAR"];row=Calendar.createElement("tr",thead);row.className="daynames";if(this.weekNumbers){cell=Calendar.createElement("td",row);cell.className="name wn";cell.appendChild(document.createTextNode(Calendar._TT["WK"]));}for(var i=7;i>0;--i){cell=Calendar.createElement("td",row);cell.appendChild(document.createTextNode(""));if(!i){cell.navtype=100;cell.calendar=this;Calendar._add_evs(cell);}}this.firstdayname=(this.weekNumbers)?row.firstChild.nextSibling:row.firstChild;this._displayWeekdays();var tbody=Calendar.createElement("tbody",table);this.tbody=tbody;for(i=6;i>0;--i){row=Calendar.createElement("tr",tbody);if(this.weekNumbers){cell=Calendar.createElement("td",row);cell.appendChild(document.createTextNode(""));}for(var j=7;j>0;--j){cell=Calendar.createElement("td",row);cell.appendChild(document.createTextNode(""));cell.calendar=this;Calendar._add_evs(cell);}}if(this.showsTime){row=Calendar.createElement("tr",tbody);row.className="time";cell=Calendar.createElement("td",row);cell.className="time";cell.colSpan=2;cell.innerHTML=Calendar._TT["TIME"]||" ";cell=Calendar.createElement("td",row);cell.className="time";cell.colSpan=this.weekNumbers?4:3;(function(){function makeTimePart(className,init,range_start,range_end){var part=Calendar.createElement("span",cell);part.className=className;part.appendChild(document.createTextNode(init));part.calendar=cal;part.ttip=Calendar._TT["TIME_PART"];part.navtype=50;part._range=[];if(typeof range_start!="number")part._range=range_start;else{for(var i=range_start;i<=range_end;++i){var txt;if(i<10&&range_end>=10)txt='0'+i;else txt=''+i;part._range[part._range.length]=txt;}}Calendar._add_evs(part);return part;};var hrs=cal.date.getHours();var mins=cal.date.getMinutes();var t12=!cal.time24;var pm=(hrs>12);if(t12&&pm)hrs-=12;var H=makeTimePart("hour",hrs,t12?1:0,t12?12:23);var span=Calendar.createElement("span",cell);span.appendChild(document.createTextNode(":"));span.className="colon";var M=makeTimePart("minute",mins,0,59);var AP=null;cell=Calendar.createElement("td",row);cell.className="time";cell.colSpan=2;if(t12)AP=makeTimePart("ampm",pm?"pm":"am",["am","pm"]);else cell.innerHTML=" ";cal.onSetTime=function(){var hrs=this.date.getHours();var mins=this.date.getMinutes();var pm=(hrs>12);if(pm&&t12)hrs-=12;H.firstChild.data=(hrs<10)?("0"+hrs):hrs;M.firstChild.data=(mins<10)?("0"+mins):mins;if(t12)AP.firstChild.data=pm?"pm":"am";};cal.onUpdateTime=function(){var date=this.date;var h=parseInt(H.firstChild.data,10);if(t12){if(/pm/i.test(AP.firstChild.data)&&h<12)h+=12;else if(/am/i.test(AP.firstChild.data)&&h==12)h=0;}var d=date.getDate();var m=date.getMonth();var y=date.getFullYear();date.setHours(h);date.setMinutes(parseInt(M.firstChild.data,10));date.setFullYear(y);date.setMonth(m);date.setDate(d);this.dateClicked=false;this.callHandler();};})();}else{this.onSetTime=this.onUpdateTime=function(){};}var tfoot=Calendar.createElement("tfoot",table);row=Calendar.createElement("tr",tfoot);row.className="footrow";cell=hh(Calendar._TT["SEL_DATE"],this.weekNumbers?8:7,300);cell.className="ttip";if(this.isPopup){cell.ttip=Calendar._TT["DRAG_TO_MOVE"];cell.style.cursor="move";}this.tooltips=cell;div=Calendar.createElement("div",this.element);this.monthsCombo=div;div.className="combo";for(i=0;i<Calendar._MN.length;++i){var mn=Calendar.createElement("div");mn.className=Calendar.is_ie?"label-IEfix":"label";mn.month=i;mn.appendChild(document.createTextNode(Calendar._SMN[i]));div.appendChild(mn);}div=Calendar.createElement("div",this.element);this.yearsCombo=div;div.className="combo";for(i=12;i>0;--i){var yr=Calendar.createElement("div");yr.className=Calendar.is_ie?"label-IEfix":"label";yr.appendChild(document.createTextNode(""));div.appendChild(yr);}this._init(this.firstDayOfWeek,this.date);parent.appendChild(this.element);};Calendar._keyEvent=function(ev){if(!window.calendar){return false;}(Calendar.is_ie)&&(ev=window.event);var cal=window.calendar;var act=(Calendar.is_ie||ev.type=="keypress");if(ev.ctrlKey){switch(ev.keyCode){case 37:act&&Calendar.cellClick(cal._nav_pm);break;case 38:act&&Calendar.cellClick(cal._nav_py);break;case 39:act&&Calendar.cellClick(cal._nav_nm);break;case 40:act&&Calendar.cellClick(cal._nav_ny);break;default:return false;}}else switch(ev.keyCode){case 32:Calendar.cellClick(cal._nav_now);break;case 27:act&&cal.callCloseHandler();break;case 37:case 38:case 39:case 40:if(act){var date=cal.date.getDate()-1;var el=cal.currentDateEl;var ne=null;var prev=(ev.keyCode==37)||(ev.keyCode==38);switch(ev.keyCode){case 37:(--date>=0)&&(ne=cal.ar_days[date]);break;case 38:date-=7;(date>=0)&&(ne=cal.ar_days[date]);break;case 39:(++date<cal.ar_days.length)&&(ne=cal.ar_days[date]);break;case 40:date+=7;(date<cal.ar_days.length)&&(ne=cal.ar_days[date]);break;}if(!ne){if(prev){Calendar.cellClick(cal._nav_pm);}else{Calendar.cellClick(cal._nav_nm);}date=(prev)?cal.date.getMonthDays():1;el=cal.currentDateEl;ne=cal.ar_days[date-1];}Calendar.removeClass(el,"selected");Calendar.addClass(ne,"selected");cal.date=new Date(ne.caldate);cal.callHandler();cal.currentDateEl=ne;}break;case 13:if(act){cal.callHandler();cal.hide();}break;default:return false;}return Calendar.stopEvent(ev);};Calendar.prototype._init=function(firstDayOfWeek,date){var today=new Date();this.table.style.visibility="hidden";var year=date.getFullYear();if(year<this.minYear){year=this.minYear;date.setFullYear(year);}else if(year>this.maxYear){year=this.maxYear;date.setFullYear(year);}this.firstDayOfWeek=firstDayOfWeek;this.date=new Date(date);var month=date.getMonth();var mday=date.getDate();var no_days=date.getMonthDays();date.setDate(1);var day1=(date.getDay()-this.firstDayOfWeek)%7;if(day1<0)day1+=7;date.setDate(-day1);date.setDate(date.getDate()+1);var row=this.tbody.firstChild;var MN=Calendar._SMN[month];var ar_days=new Array();var weekend=Calendar._TT["WEEKEND"];for(var i=0;i<6;++i,row=row.nextSibling){var cell=row.firstChild;if(this.weekNumbers){cell.className="day wn";cell.firstChild.data=date.getWeekNumber();cell=cell.nextSibling;}row.className="daysrow";var hasdays=false;for(var j=0;j<7;++j,cell=cell.nextSibling,date.setDate(date.getDate()+1)){var iday=date.getDate();var wday=date.getDay();cell.className="day";var current_month=(date.getMonth()==month);if(!current_month){if(this.showsOtherMonths){cell.className+=" othermonth";cell.otherMonth=true;}else{cell.className="emptycell";cell.innerHTML=" ";cell.disabled=true;continue;}}else{cell.otherMonth=false;hasdays=true;}cell.disabled=false;cell.firstChild.data=iday;if(typeof this.getDateStatus=="function"){var status=this.getDateStatus(date,year,month,iday);if(status===true){cell.className+=" disabled";cell.disabled=true;}else{if(/disabled/i.test(status))cell.disabled=true;cell.className+=" "+status;}}if(!cell.disabled){ar_days[ar_days.length]=cell;cell.caldate=new Date(date);cell.ttip="_";if(current_month&&iday==mday){cell.className+=" selected";this.currentDateEl=cell;}if(date.getFullYear()==today.getFullYear()&&date.getMonth()==today.getMonth()&&iday==today.getDate()){cell.className+=" today";cell.ttip+=Calendar._TT["PART_TODAY"];}if(weekend.indexOf(wday.toString())!=-1){cell.className+=cell.otherMonth?" oweekend":" weekend";}}}if(!(hasdays||this.showsOtherMonths))row.className="emptyrow";}this.ar_days=ar_days;this.title.firstChild.data=Calendar._MN[month]+", "+year;this.onSetTime();this.table.style.visibility="visible";};Calendar.prototype.setDate=function(date){if(!date.equalsTo(this.date)){this._init(this.firstDayOfWeek,date);}};Calendar.prototype.refresh=function(){this._init(this.firstDayOfWeek,this.date);};Calendar.prototype.setFirstDayOfWeek=function(firstDayOfWeek){this._init(firstDayOfWeek,this.date);this._displayWeekdays();};Calendar.prototype.setDateStatusHandler=Calendar.prototype.setDisabledHandler=function(unaryFunction){this.getDateStatus=unaryFunction;};Calendar.prototype.setRange=function(a,z){this.minYear=a;this.maxYear=z;};Calendar.prototype.callHandler=function(){if(this.onSelected){this.onSelected(this,this.date.print(this.dateFormat));}};Calendar.prototype.callCloseHandler=function(){if(this.onClose){this.onClose(this);}this.hideShowCovered();};Calendar.prototype.destroy=function(){var el=this.element.parentNode;el.removeChild(this.element);Calendar._C=null;window.calendar=null;};Calendar.prototype.reparent=function(new_parent){var el=this.element;el.parentNode.removeChild(el);new_parent.appendChild(el);};Calendar._checkCalendar=function(ev){if(!window.calendar){return false;}var el=Calendar.is_ie?Calendar.getElement(ev):Calendar.getTargetElement(ev);for(;el!=null&&el!=calendar.element;el=el.parentNode);if(el==null){window.calendar.callCloseHandler();return Calendar.stopEvent(ev);}};Calendar.prototype.show=function(){var rows=this.table.getElementsByTagName("tr");for(var i=rows.length;i>0;){var row=rows[--i];Calendar.removeClass(row,"rowhilite");var cells=row.getElementsByTagName("td");for(var j=cells.length;j>0;){var cell=cells[--j];Calendar.removeClass(cell,"hilite");Calendar.removeClass(cell,"active");}}this.element.style.display="block";this.hidden=false;if(this.isPopup){window.calendar=this;Calendar.addEvent(document,"keydown",Calendar._keyEvent);Calendar.addEvent(document,"keypress",Calendar._keyEvent);Calendar.addEvent(document,"mousedown",Calendar._checkCalendar);}this.hideShowCovered();};Calendar.prototype.hide=function(){if(this.isPopup){Calendar.removeEvent(document,"keydown",Calendar._keyEvent);Calendar.removeEvent(document,"keypress",Calendar._keyEvent);Calendar.removeEvent(document,"mousedown",Calendar._checkCalendar);}this.element.style.display="none";this.hidden=true;this.hideShowCovered();};Calendar.prototype.showAt=function(x,y){var s=this.element.style;s.left=x+"px";s.top=y+"px";this.show();};Calendar.prototype.showAtElement=function(el,opts){var self=this;var p=Calendar.getAbsolutePos(el);if(!opts||typeof opts!="string"){this.showAt(p.x,p.y+el.offsetHeight);return true;}function fixPosition(box){if(box.x<0)box.x=0;if(box.y<0)box.y=0;var cp=document.createElement("div");var s=cp.style;s.position="absolute";s.right=s.bottom=s.width=s.height="0px";document.body.appendChild(cp);var br=Calendar.getAbsolutePos(cp);document.body.removeChild(cp);if(Calendar.is_ie){br.y+=document.body.scrollTop;br.x+=document.body.scrollLeft;}else{br.y+=window.scrollY;br.x+=window.scrollX;}var tmp=box.x+box.width-br.x;if(tmp>0)box.x-=tmp;tmp=box.y+box.height-br.y;if(tmp>0)box.y-=tmp;};this.element.style.display="block";Calendar.continuation_for_the_fucking_khtml_browser=function(){var w=self.element.offsetWidth;var h=self.element.offsetHeight;self.element.style.display="none";var valign=opts.substr(0,1);var halign="l";if(opts.length>1){halign=opts.substr(1,1);}switch(valign){case "T":p.y-=h;break;case "B":p.y+=el.offsetHeight;break;case "C":p.y+=(el.offsetHeight-h)/2;break;case "t":p.y+=el.offsetHeight-h;break;case "b":break;}switch(halign){case "L":p.x-=w;break;case "R":p.x+=el.offsetWidth;break;case "C":p.x+=(el.offsetWidth-w)/2;break;case "r":p.x+=el.offsetWidth-w;break;case "l":break;}p.width=w;p.height=h+40;self.monthsCombo.style.display="none";fixPosition(p);self.showAt(p.x,p.y);};if(Calendar.is_khtml)setTimeout("Calendar.continuation_for_the_fucking_khtml_browser()",10);else Calendar.continuation_for_the_fucking_khtml_browser();};Calendar.prototype.setDateFormat=function(str){this.dateFormat=str;};Calendar.prototype.setTtDateFormat=function(str){this.ttDateFormat=str;};Calendar.prototype.parseDate=function(str,fmt){var y=0;var m=-1;var d=0;var a=str.split(/\W+/);if(!fmt){fmt=this.dateFormat;}var b=fmt.match(/%./g);var i=0,j=0;var hr=0;var min=0;for(i=0;i<a.length;++i){if(!a[i])continue;switch(b[i]){case "%d":case "%e":d=parseInt(a[i],10);break;case "%m":m=parseInt(a[i],10)-1;break;case "%Y":case "%y":y=parseInt(a[i],10);(y<100)&&(y+=(y>29)?1900:2000);break;case "%b":case "%B":for(j=0;j<12;++j){if(Calendar._MN[j].substr(0,a[i].length).toLowerCase()==a[i].toLowerCase()){m=j;break;}}break;case "%H":case "%I":case "%k":case "%l":hr=parseInt(a[i],10);break;case "%P":case "%p":if(/pm/i.test(a[i])&&hr<12)hr+=12;break;case "%M":min=parseInt(a[i],10);break;}}if(y!=0&&m!=-1&&d!=0){this.setDate(new Date(y,m,d,hr,min,0));return;}y=0;m=-1;d=0;for(i=0;i<a.length;++i){if(a[i].search(/[a-zA-Z]+/)!=-1){var t=-1;for(j=0;j<12;++j){if(Calendar._MN[j].substr(0,a[i].length).toLowerCase()==a[i].toLowerCase()){t=j;break;}}if(t!=-1){if(m!=-1){d=m+1;}m=t;}}else if(parseInt(a[i],10)<=12&&m==-1){m=a[i]-1;}else if(parseInt(a[i],10)>31&&y==0){y=parseInt(a[i],10);(y<100)&&(y+=(y>29)?1900:2000);}else if(d==0){d=a[i];}}if(y==0){var today=new Date();y=today.getFullYear();}if(m!=-1&&d!=0){this.setDate(new Date(y,m,d,hr,min,0));}};Calendar.prototype.hideShowCovered=function(){var self=this;Calendar.continuation_for_the_fucking_khtml_browser=function(){function getVisib(obj){var value=obj.style.visibility;if(!value){if(document.defaultView&&typeof(document.defaultView.getComputedStyle)=="function"){if(!Calendar.is_khtml)value=document.defaultView. getComputedStyle(obj,"").getPropertyValue("visibility");else value='';}else if(obj.currentStyle){value=obj.currentStyle.visibility;}else value='';}return value;};var tags=new Array("applet","iframe","select");var el=self.element;var p=Calendar.getAbsolutePos(el);var EX1=p.x;var EX2=el.offsetWidth+EX1;var EY1=p.y;var EY2=el.offsetHeight+EY1;for(var k=tags.length;k>0;){var ar=document.getElementsByTagName(tags[--k]);var cc=null;for(var i=ar.length;i>0;){cc=ar[--i];p=Calendar.getAbsolutePos(cc);var CX1=p.x;var CX2=cc.offsetWidth+CX1;var CY1=p.y;var CY2=cc.offsetHeight+CY1;if(self.hidden||(CX1>EX2)||(CX2<EX1)||(CY1>EY2)||(CY2<EY1)){if(!cc.__msh_save_visibility){cc.__msh_save_visibility=getVisib(cc);}cc.style.visibility=cc.__msh_save_visibility;}else{if(!cc.__msh_save_visibility){cc.__msh_save_visibility=getVisib(cc);}cc.style.visibility="hidden";}}}};if(Calendar.is_khtml)setTimeout("Calendar.continuation_for_the_fucking_khtml_browser()",10);else Calendar.continuation_for_the_fucking_khtml_browser();};Calendar.prototype._displayWeekdays=function(){var fdow=this.firstDayOfWeek;var cell=this.firstdayname;var weekend=Calendar._TT["WEEKEND"];for(var i=0;i<7;++i){cell.className="day name";var realday=(i+fdow)%7;if(i){cell.ttip=Calendar._TT["DAY_FIRST"].replace("%s",Calendar._DN[realday]);cell.navtype=100;cell.calendar=this;cell.fdow=realday;Calendar._add_evs(cell);}if(weekend.indexOf(realday.toString())!=-1){Calendar.addClass(cell,"weekend");}cell.firstChild.data=Calendar._SDN[(i+fdow)%7];cell=cell.nextSibling;}};Calendar.prototype._hideCombos=function(){this.monthsCombo.style.display="none";this.yearsCombo.style.display="none";};Calendar.prototype._dragStart=function(ev){if(this.dragging){return;}this.dragging=true;var posX;var posY;if(Calendar.is_ie){posY=window.event.clientY+document.body.scrollTop;posX=window.event.clientX+document.body.scrollLeft;}else{posY=ev.clientY+window.scrollY;posX=ev.clientX+window.scrollX;}var st=this.element.style;this.xOffs=posX-parseInt(st.left);this.yOffs=posY-parseInt(st.top);with(Calendar){addEvent(document,"mousemove",calDragIt);addEvent(document,"mouseup",calDragEnd);}};Date._MD=new Array(31,28,31,30,31,30,31,31,30,31,30,31);Date.SECOND=1000;Date.MINUTE=60*Date.SECOND;Date.HOUR=60*Date.MINUTE;Date.DAY=24*Date.HOUR;Date.WEEK=7*Date.DAY;Date.prototype.getMonthDays=function(month){var year=this.getFullYear();if(typeof month=="undefined"){month=this.getMonth();}if(((0==(year%4))&&((0!=(year%100))||(0==(year%400))))&&month==1){return 29;}else{return Date._MD[month];}};Date.prototype.getDayOfYear=function(){var now=new Date(this.getFullYear(),this.getMonth(),this.getDate(),0,0,0);var then=new Date(this.getFullYear(),0,0,0,0,0);var time=now-then;return Math.floor(time/Date.DAY);};Date.prototype.getWeekNumber=function(){var d=new Date(this.getFullYear(),this.getMonth(),this.getDate(),0,0,0);var DoW=d.getDay();d.setDate(d.getDate()-(DoW+6)%7+3);var ms=d.valueOf();d.setMonth(0);d.setDate(4);return Math.round((ms-d.valueOf())/(7*864e5))+1;};Date.prototype.equalsTo=function(date){return((this.getFullYear()==date.getFullYear())&&(this.getMonth()==date.getMonth())&&(this.getDate()==date.getDate())&&(this.getHours()==date.getHours())&&(this.getMinutes()==date.getMinutes()));};Date.prototype.print=function(str){var m=this.getMonth();var d=this.getDate();var y=this.getFullYear();var wn=this.getWeekNumber();var w=this.getDay();var s={};var hr=this.getHours();var pm=(hr>=12);var ir=(pm)?(hr-12):hr;var dy=this.getDayOfYear();if(ir==0)ir=12;var min=this.getMinutes();var sec=this.getSeconds();s["%a"]=Calendar._SDN[w];s["%A"]=Calendar._DN[w];s["%b"]=Calendar._SMN[m];s["%B"]=Calendar._MN[m];s["%C"]=1+Math.floor(y/100);s["%d"]=(d<10)?("0"+d):d;s["%e"]=d;s["%H"]=(hr<10)?("0"+hr):hr;s["%I"]=(ir<10)?("0"+ir):ir;s["%j"]=(dy<100)?((dy<10)?("00"+dy):("0"+dy)):dy;s["%k"]=hr;s["%l"]=ir;s["%m"]=(m<9)?("0"+(1+m)):(1+m);s["%M"]=(min<10)?("0"+min):min;s["%n"]="\n";s["%p"]=pm?"PM":"AM";s["%P"]=pm?"pm":"am";s["%s"]=Math.floor(this.getTime()/1000);s["%S"]=(sec<10)?("0"+sec):sec;s["%t"]="\t";s["%U"]=s["%W"]=s["%V"]=(wn<10)?("0"+wn):wn;s["%u"]=w+1;s["%w"]=w;s["%y"]=(''+y).substr(2,2);s["%Y"]=y;s["%%"]="%";var re=/%./g;if(!Calendar.is_ie5)return str.replace(re,function(par){return s[par]||par;});var a=str.match(re);for(var i=0;i<a.length;i++){var tmp=s[a[i]];if(tmp){re=new RegExp(a[i],'g');str=str.replace(re,tmp);}}return str;};Date.prototype.__msh_oldSetFullYear=Date.prototype.setFullYear;Date.prototype.setFullYear=function(y){var d=new Date(this);d.__msh_oldSetFullYear(y);if(d.getMonth()!=this.getMonth())this.setDate(28);this.__msh_oldSetFullYear(y);};window.calendar=null;
\ No newline at end of file
<BODY BGCOLOR="#FFFFFF">
<table width="100%">
<tr><td>
- <IMG BORDER=0 ALT="Silicon Interactive Software Design" SRC="images/small-logo.png">
- </td><td>
- <font color="#ff0000" size=7>freeside main menu</font>
+ <IMG BORDER=0 ALT="freeside" SRC="images/small-logo.png">
+ </td><td valign="top">
+ <font color="#7f007b" size=7></font>
</td><td align=right valign=bottom>
version %%%VERSION%%%
<BR><A HREF="http://www.sisd.com/freeside">Freeside home page</A>
<FORM ACTION="search/cust_main.cgi" METHOD="POST"><INPUT TYPE="hidden" NAME="phone_on" VALUE="1">Phone # <INPUT TYPE="text" NAME="phone_text"><INPUT TYPE="submit" VALUE="Search"></FORM>
<BR><FORM ACTION="search/svc_acct.cgi" METHOD="POST">Username <INPUT TYPE="text" NAME="username"><SELECT NAME="username_type"><OPTION VALUE="All">(all)</OPTION><OPTION>Fuzzy</OPTION><OPTION>Substring</OPTION><OPTION SELECTED>Exact</OPTION></SELECT><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/svc_acct.cgi?username">all accounts by username</A> or <A HREF="search/svc_acct.cgi?uid">uid</A></FORM>
<BR><FORM ACTION="search/svc_domain.cgi" METHOD="POST">Domain <INPUT TYPE="text" NAME="domain"><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/svc_domain.cgi?domain">all domains</A></FORM>
-<!-- <LI><A HREF="search/svc_acct_sm.html">mail aliases (by domain, and optionally username)</A>-->
-<!-- <LI><A HREF="search/svc_forward.html">mail forwards (by ?)</A>-->
+ <BR><A HREF="search/svc_forward.cgi?svcnum">all mail forwards by svcnum</A><BR>
<BR>
</TD></TR>
</TABLE>
<UL>
<LI><a href="search/cust_bill_event.html">Invoice event errors (failed credit cards)</a>
<LI>open invoices (<A HREF="search/cust_bill.cgi?OPEN_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN_custnum">by customer number</A>)
+ <LI>15 day open invoices (<A HREF="search/cust_bill.cgi?OPEN15_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN15_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN15_custnum">by customer number</A>)
<LI>30 day open invoices (<A HREF="search/cust_bill.cgi?OPEN30_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN30_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN30_custnum">by customer number</A>)
<LI>60 day open invoices (<A HREF="search/cust_bill.cgi?OPEN60_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN60_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN60_custnum">by customer number</A>)
<LI>90 day open invoices (<A HREF="search/cust_bill.cgi?OPEN90_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN90_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN90_custnum">by customer number</A>)
<LI>all invoices (<A HREF="search/cust_bill.cgi?invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?date">by date</A>) (<A HREF="search/cust_bill.cgi?custnum">by customer number</A>)
</UL>
<A HREF="search/report_cust_pay.html">Payment report (by type and/or date range)</A>
+ <BR><BR><A HREF="search/report_cust_credit.html">Credit report (by employee and/or date range)</A>
<BR><BR><A HREF="search/report_receivables.cgi">Accounts Receivable Aging Summary</A>
- <BR><BR>(old) Financial reports (being rewritten)
- <UL>
- <LI> <A HREF="search/report_tax.html">tax reports</A>
- <LI> <A HREF="search/report_cc.html">credit card receipts</A>
- <LI> <A HREF="search/report_credit.html">credit memos</A>
- </UL>
+ <BR><BR><A HREF="search/report_prepaid_income.html">Prepaid Income (Unearned Revenue) Report</A>
+ <BR><BR><A HREF="search/report_tax.html">Sales Tax Liability Report</A>
+ <BR><BR>
<CENTER><HR WIDTH="94%" NOSHADE></CENTER><BR>
<A NAME="admin">Administration</a>
<ul>
<LI><A HREF="search/cust_pkg_report.cgi">packages (by next bill date range)</A>
</UL>
<A HREF="browse/part_pkg.cgi?active=1">Package definitions (by number of active packages)</A><BR><BR>
+ <A HREF="browse/part_svc.cgi?active=1">Service definitions (by number of active services)</A><BR><BR>
Customers
<UL>
<LI><A HREF="search/cust_main-otaker.cgi">Search customers by order-taker</A>
<BR><A HREF="browse/queue.cgi">View pending job queue</A>
<BR><A HREF="misc/cust_main-import.cgi">Batch import customers from CSV file</A>
<BR><A HREF="misc/cust_main-import_charges.cgi">Batch import charges from CSV file</A>
+ <BR><A HREF="misc/dump.cgi">Download database dump</A>
<BR><BR><CENTER><HR WIDTH="94%" NOSHADE></CENTER><BR>
<A NAME="config" HREF="config/config-view.cgi">Configuration</a><!-- - <font size="+2" color="#ff0000">start here</font> -->
<BR><BR><A NAME="admin">Administration</a>
my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
die "Unknown svcnum!" unless $cust_svc;
-&eidiot(qq!This account has already been audited. Cancel the
- <A HREF="!. popurl(2). qq!view/cust_pkg.cgi?! . $cust_svc->getfield('pkgnum') .
- qq!pkgnum"> package</A> instead.!)
- if $cust_svc->pkgnum ne '' && $cust_svc->pkgnum ne '0';
+my $cust_pkg = $cust_svc->cust_pkg;
+if ( $cust_pkg ) {
+ &eidiot( 'This account has already been audited. Cancel the '.
+ qq!<A HREF="${p}view/cust_main.cgi?!. $cust_pkg->custnum.
+ '#cust_pkg'. $cust_pkg->pkgnum. '">'.
+ 'package</A> instead.');
+}
my $error = $cust_svc->cancel;
my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } );
-my $error = $cust_main->cancel;
-eidiot($error) if $error;
+my @errors = $cust_main->cancel;
+eidiot(join(' / ', @errors)) if scalar(@errors);
#print $cgi->redirect($p. "view/cust_main.cgi?". $cust_main->custnum);
print $cgi->redirect($p);
--- /dev/null
+<%
+ if ( driver_name =~ /^Pg$/ ) {
+ my $dbname = (split(':', datasrc))[2];
+ if ( $dbname =~ /[;=]/ ) {
+ my %elements = map { /^(\w+)=(.*)$/; $1=>$2 } split(';', $dbname);
+ $dbname = $elements{'dbname'};
+ }
+ open(DUMP,"pg_dump $dbname |");
+ } else {
+ eidiot "don't (yet) know how to dump ". driver_name. " databases\n";
+ }
+
+ http_header('Content-Type' => 'text/plain' );
+
+ while (<DUMP>) {
+ print $_;
+ }
+ close DUMP;
+%>
--- /dev/null
+<%
+
+my $conf = new FS::Conf;
+
+#untaint invnum
+my($query) = $cgi->keywords;
+$query =~ /^(\d*)$/;
+my $invnum = $1;
+my $cust_bill = qsearchs('cust_bill',{'invnum'=>$invnum});
+die "Can't find invoice!\n" unless $cust_bill;
+
+my $error = send_email(
+ 'from' => $conf->config('invoice_from'),
+ 'to' => [ grep { $_ ne 'POST' } $cust_bill->cust_main->invoicing_list ],
+ 'subject' => 'Invoice',
+ 'body' => [ $cust_bill->print_text ],
+);
+eidiot($error) if $error;
+
+my $custnum = $cust_bill->getfield('custnum');
+print $cgi->redirect("${p}view/cust_main.cgi?$custnum");
+
+%>
+<!-- mason kludge -->
<%
-#untaint date & pkgnum
-
-my $date;
-if ( $cgi->param('date') ) {
- str2time($cgi->param('date')) =~ /^(\d+)$/ or die "Illegal date";
- $date=$1;
-} else {
- $date='';
-}
-
-$cgi->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum";
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
my $pkgnum = $1;
+#get package record
my $cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-my %hash = $cust_pkg->hash;
-$hash{expire}=$date;
-my $new = new FS::cust_pkg ( \%hash );
-my $error = $new->replace($cust_pkg);
-&eidiot($error) if $error;
+die "Unknown pkgnum $pkgnum" unless $cust_pkg;
+my $part_pkg = $cust_pkg->part_pkg;
+
+my $custnum = $cust_pkg->getfield('custnum');
-print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+my $date = $cust_pkg->expire ? time2str('%D', $cust_pkg->expire) : '';
%>
+
+<%= header('Expire package', menubar(
+ "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
+ 'Main Menu' => popurl(2)
+)) %>
+
+<LINK REL="stylesheet" TYPE="text/css" HREF="../elements/calendar-win2k-2.css" TITLE="win2k-2">
+<SCRIPT TYPE="text/javascript" SRC="../elements/calendar_stripped.js"></SCRIPT>
+<SCRIPT TYPE="text/javascript" SRC="../elements/calendar-en.js"></SCRIPT>
+<SCRIPT TYPE="text/javascript" SRC="../elements/calendar-setup.js"></SCRIPT>
+
+<%= $pkgnum %>: <%= $part_pkg->pkg. ' - '. $part_pkg->comment %>
+
+<FORM NAME="formname" ACTION="process/expire_pkg.cgi" METHOD="post">
+<INPUT TYPE="hidden" NAME="pkgnum" VALUE="<%= $pkgnum %>">
+<TABLE>
+ <TR>
+ <TD>Cancel package on </TD>
+ <TD><INPUT TYPE="text" NAME="date" ID="expire_date" VALUE="<%= $date %>">
+ <IMG SRC="<%= $p %>images/calendar.png" ID="expire_button" STYLE="cursor:pointer" TITLE="Select date">
+ <BR><I>m/d/y</I>
+ </TD>
+ </TR>
+</TABLE>
+
+<SCRIPT TYPE="text/javascript">
+ Calendar.setup({
+ inputField: "expire_date",
+ ifFormat: "%m/%d/%Y",
+ button: "expire_button",
+ align: "BR"
+ });
+</SCRIPT>
+
+<INPUT TYPE="submit" VALUE="Cancel later">
+</FORM>
+</BODY>
+</HTML>
my %link_field = (
'svc_acct' => 'username',
'svc_domain' => 'domain',
- 'svc_acct_sm' => '',
- 'svc_charge' => '',
- 'svc_wo' => '',
+);
+
+my %link_field2 = (
+ 'svc_acct' => { label => 'Domain',
+ field => 'domsvc',
+ type => 'select',
+ select_table => 'svc_domain',
+ select_key => 'svcnum',
+ select_label => 'domain'
+ },
);
my($query) = $cgi->keywords;
my $svc = $part_svc->getfield('svc');
my $svcdb = $part_svc->getfield('svcdb');
my $link_field = $link_field{$svcdb};
+my $link_field2 = $link_field2{$svcdb};
+
+%>
-print header("Link to existing $svc"),
- qq!<FORM ACTION="!, popurl(1), qq!process/link.cgi" METHOD=POST>!;
+<%= header("Link to existing $svc") %>
+<FORM ACTION="<%= popurl(1) %>process/link.cgi" METHOD=POST>
-if ( $link_field ) {
- print <<END;
+<% if ( $link_field ) { %>
<INPUT TYPE="hidden" NAME="svcnum" VALUE="">
- <INPUT TYPE="hidden" NAME="link_field" VALUE="$link_field">
- $link_field of existing service: <INPUT TYPE="text" NAME="link_value">
-END
-} else {
- print qq!Service # of existing service: <INPUT TYPE="text" NAME="svcnum" VALUE="">!;
-}
+ <INPUT TYPE="hidden" NAME="link_field" VALUE="<%= $link_field %>">
+ <%= $link_field %> of existing service: <INPUT TYPE="text" NAME="link_value">
+ <BR>
+ <% if ( $link_field2 ) { %>
+ <INPUT TYPE="hidden" NAME="link_field2" VALUE="<%= $link_field2->{field} %>">
+ <%= $link_field2->{'label'} %> of existing service:
+ <% if ( $link_field2->{'type'} eq 'select' ) { %>
+ <% if ( $link_field2->{'select_table'} ) { %>
+ <SELECT NAME="link_value2">
+ <OPTION> </OPTION>
+ <% foreach my $r ( qsearch( $link_field2->{'select_table'}, {})) { %>
+ <% my $key = $link_field2->{'select_key'}; %>
+ <% my $label = $link_field2->{'select_label'}; %>
+ <OPTION VALUE="<%= $r->$key() %>"><%= $r->$label() %></OPTION>
+ <% } %>
+ </SELECT>
+ <% } else { %>
+ Don't know how to process secondary link field for <%= $svcdb %>
+ (type=>select but no select_table)
+ <% } %>
+ <% } else { %>
+ Don't know how to process secondary link field for <%= $svcdb %>
+ (unknown type <%= $link_field2->{'type'} %>)
+ <% } %>
+ <BR>
+ <% } %>
+<% } else { %>
+ Service # of existing service: <INPUT TYPE="text" NAME="svcnum" VALUE="">
+<% } %>
-print <<END;
-<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
-<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
-<P><CENTER><INPUT TYPE="submit" VALUE="Link"></CENTER>
+<INPUT TYPE="hidden" NAME="pkgnum" VALUE="<%= $pkgnum %>">
+<INPUT TYPE="hidden" NAME="svcpart" VALUE="<%= $svcpart %>">
+<BR><INPUT TYPE="submit" VALUE="Link">
</FORM>
</BODY>
</HTML>
-END
-
-%>
my $custnum = $cust_bill->getfield('custnum');
-print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum#history");
+print $cgi->redirect("${p}view/cust_main.cgi?$custnum");
%>
--- /dev/null
+<%
+
+#untaint date & pkgnum
+
+my $date;
+if ( $cgi->param('date') ) {
+ str2time($cgi->param('date')) =~ /^(\d+)$/ or die "Illegal date";
+ $date=$1;
+} else {
+ $date='';
+}
+
+$cgi->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum";
+my $pkgnum = $1;
+
+my $cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+my %hash = $cust_pkg->hash;
+$hash{expire}=$date;
+my $new = new FS::cust_pkg ( \%hash );
+my $error = $new->replace($cust_pkg);
+&eidiot($error) if $error;
+
+print $cgi->redirect(popurl(3). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+
+%>
my $svcdb = $part_svc->getfield('svcdb');
$cgi->param('link_field') =~ /^(\w+)$/;
my $link_field = $1;
+ my %search = ( $link_field => $cgi->param('link_value') );
+ if ( $cgi->param('link_field2') =~ /^(\w+)$/ ) {
+ $search{$1} = $cgi->param('link_value2');
+ }
my $svc_x = ( grep { $_->cust_svc->svcpart == $svcpart }
- qsearch( $svcdb, { $link_field => $cgi->param('link_value') })
+ qsearch( $svcdb, \%search )
)[0];
eidiot("$link_field not found!") unless $svc_x;
$svcnum = $svc_x->svcnum;
my $old = qsearchs('cust_svc',{'svcnum'=>$svcnum});
die "svcnum not found!" unless $old;
-#die "svcnum $svcnum already linked to package ". $old->pkgnum if $old->pkgnum;
-my $new = new FS::cust_svc ({
- 'svcnum' => $svcnum,
- 'pkgnum' => $pkgnum,
- 'svcpart' => $svcpart,
-});
+my $conf = new FS::Conf;
+my($error, $new);
+if ( $old->pkgnum && ! $conf->exists('legacy_link-steal') ) {
+ $error = "svcnum $svcnum already linked to package ". $old->pkgnum;
+} else {
+ $new = new FS::cust_svc ({
+ 'svcnum' => $svcnum,
+ 'pkgnum' => $pkgnum,
+ 'svcpart' => $svcpart,
+ });
-my $error = $new->replace($old);
+ $error = $new->replace($old);
+}
unless ($error) {
#no errors, so let's view this customer.
- print $cgi->redirect(popurl(3). "view/cust_pkg.cgi?$pkgnum");
+ my $custnum = $new->cust_pkg->custnum;
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum".
+ "#cust_pkg$pkgnum" );
} else {
%>
<!-- mason kludge -->
--- /dev/null
+<%
+
+#untaint crednum
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal crednum";
+my $crednum = $1;
+
+my $cust_credit = qsearchs('cust_credit', { 'crednum' => $crednum } );
+my $custnum = $cust_credit->custnum;
+
+foreach my $cust_credit_bill ( $cust_credit->cust_credit_bill ) {
+ my $error = $cust_credit_bill->delete;
+ eidiot($error) if $error;
+}
+
+print $cgi->redirect($p. "view/cust_main.cgi?". $custnum);
+
+%>
my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
die "Unknown svcnum!" unless $cust_svc;
-#&eidiot(qq!This account has already been audited. Cancel the
-# <A HREF="!. popurl(2). qq!view/cust_pkg.cgi?! . $cust_svc->getfield('pkgnum') .
-# qq!pkgnum"> package</A> instead.!)
-# if $cust_svc->pkgnum ne '' && $cust_svc->pkgnum ne '0';
my $custnum = $cust_svc->cust_pkg->custnum;
my $fh = $cgi->upload('batch_results');
my $filename = $cgi->param('batch_results');
- $filename =~ /^.*[\/\\]([^\/\\]+)$/ or die;
- my $paybatch = $1;
+ $filename =~ /^(.*[\/\\])?([^\/\\]+)$/
+ or die "unparsable filename: $filename\n";
+ my $paybatch = $2;
my $error = defined($fh)
? FS::cust_pay_batch::import_results( {
--- /dev/null
+<%
+ my $svcnum = $cgi->param('svcnum');
+ my $custnum = $cgi->param('custnum');
+ my $domain = $cgi->param('domain');
+
+%>
+<%= header("Whois $domain", menubar(
+ ( $custnum
+ ? ( "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
+ )
+ : ()
+ ),
+ "View this domain (#$svcnum)" => "${p}view/svc_domain.cgi?$svcnum",
+ "Main menu" => $p,
+)) %>
+<% my $whois = eval { whois($domain) };
+ if ( $@ ) {
+ ( $whois = $@ ) =~ s/ at \/.*Net\/Whois\/Raw\.pm line \d+.*$//s;
+ } else {
+ $whois =~ s/^\n+//;
+ }
+%>
+<PRE><%= $whois %></PRE>
+</BODY>
+</HTML>
my $view = popurl(2). "view/cust_bill.cgi?$invnum";
print <<END;
<TR>
- <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$invnum</FONT></A></TD>
- <TD ROWSPAN=$rowspan ALIGN="right"><A HREF="$view"><FONT SIZE=-1>\$$owed</FONT></A></TD>
- <TD ROWSPAN=$rowspan ALIGN="right"><A HREF="$view"><FONT SIZE=-1>\$$charged</FONT></A></TD>
- <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$pdate</FONT></A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="$view">$invnum</A></TD>
+ <TD ROWSPAN=$rowspan ALIGN="right"><A HREF="$view">\$$owed</A></TD>
+ <TD ROWSPAN=$rowspan ALIGN="right"><A HREF="$view">\$$charged</A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="$view">$pdate</A></TD>
END
my $custnum = $cust_bill->custnum;
my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } );
$cust_main->company,
);
print <<END;
- <TD ROWSPAN=$rowspan><A HREF="$cview"><FONT SIZE=-1>$name</FONT></A></TD>
- <TD ROWSPAN=$rowspan><A HREF="$cview"><FONT SIZE=-1>$company</FONT></A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="$cview">$name</A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="$cview">$company</A></TD>
END
} else {
print <<END
$tot_balance = sprintf("%.2f", $tot_balance);
$tot_amount = sprintf("%.2f", $tot_amount);
print "</TABLE>$pager<BR>". table(). <<END;
- <TR><TD> </TD><TH><FONT SIZE=-1>Total<BR>Balance</FONT></TH><TH><FONT SIZE=-1>Total<BR>Amount</FONT></TH></TR>
- <TR><TD></TD><TD ALIGN="right"><FONT SIZE=-1>\$$tot_balance</FONT></TD><TD ALIGN="right"><FONT SIZE=-1>\$$tot_amount</FONT></TD></TD></TR>
+ <TR><TD> </TD><TH>Total<BR>Balance</TH><TH>Total<BR>Amount</TH></TR>
+ <TR><TD></TD><TD ALIGN="right">\$$tot_balance</TD><TD ALIGN="right">\$$tot_amount</TD></TD></TR>
</TABLE>
</BODY>
</HTML>
my $beginning = str2time($1) || 0;
$cgi->param('ending') =~ /^([ 0-9\-\/]{0,10})$/;
-my $ending = str2time($1) + 86400;
+my $ending = str2time($1) + 86399;
my @cust_bill_event =
sort { $a->_date <=> $b->_date }
<FORM ACTION="cust_main.cgi" METHOD="post">
Search for <B>Order taker</B>:
<INPUT TYPE="hidden" NAME="otaker_on" VALUE="TRUE">
- <% my $dbh = dbh;
- my $sth = dbh->prepare("SELECT DISTINCT otaker FROM cust_main")
- or eidiot $dbh->errstr;
- $sth->execute() or eidiot $sth->errstr;
+ <% my $sth = dbh->prepare("SELECT DISTINCT otaker FROM cust_main")
+ or die dbh->errstr;
+ $sth->execute() or die $sth->errstr;
# my @otakers = map { $_->[0] } @{$sth->selectall_arrayref};
%>
<SELECT NAME="otaker">
<INPUT TYPE="checkbox" NAME="last_on" CHECKED> Search for <B>last name</B>:
<INPUT TYPE="text" NAME="last_text">
using search method: <SELECT NAME="last_type">
- <OPTION>All
+ <OPTION SELECTED>All
<OPTION>Fuzzy
<OPTION>Substring
- <OPTION SELECTED>Exact
+ <OPTION>Exact
</SELECT>
<P><INPUT TYPE="checkbox" NAME="company_on" CHECKED> Search for <B>company</B>:
<INPUT TYPE="text" NAME="company_text">
- using search methods: <SELECT NAME="company_type">
- <OPTION>All
+ using search method: <SELECT NAME="company_type">
+ <OPTION SELECTED>All
<OPTION>Fuzzy
<OPTION>Substring
- <OPTION SELECTED>Exact
+ <OPTION>Exact
</SELECT>
<P><INPUT TYPE="submit" VALUE="Search">
my $pkg = $part_pkg->pkg;
my $comment = $part_pkg->comment;
- my $pkgview = $p. 'view/cust_pkg.cgi?'. $pkgnum;
+ my $pkgview = "${p}view/cust_main.cgi?$custnum#cust_pkg$pkgnum";
my @cust_svc = @{shift @lol_cust_svc};
#my(@cust_svc) = qsearch( 'cust_svc', { 'pkgnum' => $_->pkgnum } );
my $rowspan = scalar(@cust_svc) || 1;
}
if ( $cgi->param('ending')
&& $cgi->param('ending') =~ /^([ 0-9\-\/]{0,10})$/ ) {
- my $ending = str2time($1) + 86400;
+ my $ending = str2time($1) + 86399;
push @search, " _date <= $ending ";
}
my $search;
}
if ( $cgi->param('ending')
&& $cgi->param('ending') =~ /^([ 0-9\-\/]{0,10})$/ ) {
- my $ending = str2time($1) + 86400;
+ my $ending = str2time($1) + 86399;
$range .= ( $range ? ' AND ' : ' WHERE ' ). " bill <= $ending ";
}
}
if ( scalar(@cust_pkg) == 1 ) {
- my($pkgnum)=$cust_pkg[0]->pkgnum;
- print $cgi->redirect(popurl(2). "view/cust_pkg.cgi?$pkgnum");
+ print $cgi->redirect("${p}view/cust_main.cgi?". $cust_pkg[0]->custnum.
+ "#cust_pkg". $cust_pkg[0]->pkgnum );
#exit;
} elsif ( scalar(@cust_pkg) == 0 ) { #error
%>
my $rowspan = scalar(@cust_svc) || 1;
my $p = popurl(2);
print $n1, <<END;
- <TD ROWSPAN=$rowspan><A HREF="${p}view/cust_pkg.cgi?$pkgnum"><FONT SIZE=-1>$pkgnum - $pkg</FONT></A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="${p}view/cust_main.cgi?$custnum#cust_pkg$pkgnum"><FONT SIZE=-1>$pkgnum - $pkg</FONT></A></TD>
<TD ROWSPAN=$rowspan>$setup</TD>
END
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Payment report criteria</TITLE>
+ <LINK REL="stylesheet" TYPE="text/css" HREF="../elements/calendar-win2k-2.css" TITLE="win2k-2">
+ <SCRIPT TYPE="text/javascript" SRC="../elements/calendar_stripped.js"></SCRIPT>
+ <SCRIPT TYPE="text/javascript" SRC="../elements/calendar-en.js"></SCRIPT>
+ <SCRIPT TYPE="text/javascript" SRC="../elements/calendar-setup.js"></SCRIPT>
+ </HEAD>
+ <BODY BGCOLOR="#e8e8e8">
+ <H1>Payment report criteria</H1>
+ <FORM ACTION="cust_pay.cgi" METHOD="post">
+ <INPUT TYPE="hidden" NAME="magic" VALUE="_date">
+ <TABLE>
+ <TR>
+ <TD ALIGN="right">Payments of type: </TD>
+ <TD><SELECT NAME="payby">
+ <OPTION VALUE="">all</OPTION>
+ <OPTION VALUE="CARD">credit card (all)</OPTION>
+ <OPTION VALUE="CARD-VisaMC">credit card (Visa/MasterCard)</OPTION>
+ <OPTION VALUE="CARD-Amex">credit card (American Express)</OPTION>
+ <OPTION VALUE="CARD-Discover">credit card (Discover)</OPTION>
+ <OPTION VALUE="CHEK">electronic check / ACH</OPTION>
+ <OPTION VALUE="BILL">check / cash</OPTION>
+ </SELECT>
+ </TD>
+ </TR>
+ <TR>
+ <TD ALIGN="right">From: </TD>
+ <TD><INPUT TYPE="text" NAME="beginning" ID="beginning_text" VALUE="" SIZE=11 MAXLENGTH=10> <IMG SRC="../images/calendar.png" ID="beginning_button" STYLE="cursor: pointer" TITLE="Select date"><BR><i>m/d/y</i></TD>
+<SCRIPT TYPE="text/javascript">
+ Calendar.setup({
+ inputField: "beginning_text",
+ ifFormat: "%m/%d/%Y",
+ button: "beginning_button",
+ align: "BR"
+ });
+</SCRIPT>
+ </TR>
+ <TD ALIGN="right">To: </TD>
+ <TD><INPUT TYPE="text" NAME="ending" ID="ending_text" VALUE="" SIZE=11 MAXLENGTH=10> <IMG SRC="../images/calendar.png" ID="ending_button" STYLE="cursor: pointer" TITLE="Select date"><BR><i>m/d/y</i></TD>
+<SCRIPT TYPE="text/javascript">
+ Calendar.setup({
+ inputField: "ending_text",
+ ifFormat: "%m/%d/%Y",
+ button: "ending_button",
+ align: "BR"
+ });
+</SCRIPT>
+ </TR>
+ </TABLE>
+ <BR><INPUT TYPE="submit" VALUE="Get Report">
+ </FORM>
+ </BODY>
+</HTML>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+ #doesn't yet deal with daily/weekly packages
+
+ #needs to be re-written in sql for efficiency
+
+ my $time = time;
+
+ my $now = $cgi->param('date') && str2time($cgi->param('date')) || $time;
+ $now =~ /^(\d+)$/ or die "unparsable date?";
+ $now = $1;
+
+ my( $total, $total_legacy ) = ( 0, 0 );
+
+ my @cust_bill_pkg =
+ grep { $_->cust_pkg && $_->cust_pkg->part_pkg->freq !~ /^([01]|\d+[dw])$/ }
+ qsearch( 'cust_bill_pkg', {
+ 'recur' => { op=>'!=', value=>0 },
+ 'edate' => { op=>'>', value=>$now },
+ }, );
+
+ my @cust_pkg =
+ grep { $_->part_pkg->recur != 0
+ && $_->part_pkg->freq !~ /^([01]|\d+[dw])$/
+ }
+ qsearch ( 'cust_pkg', {
+ 'bill' => { op=>'>', value=>$now }
+ } );
+
+ foreach my $cust_bill_pkg ( @cust_bill_pkg) {
+ my $period = $cust_bill_pkg->edate - $cust_bill_pkg->sdate;
+
+ my $elapsed = $now - $cust_bill_pkg->sdate;
+ $elapsed = 0 if $elapsed < 0;
+
+ my $remaining = 1 - $elapsed/$period;
+
+ my $unearned = $remaining * $cust_bill_pkg->recur;
+ $total += $unearned;
+
+ }
+
+ foreach my $cust_pkg ( @cust_pkg ) {
+ my $period = $cust_pkg->bill - $cust_pkg->last_bill;
+
+ my $elapsed = $now - $cust_pkg->last_bill;
+ $elapsed = 0 if $elapsed < 0;
+
+ my $remaining = 1 - $elapsed/$period;
+
+ my $unearned = $remaining * $cust_pkg->part_pkg->recur; #!! only works for flat/legacy
+ $total_legacy += $unearned;
+
+ }
+
+ $total = sprintf('%.2f', $total);
+ $total_legacy = sprintf('%.2f', $total_legacy);
+
+%>
+
+<%= header( 'Prepaid Income (Unearned Revenue) Report',
+ menubar( 'Main Menu'=>$p, ) ) %>
+<%= table() %>
+ <TR>
+ <TH>Actual Unearned Revenue</TH>
+ <TH>Legacy Unearned Revenue</TH>
+ </TR>
+ <TR>
+ <TD ALIGN="right">$<%= $total %>
+ <TD ALIGN="right">
+ <%= $now == $time ? "\$$total_legacy" : '<i>N/A</i>'%>
+ </TD>
+ </TR>
+
+</TABLE>
+<BR>
+Actual unearned revenue is the amount of unearned revenue Freeside has
+actually invoiced for packages with longer-than monthly terms.
+<BR><BR>
+Legacy unearned revenue is the amount of unearned revenue represented by
+customer packages. This number may be larger than actual unearned
+revenue if you have imported longer-than monthly customer packages from
+a previous billing system.
+</BODY>
+</HTML>
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Prepaid Income (Unearned Revenue) Report</TITLE>
+ <LINK REL="stylesheet" TYPE="text/css" HREF="../elements/calendar-win2k-2.css" TITLE="win2k-2">
+ <SCRIPT TYPE="text/javascript" SRC="../elements/calendar_stripped.js"></SCRIPT>
+ <SCRIPT TYPE="text/javascript" SRC="../elements/calendar-en.js"></SCRIPT>
+ <SCRIPT TYPE="text/javascript" SRC="../elements/calendar-setup.js"></SCRIPT>
+ </HEAD>
+ <BODY BGCOLOR="#e8e8e8">
+ <H1>Prepaid Income (Unearned Revenue) Report</H1>
+ <FORM ACTION="report_prepaid_income.cgi" METHOD="post">
+ <TABLE>
+ <TR>
+ <TD>Prepaid income (unearned revenue) as of </TD>
+ <TD>
+ <INPUT TYPE="text" NAME="date" ID="date_text" VALUE="now">
+ <IMG SRC="../images/calendar.png" ID="date_button" STYLE="cursor: pointer" TITLE="Select date">
+ </TD>
+ </TR>
+ <TR>
+ <TD>
+ </TD>
+ <TD><i>m/d/y</i></TD>
+ </TR>
+ </TABLE>
+<SCRIPT TYPE="text/javascript">
+ Calendar.setup({
+ inputField: "date_text",
+ ifFormat: "%m/%d/%Y",
+ button: "date_button",
+ align: "BR"
+ });
+</SCRIPT>
+
+ <INPUT TYPE="submit" VALUE="Generate report">
+ </BODY>
+</HTML>
+ <TABLE>
+
,0
)
-order by lower(company), lower(last)
+order by coalesce(lower(company), ''), lower(last)
END
<!-- mason kludge -->
<%
-#my $user = getotaker;
-my $user = $FS::UID::user; #dumb 1.4 8-char workaround
+my $user = getotaker;
$cgi->param('beginning') =~ /^([ 0-9\-\/]{0,10})$/;
-my $beginning = $1;
+my $pbeginning = $1;
+my $beginning = $1 ? str2time($1) : 0;
$cgi->param('ending') =~ /^([ 0-9\-\/]{0,10})$/;
-my $ending = $1;
+my $pending = $1;
+my $ending = ( $1 ? str2time($1) : 4294880896 ) + 86399;
-print header('Tax Report Results');
+my $from_join_cust = "
+ FROM cust_bill_pkg
+ JOIN cust_bill USING ( invnum )
+ JOIN cust_main USING ( custnum )
+";
+my $join_pkg = "
+ JOIN cust_pkg USING ( pkgnum )
+ JOIN part_pkg USING ( pkgpart )
+";
+my $where = "
+ WHERE _date >= $beginning AND _date <= $ending
+ AND ( county = ? OR ? = '' )
+ AND ( state = ? OR ? = '' )
+ AND ( country = ? )
+ AND payby != 'COMP'
+";
+my @base_param = qw( county county state state country );
-open (REPORT, "freeside-tax-report -v -s $beginning -f $ending $user |");
+my $gotcust = "
+ WHERE 0 < ( SELECT COUNT(*) FROM cust_main
+ WHERE ( cust_main.county = cust_main_county.county
+ OR cust_main_county.county = ''
+ OR cust_main_county.county IS NULL )
+ AND ( cust_main.state = cust_main_county.state
+ OR cust_main_county.state = ''
+ OR cust_main_county.state IS NULL )
+ AND ( cust_main.country = cust_main_county.country )
+ LIMIT 1
+ )
+";
-print '<PRE>';
-while(<REPORT>) {
- print $_;
+my $monthly_exempt_warning = 0;
+my($total, $exempt, $taxable, $owed, $tax) = ( 0, 0, 0, 0, 0 );
+my $out = 'Out of taxable region(s)';
+my %regions;
+foreach my $r (qsearch('cust_main_county', {}, '', $gotcust) ) {
+ #warn $r->county. ' '. $r->state. ' '. $r->country. "\n";
+
+ my $label = getlabel($r);
+ $regions{$label}->{'label'} = $label;
+
+ my $fromwhere = $from_join_cust. $join_pkg. $where;
+ my @param = @base_param;
+
+ if ( $r->taxclass ) {
+ $fromwhere .= " AND ( taxclass = ? ) ";
+ push @param, 'taxclass';
+ }
+
+ my $nottax = 'pkgnum != 0';
+
+ my $a = scalar_sql($r, \@param,
+ "SELECT SUM(cust_bill_pkg.setup+cust_bill_pkg.recur) $fromwhere AND $nottax"
+ );
+ $total += $a;
+ $regions{$label}->{'total'} += $a;
+
+ foreach my $e ( grep { $r->get($_.'tax') =~ /^Y/i }
+ qw( cust_bill_pkg.setup cust_bill_pkg.recur ) ) {
+ my $x = scalar_sql($r, \@param,
+ "SELECT SUM($e) $fromwhere AND $nottax"
+ );
+ $exempt += $x;
+ $regions{$label}->{'exempt'} += $x;
+ }
+
+ my($t, $x) = (0, 0);
+ foreach my $e ( grep { $r->get($_.'tax') !~ /^Y/i }
+ qw( cust_bill_pkg.setup cust_bill_pkg.recur ) ) {
+ $t += scalar_sql($r, \@param,
+ "SELECT SUM($e) $fromwhere AND $nottax AND ( tax != 'Y' OR tax IS NULL )"
+ );
+
+ $x += scalar_sql($r, \@param,
+ "SELECT SUM($e) $fromwhere AND $nottax AND tax = 'Y'"
+ );
+ }
+
+ my($sday,$smon,$syear) = (localtime($beginning) )[ 3, 4, 5 ];
+ $monthly_exempt_warning=1 if $sday != 1 && $beginning;
+ $smon++; $syear+=1900;
+
+ my $eending = ( $ending == 4294967295 ) ? time : $ending;
+ my($eday,$emon,$eyear) = (localtime($eending) )[ 3, 4, 5 ];
+ $emon++; $eyear+=1900;
+
+ my $monthly_exemption = scalar_sql($r, [ 'taxnum' ],
+ "SELECT SUM(amount) FROM cust_tax_exempt where taxnum = ? ".
+ " AND ( year > $syear OR ( year = $syear and month >= $smon ) )".
+ " AND ( year < $eyear OR ( year = $eyear and month <= $emon ) )"
+ );
+ #warn $r->taxnum(). ": $monthly_exemption\n";
+ if ( $monthly_exemption ) {
+ $t -= $monthly_exemption;
+ $x += $monthly_exemption;
+ }
+
+ $taxable += $t;
+ $regions{$label}->{'taxable'} += $t;
+
+ $exempt += $x;
+ $regions{$label}->{'exempt'} += $x;
+
+ $owed += $t * ($r->tax/100);
+ $regions{$label}->{'owed'} += $t * ($r->tax/100);
+
+ if ( defined($regions{$label}->{'rate'})
+ && $regions{$label}->{'rate'} != $r->tax.'%' ) {
+ $regions{$label}->{'rate'} = 'variable';
+ } else {
+ $regions{$label}->{'rate'} = $r->tax.'%';
+ }
+
+}
+
+my $taxwhere = "$from_join_cust $where";
+my @taxparam = @base_param;
+
+#foreach my $label ( keys %regions ) {
+foreach my $r (
+ qsearch( 'cust_main_county',
+ {},
+ 'DISTINCT ON (country, state, county, taxname) *',
+ $gotcust
+ )
+) {
+
+ #warn join('-', map { $r->$_() } qw( country state county taxname ) )."\n";
+
+ my $label = getlabel($r);
+
+ my $fromwhere = $join_pkg. $where;
+ my @param = @base_param;
+
+ #match itemdesc if necessary!
+ my $named_tax =
+ $r->taxname
+ ? 'AND itemdesc = '. dbh->quote($r->taxname)
+ : "AND ( itemdesc IS NULL OR itemdesc = '' OR itemdesc = 'Tax' )";
+ my $x = scalar_sql($r, \@taxparam,
+ "SELECT SUM(cust_bill_pkg.setup+cust_bill_pkg.recur) $taxwhere ".
+ "AND pkgnum = 0 $named_tax",
+ );
+ $tax += $x;
+ $regions{$label}->{'tax'} += $x;
+
+}
+
+#ordering
+my @regions = map $regions{$_},
+ sort { ( ($a eq $out) cmp ($b eq $out) ) || ($b cmp $a) }
+ keys %regions;
+
+push @regions, {
+ 'label' => 'Total',
+ 'total' => $total,
+ 'exempt' => $exempt,
+ 'taxable' => $taxable,
+ 'rate' => '',
+ 'owed' => $owed,
+ 'tax' => $tax,
+};
+
+#--
+
+sub getlabel {
+ my $r = shift;
+
+ my $label;
+ if ( $r->tax == 0 ) {
+ #kludge to avoid "will not stay shared" warning
+ my $out = 'Out of taxable region(s)';
+ $label = $out;
+ } elsif ( $r->taxname ) {
+ $label = $r->taxname;
+# $regions{$label}->{'taxname'} = $label;
+# push @{$regions{$label}->{$_}}, $r->$_() foreach qw( county state country );
+ } else {
+ $label = $r->country;
+ $label = $r->state.", $label" if $r->state;
+ $label = $r->county." county, $label" if $r->county;
+ #$label = $r->taxname. " ($label)" if $r->taxname;
+ }
+ return $label;
}
-print '</PRE>';
-print '</BODY></HTML>';
+#false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
+#to FS::Report or FS::Record or who the fuck knows where)
+sub scalar_sql {
+ my( $r, $param, $sql ) = @_;
+ #warn "$sql\n";
+ my $sth = dbh->prepare($sql) or die dbh->errstr;
+ $sth->execute( map $r->$_(), @$param )
+ or die "Unexpected error executing statement $sql: ". $sth->errstr;
+ $sth->fetchrow_arrayref->[0] || 0;
+}
%>
+<%= header( "Sales Tax Report - $pbeginning through ".($pending||'now'),
+ menubar( 'Main Menu'=>$p, ) ) %>
+<%= table() %>
+ <TR>
+ <TH ROWSPAN=2></TH>
+ <TH COLSPAN=3>Sales</TH>
+ <TH ROWSPAN=2>Rate</TH>
+ <TH ROWSPAN=2>Tax owed</TH>
+ <TH ROWSPAN=2>Tax invoiced</TH>
+ </TR>
+ <TR>
+ <TH>Total</TH>
+ <TH>Non-taxable</TH>
+ <TH>Taxable</TH>
+ </TR>
+ <% foreach my $region ( @regions ) { %>
+ <TR>
+ <TD><%= $region->{'label'} %></TD>
+ <TD ALIGN="right">$<%= sprintf('%.2f', $region->{'total'} ) %></TD>
+ <TD ALIGN="right">$<%= sprintf('%.2f', $region->{'exempt'} ) %></TD>
+ <TD ALIGN="right">$<%= sprintf('%.2f', $region->{'taxable'} ) %></TD>
+ <TD ALIGN="right"><%= $region->{'rate'} %></TD>
+ <TD ALIGN="right">$<%= sprintf('%.2f', $region->{'owed'} ) %></TD>
+ <TD ALIGN="right">$<%= sprintf('%.2f', $region->{'tax'} ) %></TD>
+ </TR>
+ <% } %>
+
+</TABLE>
+
+<% if ( $monthly_exempt_warning ) { %>
+ <BR>
+ Partial-month tax reports (except for current month) may not be correct due
+ to month-granularity tax exemption (usually "texas tax"). For an accurate
+ report, start on the first of a month and end on the last day of a month (or
+ leave blank for to now).
+<% } %>
+
+</BODY>
+</HTML>
+
+
$orderby = "ORDER BY ${tblname}username";
} elsif ( $query eq 'uid' ) {
$sortby=\*uid_sort;
- $orderby = ( $unlinked ? 'AND' : 'WHERE' ).
+ $orderby = ( $unlinked ? ' AND' : ' WHERE' ).
" ${tblname}uid IS NOT NULL ORDER BY ${tblname}uid";
} elsif ( $cgi->param('popnum') =~ /^(\d+)$/ ) {
$unlinked .= ( $unlinked ? 'AND' : 'WHERE' ).
" popnum = $1";
$sortby=\*username_sort;
$orderby = "ORDER BY ${tblname}username";
+} elsif ( $cgi->param('svcpart') =~ /^(\d+)$/ ) {
+ $unlinked .= ( $unlinked ? ' AND' : ' WHERE' ).
+ " $1 = ( SELECT svcpart FROM cust_svc ".
+ " WHERE cust_svc.svcnum = svc_acct.svcnum ) ";
+ $sortby=\*uid_sort;
+ #$sortby=\*svcnum_sort;
} else {
$sortby=\*uid_sort;
@svc_acct = @{&usernamesearch};
|| $query eq 'username'
|| $query eq 'uid'
|| $cgi->param('popnum') =~ /^(\d+)$/
+ || $cgi->param('svcpart') =~ /^(\d+)$/
) {
my $statement = "SELECT COUNT(*) FROM svc_acct $unlinked";
'svcnum' => $_->svcnum,
'pkgnum' => '',
}), qsearch('svc_domain',{});
+} elsif ( $cgi->param('svcpart') =~ /^(\d+)$/ ) {
+ @svc_domain =
+ qsearch( 'svc_domain', {}, '',
+ " WHERE $1 = ( SELECT svcpart FROM cust_svc ".
+ " WHERE cust_svc.svcnum = svc_domain.svcnum ) "
+ );
+ $sortby=\*svcnum_sort;
} else {
$cgi->param('domain') =~ /^([\w\-\.]+)$/;
my($domain)=$1;
--- /dev/null
+<%
+
+my $conf = new FS::Conf;
+
+my($query)=$cgi->keywords;
+$query ||= ''; #to avoid use of unitialized value errors
+my(@svc_forward,$sortby);
+if ( $query eq 'svcnum' ) {
+ $sortby=\*svcnum_sort;
+ @svc_forward=qsearch('svc_forward',{});
+} else {
+ eidiot('unimplemented');
+}
+
+if ( scalar(@svc_forward) == 1 ) {
+ print $cgi->redirect(popurl(2). "view/svc_forward.cgi?". $svc_forward[0]->svcnum);
+ #exit;
+} elsif ( scalar(@svc_forward) == 0 ) {
+%>
+<!-- mason kludge -->
+<%
+ eidiot "No matching forwards found!\n";
+} else {
+%>
+<!-- mason kludge -->
+<%
+ my $total = scalar(@svc_forward);
+ print header("Mail forward Search Results",''), <<END;
+
+ $total matching mail forwards found
+ <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
+ <TR>
+ <TH>Service #<BR><FONT SIZE=-1>(click to view forward)</FONT></TH>
+ <TH>Mail to<BR><FONT SIZE=-1>(click to view account)</FONT></TH>
+ <TH>Forwards to<BR><FONT SIZE=-1>(click to view account)</FONT></TH>
+ </TR>
+END
+
+ foreach my $svc_forward (
+ sort $sortby (@svc_forward)
+ ) {
+ my $svcnum = $svc_forward->svcnum;
+
+ my $src = $svc_forward->src;
+ $src = "<I>(anything)</I>$src" if $src =~ /^@/;
+ if ( $svc_forward->srcsvc_acct ) {
+ $src = qq!<A HREF="${p}view/svc_acct.cgi?!. $svc_forward->srcsvc. '">'.
+ $svc_forward->srcsvc_acct->email. '</A>';
+ }
+
+ my $dst = $svc_forward->dst;
+ if ( $svc_forward->dstsvc_acct ) {
+ $dst = qq!<A HREF="${p}view/svc_acct.cgi?!. $svc_forward->dstsvc. '">'.
+ $svc_forward->dstsvc_acct->email. '</A>';
+ }
+
+ print <<END;
+ <TR>
+ <TD><A HREF="${p}view/svc_forward.cgi?$svcnum">$svcnum</A></TD>
+ <TD>$src</TD>
+ <TD>$dst</TD>
+ </TR>
+END
+
+ }
+
+ print <<END;
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
+}
+
+sub svcnum_sort {
+ $a->getfield('svcnum') <=> $b->getfield('svcnum');
+}
+
+%>
--- /dev/null
+<%
+
+#untaint invnum
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)(.pdf)?$/;
+my $invnum = $1;
+
+my $cust_bill = qsearchs('cust_bill',{'invnum'=>$invnum});
+die "Invoice #$invnum not found!" unless $cust_bill;
+
+my $pdf = $cust_bill->print_pdf;
+
+http_header('Content-Type' => 'application/pdf' );
+http_header('Content-Length' => length($pdf) );
+http_header('Cache-control' => 'max-age=60' );
+%>
+<%= $pdf %>
print qq!<A HREF="${p}edit/cust_pay.cgi?$invnum">Enter payments (check/cash) against this invoice</A> | !
if $cust_bill->owed > 0;
-print qq!<A HREF="${p}misc/print-invoice.cgi?$invnum">Reprint this invoice</A>!. '<BR><BR>';
+print qq!<A HREF="${p}misc/print-invoice.cgi?$invnum">Reprint this invoice</A>!;
+if ( grep { $_ ne 'POST' } $cust_bill->cust_main->invoicing_list ) {
+ print qq! | <A HREF="${p}misc/email-invoice.cgi?$invnum">!.
+ qq!Re-email this invoice</A>!;
+}
+
+print '<BR><BR>';
-print menubar(
- 'View typeset invoice' => "${p}view/cust_bill-ps.cgi?$invnum",
-), '<BR><BR>';
+my $conf = new FS::Conf;
+if ( $conf->exists('invoice_latex') ) {
+ print menubar(
+ 'View typeset invoice' => "${p}view/cust_bill-pdf.cgi?$invnum.pdf",
+ ), '<BR><BR>';
+}
#false laziness with search/cust_bill_event.cgi
my $conf = new FS::Conf;
-#false laziness with view/cust_pkg.cgi, but i'm trying to make that go away so
my %uiview = ();
my %uiadd = ();
foreach my $part_svc ( qsearch('part_svc',{}) ) {
'Main Menu' => popurl(2)
));
-print <<END;
+%>
+
<STYLE TYPE="text/css">
.package TH { font-size: medium }
.package TR { font-size: smaller }
-.package .pkgnum { font-size: medium }
.package .provision { font-weight: bold }
</STYLE>
-END
+
+<%
die "No customer specified (bad URL)!" unless $cgi->keywords;
my($query) = $cgi->keywords; # needs parens with my, ->keywords returns array
print qq!<A HREF="${p}edit/cust_main.cgi?$custnum">Edit this customer</A>!;
-print <<END;
+%>
+
<SCRIPT>
function cancel_areyousure(href) {
if (confirm("Perminantly delete all services and cancel this customer?") == true)
window.location.href = href;
}
</SCRIPT>
-END
+
+<%
print qq! | <A HREF="javascript:cancel_areyousure('${p}misc/cust_main-cancel.cgi?$custnum')">!.
'Cancel this customer</A>'
'</PRE></TD></TR></TABLE></TABLE>';
}
-print '</TD></TR></TABLE>';
+%>
+
+</TD></TR></TABLE>
-print '<BR>'.
- '<FORM ACTION="'.popurl(2).'edit/process/quick-cust_pkg.cgi" METHOD="POST">'.
- qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!.
- '<SELECT NAME="pkgpart"><OPTION> ';
+<BR>
+<SCRIPT TYPE="text/javascript">
+function enable_order_pkg () {
+ if ( document.OrderPkgForm.pkgpart.selectedIndex > 0 ) {
+ document.OrderPkgForm.submit.disabled = false;
+ } else {
+ document.OrderPkgForm.submit.disabled = true;
+ }
+}
+</SCRIPT>
+<FORM NAME="OrderPkgForm" ACTION="<%= $p %>edit/process/quick-cust_pkg.cgi" METHOD="POST">
+<INPUT TYPE="hidden" NAME="custnum" VALUE="<%= $custnum %>">
+<SELECT NAME="pkgpart" onChange="enable_order_pkg()"><OPTION>Order additional package
+<%
foreach my $part_pkg (
qsearch( 'part_pkg', { 'disabled' => '' }, '',
' AND 0 < ( SELECT COUNT(*) FROM type_pkgs '.
' AND type_pkgs.pkgpart = part_pkg.pkgpart )'
)
) {
- print '<OPTION VALUE="'. $part_pkg->pkgpart. '">'. $part_pkg->pkg. ' - '.
- $part_pkg->comment;
-}
+%>
+<OPTION VALUE="<%= $part_pkg->pkgpart %>"><%= $part_pkg->pkg %> - <%= $part_pkg->comment %>
+<% } %>
+
+</SELECT><INPUT NAME="submit" TYPE="submit" VALUE="Order Package" disabled></FORM><BR>
-print '</SELECT><INPUT TYPE="submit" VALUE="Order Package"></FORM><BR>';
+<%
if ( $conf->config('payby-default') ne 'HIDE' ) {
- print '<BR>'.
+ print
qq!<FORM ACTION="${p}edit/process/quick-charge.cgi" METHOD="POST">!.
qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!.
qq!Description:<INPUT TYPE="text" NAME="pkg">!.
}
-print <<END;
+%>
+
<SCRIPT>
function cust_pkg_areyousure(href) {
if (confirm("Permanently delete included services and cancel this package?") == true)
window.location.href = href;
}
</SCRIPT>
-END
-print qq!<BR><A NAME="cust_pkg">Packages</A> !,
-# qq!<BR>Click on package number to view/edit package.!,
+<%
+
+print qq!<A NAME="cust_pkg">Packages</A> !,
qq!( <A HREF="!, popurl(2), qq!edit/cust_pkg.cgi?$custnum">Order and cancel packages</A> (preserves services) )!,
;
%>
<TABLE CLASS="package" BORDER=1 CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999">
<TR>
- <TH COLSPAN=2>Package</TH>
+ <TH>Package</TH>
<TH>Status</TH>
<TH COLSPAN=2>Services</TH>
</TR>
%>
<!--pkgnum: <%=$pkg->{pkgnum}%>-->
<TR>
- <TD ROWSPAN=<%=$rowspan%> CLASS="pkgnum"><%=$pkg->{pkgnum}%></TD>
<TD ROWSPAN=<%=$rowspan%>>
- <%=$pkg->{pkg}%> - <%=$pkg->{comment}%> ( <%=pkg_details_link($pkg)%> )<BR>
+ <A NAME="cust_pkg<%=$pkg->{pkgnum}%>"><%=$pkg->{pkgnum}%></A>:
+ <%=$pkg->{pkg}%> - <%=$pkg->{comment}%><BR>
<% unless ($pkg->{cancel}) { %>
( <%=pkg_change_link($pkg)%> )
( <%=pkg_dates_link($pkg)%> | <%=pkg_customize_link($pkg,$custnum)%> )
}
if ($svcpart->{count} < $svcpart->{quantity}) {
print qq!<TR>\n! if ($cnt > 0);
- print qq! <TD COLSPAN=2>!.svc_provision_link($pkg,$svcpart).qq!</TD>\n</TR>\n!;
+ print qq! <TD COLSPAN=2>!.svc_provision_link($pkg, $svcpart, $conf).qq!</TD>\n</TR>\n!;
}
}
}
-print '</TABLE>'
+print '</TABLE>';
}
#end display packages
+%>
-
-print <<END;
<SCRIPT>
function cust_pay_areyousure(href) {
if (confirm("Are you sure you want to delete this payment?")
== true)
window.location.href = href;
}
+function cust_credit_unapply_areyousure(href) {
+ if (confirm("Are you sure you want to unapply this credit?")
+ == true)
+ window.location.href = href;
+}
function cust_credit_areyousure(href) {
if (confirm("Are you sure you want to delete this credit?")
== true)
window.location.href = href;
}
</SCRIPT>
-END
-if ( $conf->config('payby-default') ne 'HIDE' ) {
-
- #formatting
- print qq!<BR><BR><A NAME="history">Payment History!.
- qq!</A> ( !.
- qq!<A HREF="!. popurl(2). qq!edit/cust_pay.cgi?custnum=$custnum">!.
- qq!Post payment</A> | !.
- qq!<A HREF="!. popurl(2). qq!edit/cust_credit.cgi?$custnum">!.
- qq!Post credit</A> )!;
+<% if ( $conf->config('payby-default') ne 'HIDE' ) { %>
+ <BR><BR><A NAME="history">Payment History</A>
+ (<A HREF="<%= $p %>edit/cust_pay.cgi?custnum=<%= $custnum %>">Post payment</A>
+ | <A HREF="<%= $p %>edit/cust_credit.cgi?<%= $custnum %>">Post credit</A>)
+
+ <%
#get payment history
- #
- # major problem: this whole thing is way too sloppy.
- # minor problem: the description lines need better formatting.
-
- my @history = (); #needed for mod_perl :)
-
- my %target = ();
-
- my @bills = qsearch('cust_bill',{'custnum'=>$custnum});
- foreach my $bill (@bills) {
- my($bref)=$bill->hashref;
- my $bpre = ( $bill->owed > 0 )
- ? '<b><font size="+1" color="#ff0000"> Open '
- : '';
- my $bpost = ( $bill->owed > 0 ) ? '</font></b>' : '';
- push @history,
- $bref->{_date} . qq!\t<A HREF="!. popurl(2). qq!view/cust_bill.cgi?! .
- $bref->{invnum} . qq!">${bpre}Invoice #! . $bref->{invnum} .
- qq! (Balance \$! . $bill->owed . qq!)$bpost</A>\t! .
- $bref->{charged} . qq!\t\t\t!;
-
- my(@cust_bill_pay)=qsearch('cust_bill_pay',{'invnum'=> $bref->{invnum} } );
- # my(@payments)=qsearch('cust_pay',{'invnum'=> $bref->{invnum} } );
- # my($payment);
- foreach my $cust_bill_pay (@cust_bill_pay) {
- my $payment = $cust_bill_pay->cust_pay;
- my($date,$invnum,$payby,$payinfo,$paid)=($payment->_date,
- $cust_bill_pay->invnum,
- $payment->payby,
- $payment->payinfo,
- $cust_bill_pay->amount,
- );
- $payinfo = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4))
- if $payby eq 'CARD';
- my $target = "$payby$payinfo";
- $payby =~ s/^BILL$/Check #/ if $payinfo;
- $payby =~ s/^(CARD|COMP)$/$1 /;
- my $delete = $payment->closed !~ /^Y/i && $conf->exists('deletepayments')
- ? qq! (<A HREF="javascript:cust_pay_areyousure('${p}misc/delete-cust_pay.cgi?!. $payment->paynum. qq!')">delete</A>)!
- : '';
- my $unapply =
- $payment->closed !~ /^Y/i && $conf->exists('unapplypayments')
- ? qq! (<A HREF="javascript:cust_pay_unapply_areyousure('${p}misc/unapply-cust_pay.cgi?!. $payment->paynum. qq!')">unapply</A>)!
- : '';
- push @history,
- "$date\tPayment, Invoice #$invnum ($payby$payinfo)$delete$unapply\t\t$paid\t\t\t$target";
+ my @history = ();
+
+ #invoices
+ foreach my $cust_bill ($cust_main->cust_bill) {
+ my $pre = ( $cust_bill->owed > 0 )
+ ? '<B><FONT SIZE="+1" COLOR="#FF0000">Open '
+ : '';
+ my $post = ( $cust_bill->owed > 0 ) ? '</FONT></B>' : '';
+ my $invnum = $cust_bill->invnum;
+ push @history, {
+ 'date' => $cust_bill->_date,
+ 'desc' => qq!<A HREF="${p}view/cust_bill.cgi?$invnum">!. $pre.
+ "Invoice #$invnum (Balance \$". $cust_bill->owed. ')'.
+ $post. '</A>',
+ 'charge' => $cust_bill->charged,
+ };
+ }
+
+ #payments (some false laziness w/credits)
+ foreach my $cust_pay ($cust_main->cust_pay) {
+
+ my $payby = $cust_pay->payby;
+ my $payinfo = $cust_pay->payinfo;
+ my @cust_bill_pay = $cust_pay->cust_bill_pay;
+
+ $payinfo = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4))
+ if $payby eq 'CARD';
+ my $target = "$payby$payinfo";
+ $payby =~ s/^BILL$/Check #/ if $payinfo;
+ $payby =~ s/^BILL$//;
+ $payby =~ s/^(CARD|COMP)$/$1 /;
+ my $info = $payby ? " ($payby$payinfo)" : '';
+
+ my( $pre, $post, $desc, $apply, $ext ) = ( '', '', '', '', '' );
+ if ( scalar(@cust_bill_pay) == 0 ) {
+ #completely unapplied
+ $pre = '<B><FONT COLOR="#FF0000">Unapplied ';
+ $post = '</FONT></B>';
+ $apply = qq! (<A HREF="${p}edit/cust_bill_pay.cgi?!.
+ $cust_pay->paynum. '">apply</A>)';
+ } elsif ( scalar(@cust_bill_pay) == 1 && $cust_pay->unapplied == 0 ) {
+ #applied to one invoice
+ $desc = ' applied to Invoice #'. $cust_bill_pay[0]->invnum;
+ } else {
+ #complicated
+ $desc = '<BR>';
+ foreach my $cust_bill_pay (@cust_bill_pay) {
+ $desc .= ' '.
+ '$'. $cust_bill_pay->amount.
+ ' applied to Invoice #'. $cust_bill_pay->invnum.
+ '<BR>';
+ #' on '. time2str("%D", $cust_bill_pay->_date).
+
+ }
+ if ( $cust_pay->unapplied > 0 ) {
+ $desc .= ' '.
+ '<B><FONT COLOR="#FF0000">$'.
+ $cust_pay->unapplied. ' unapplied</FONT></B>'.
+ qq! (<A HREF="${p}edit/cust_bill_pay.cgi?!.
+ $cust_pay->paynum. '">apply</A>)'.
+ '<BR>';
+ }
}
-
- my(@cust_credit_bill)=
- qsearch('cust_credit_bill', { 'invnum'=> $bref->{invnum} } );
- foreach my $cust_credit_bill (@cust_credit_bill) {
- my $cust_credit = $cust_credit_bill->cust_credit;
- my($date, $invnum, $crednum, $amount, $reason, $app_date ) = (
- $cust_credit->_date,
- $cust_credit_bill->invnum,
- $cust_credit_bill->crednum,
- $cust_credit_bill->amount,
- $cust_credit->reason,
- time2str("%D", $cust_credit_bill->_date),
- );
- my $delete =
- $cust_credit->closed !~ /^Y/i && $conf->exists('deletecredits')
- ? qq! (<A HREF="javascript:cust_credit_areyousure('${p}misc/delete-cust_credit.cgi?!. $cust_credit->crednum. qq!')">delete</A>)!
- : '';
- push @history,
- "$date\tCredit #$crednum: $reason<BR>".
- "(applied to invoice #$invnum on $app_date)$delete\t\t\t$amount\t";
+
+ my $delete = '';
+ if ( $cust_pay->closed !~ /^Y/i && $conf->exists('deletepayments') ) {
+ $delete = qq! (<A HREF="javascript:cust_pay_areyousure('!.
+ qq!${p}misc/delete-cust_pay.cgi?!. $cust_pay->paynum.
+ qq!')">delete</A>)!;
}
- }
-
- my @credits = grep { scalar(my @array = $_->cust_credit_refund) }
- qsearch('cust_credit',{'custnum'=>$custnum});
- foreach my $credit (@credits) {
- my($cref)=$credit->hashref;
- my(@cust_credit_refund)=
- qsearch('cust_credit_refund', { 'crednum'=> $cref->{crednum} } );
- foreach my $cust_credit_refund (@cust_credit_refund) {
- my $cust_refund = $cust_credit_refund->cust_credit;
- my($date, $crednum, $amount, $reason, $app_date ) = (
- $credit->_date,
- $credit->crednum,
- $cust_credit_refund->amount,
- $credit->reason,
- time2str("%D", $cust_credit_refund->_date),
- );
- push @history,
- "$date\tCredit #$crednum: $reason<BR>".
- "(applied to refund on $app_date)\t\t\t$amount\t";
+
+ my $unapply = '';
+ if ( $cust_pay->closed !~ /^Y/i
+ && $conf->exists('unapplypayments')
+ && scalar(@cust_bill_pay) ) {
+ $unapply = qq! (<A HREF="javascript:cust_pay_unapply_areyousure('!.
+ qq!${p}misc/unapply-cust_pay.cgi?!. $cust_pay->paynum.
+ qq!')">unapply</A>)!;
}
+
+ push @history, {
+ 'date' => $cust_pay->_date,
+ 'desc' => $pre. "Payment$post$info$desc".
+ "$apply$delete$unapply",
+ 'payment' => $cust_pay->paid,
+ 'target' => $target,
+ };
}
-
- @credits = grep { $_->credited > 0 }
- qsearch('cust_credit',{'custnum'=>$custnum});
- foreach my $credit (@credits) {
- my($cref)=$credit->hashref;
- my $delete =
- $credit->closed !~ /^Y/i && $conf->exists('deletecredits')
- ? qq! (<A HREF="javascript:cust_credit_areyousure('${p}misc/delete-cust_credit.cgi?!. $credit->crednum. qq!')">delete</A>)!
- : '';
- push @history,
- $cref->{_date} . "\t" .
- qq!<A HREF="! . popurl(2). qq!edit/cust_credit_bill.cgi?!. $cref->{crednum} . qq!">!.
- '<b><font size="+1" color="#ff0000">Unapplied credit #' .
- $cref->{crednum} . "</font></b></A>: ".
- $cref->{reason} . "$delete\t\t\t" . $credit->credited . "\t";
- }
-
- my(@refunds)=qsearch('cust_refund',{'custnum'=> $custnum } );
- foreach my $refund (@refunds) {
- my($rref)=$refund->hashref;
- my($refundnum) = (
- $refund->refundnum,
- );
-
- push @history,
- $rref->{_date} . "\tRefund #$refundnum, (" .
- $rref->{payby} . " " . $rref->{payinfo} . ") by " .
- $rref->{otaker} . " - ". $rref->{reason} . "\t\t\t\t" .
- $rref->{refund};
+
+ #credits (some false laziness w/payments)
+ foreach my $cust_credit ($cust_main->cust_credit) {
+
+ my @cust_credit_bill = $cust_credit->cust_credit_bill;
+ my @cust_credit_refund = $cust_credit->cust_credit_refund;
+
+ my( $pre, $post, $desc, $apply, $ext ) = ( '', '', '', '', '' );
+ if ( scalar(@cust_credit_bill) == 0
+ && scalar(@cust_credit_refund) == 0 ) {
+ #completely unapplied
+ $pre = '<B><FONT COLOR="#FF0000">Unapplied ';
+ $post = '</FONT></B>';
+ $apply = qq! (<A HREF="${p}edit/cust_credit_bill.cgi?!.
+ $cust_credit->crednum. '">apply</A>)';
+ } elsif ( scalar(@cust_credit_bill) == 1
+ && scalar(@cust_credit_refund) == 0
+ && $cust_credit->credited == 0 ) {
+ #applied to one invoice
+ $desc = ' applied to Invoice #'. $cust_credit_bill[0]->invnum;
+ } elsif ( scalar(@cust_credit_bill) == 0
+ && scalar(@cust_credit_refund) == 1
+ && $cust_credit->credited == 0 ) {
+ #applied to one refund
+ $desc = ' refunded on '. time2str("%D", $cust_credit_refund[0]->_date);
+ } else {
+ #complicated
+ $desc = '<BR>';
+ foreach my $app ( sort { $a->_date <=> $b->_date }
+ ( @cust_credit_bill, @cust_credit_refund ) ) {
+ if ( $app->isa('FS::cust_credit_bill') ) {
+ $desc .= ' '.
+ '$'. $app->amount.
+ ' applied to Invoice #'. $app->invnum.
+ '<BR>';
+ #' on '. time2str("%D", $app->_date).
+ } elsif ( $app->isa('FS::cust_credit_refund') ) {
+ $desc .= ' '.
+ '$'. $app->amount.
+ ' refunded on'. time2str("%D", $app->_date).
+ '<BR>';
+ } else {
+ die "$app is not a FS::cust_credit_bill or a FS::cust_credit_refund";
+ }
+ }
+ if ( $cust_credit->credited > 0 ) {
+ $desc .= ' <B><FONT COLOR="#FF0000">$'.
+ $cust_credit->credited. ' unapplied</FONT></B>'.
+ qq! (<A HREF="${p}edit/cust_credit_bill.cgi?!.
+ $cust_credit->crednum. '">apply</A>)'.
+ '<BR>';
+ }
+ }
+#
+ my $delete = '';
+ if ( $cust_credit->closed !~ /^Y/i && $conf->exists('deletecredits') ) {
+ $delete = qq! (<A HREF="javascript:cust_credit_areyousure('!.
+ qq!${p}misc/delete-cust_credit.cgi?!. $cust_credit->crednum.
+ qq!')">delete</A>)!;
+ }
+
+ my $unapply = '';
+ if ( $cust_credit->closed !~ /^Y/i
+ && $conf->exists('unapplycredits')
+ && scalar(@cust_credit_bill) ) {
+ $unapply = qq! (<A HREF="javascript:cust_credit_unapply_areyousure('!.
+ qq!${p}misc/unapply-cust_credit.cgi?!. $cust_credit->crednum.
+ qq!')">unapply</A>)!;
+ }
+
+ push @history, {
+ 'date' => $cust_credit->_date,
+ 'desc' => $pre. "Credit$post by ". $cust_credit->otaker.
+ ' ('. $cust_credit->reason. ')'.
+ "$desc$apply$delete$unapply",
+ 'credit' => $cust_credit->amount,
+ };
+
}
-
- my @unapplied_payments =
- grep { $_->unapplied > 0 } qsearch('cust_pay', { 'custnum' => $custnum } );
- foreach my $payment (@unapplied_payments) {
- my $payby = $payment->payby;
- my $payinfo = $payment->payinfo;
- #false laziness w/above
+
+ #refunds
+ foreach my $cust_refund ($cust_main->cust_refund) {
+
+ my $payby = $cust_refund->payby;
+ my $payinfo = $cust_refund->payinfo;
+
$payinfo = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4))
if $payby eq 'CARD';
- my $target = "$payby$payinfo";
$payby =~ s/^BILL$/Check #/ if $payinfo;
$payby =~ s/^(CARD|COMP)$/$1 /;
- my $delete = $payment->closed !~ /^Y/i && $conf->exists('deletepayments')
- ? qq! (<A HREF="javascript:cust_pay_areyousure('${p}misc/delete-cust_pay.cgi?!. $payment->paynum. qq!')">delete</A>)!
- : '';
- push @history,
- $payment->_date. "\t".
- '<b><font size="+1" color="#ff0000">Unapplied payment #' .
- $payment->paynum . " ($payby$payinfo)</font></b> ".
- '(<A HREF="'. popurl(2). 'edit/cust_bill_pay.cgi?'. $payment->paynum. '">'.
- "apply</A>)$delete".
- "\t\t" . $payment->unapplied . "\t\t\t$target";
+
+ push @history, {
+ 'date' => $cust_refund->_date,
+ 'desc' => "Refund ($payby$payinfo) by ". $cust_refund->otaker,
+ 'refund' => $cust_refund->refund,
+ };
+
}
- #formatting
- print &table(), <<END;
+ %>
+
+ <%= table() %>
<TR>
<TH>Date</TH>
<TH>Description</TH>
<TH><FONT SIZE=-1>Refund</FONT></TH>
<TH><FONT SIZE=-1>Balance</FONT></TH>
</TR>
-END
-
+
+ <%
#display payment history
-
+
+ my %target;
my $balance = 0;
- foreach my $item (sort keyfield_numerically @history) {
- my($date,$desc,$charge,$payment,$credit,$refund,$target)=split(/\t/,$item);
- $charge ||= 0;
- $payment ||= 0;
- $credit ||= 0;
- $refund ||= 0;
- $balance += $charge - $payment;
- $balance -= $credit - $refund;
+ foreach my $item ( sort { $a->{'date'} <=> $b->{'date'} } @history ) {
+
+ my $charge = exists($item->{'charge'})
+ ? sprintf('$%.2f', $item->{'charge'})
+ : '';
+ my $payment = exists($item->{'payment'})
+ ? sprintf('- $%.2f', $item->{'payment'})
+ : '';
+ my $credit = exists($item->{'credit'})
+ ? sprintf('- $%.2f', $item->{'credit'})
+ : '';
+ my $refund = exists($item->{'refund'})
+ ? sprintf('$%.2f', $item->{'refund'})
+ : '';
+
+ my $target = exists($item->{'target'}) ? $item->{'target'} : '';
+
+ $balance += $item->{'charge'} if exists $item->{'charge'};
+ $balance -= $item->{'payment'} if exists $item->{'payment'};
+ $balance -= $item->{'credit'} if exists $item->{'credit'};
+ $balance += $item->{'refund'} if exists $item->{'refund'};
$balance = sprintf("%.2f", $balance);
$balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
- $target = '' unless defined $target;
+ ( my $showbalance = '$'. $balance ) =~ s/^\$\-/- \$/;
+
+ %>
- print "<TR><TD><FONT SIZE=-1>";
- print qq!<A NAME="$target">! unless $target && $target{$target}++;
- print time2str("%D",$date);
- print '</A>' if $target && $target{$target} == 1;
- print "</FONT></TD>",
- "<TD><FONT SIZE=-1>$desc</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- ( $charge ? "\$".sprintf("%.2f",$charge) : '' ),
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- ( $payment ? "- \$".sprintf("%.2f",$payment) : '' ),
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- ( $credit ? "- \$".sprintf("%.2f",$credit) : '' ),
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- ( $refund ? "\$".sprintf("%.2f",$refund) : '' ),
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>\$" . $balance,
- "</FONT></TD>",
- "\n";
- }
+ <TR>
+ <TD>
+ <% unless ( !$target || $target{$target}++ ) { %>
+ <A NAME="<%= $target %>">
+ <% } %>
+ <%= time2str("%D",$item->{'date'}) %>
+ <% if ( $target && $target{$target} == 1 ) { %>
+ </A>
+ <% } %>
+ </FONT>
+ </TD>
+ <TD><%= $item->{'desc'} %></TD>
+ <TD ALIGN="right"><%= $charge %></TD>
+ <TD ALIGN="right"><%= $payment %></TD>
+ <TD ALIGN="right"><%= $credit %></TD>
+ <TD ALIGN="right"><%= $refund %></TD>
+ <TD ALIGN="right"><%= $showbalance %></TD>
+ </TR>
+
+ <% } %>
- print "</TABLE>";
-
-}
+ </TABLE>
-print '</BODY></HTML>';
-
-#subroutiens
-sub keyfield_numerically { (split(/\t/,$a))[0] <=> (split(/\t/,$b))[0]; }
+<% } %>
-%>
+</BODY></HTML>
<%
-
+#subroutines
sub get_packages {
my $cust_main = shift or return undef;
)
) {
- warn "svcnum ". $cust_svc->svcnum. " / svcpart ". $cust_svc->svcpart. "\n";
+ #warn "svcnum ". $cust_svc->svcnum. " / svcpart ". $cust_svc->svcpart. "\n";
my $svc = {
'svcnum' => $cust_svc->svcnum,
'label' => ($cust_svc->label)[1],
}
sub svc_provision_link {
- my ($pkg, $svcpart) = (shift,shift) or return '';
+ my ($pkg, $svcpart, $conf) = @_;
( my $svc_nbsp = $svcpart->{svc} ) =~ s/\s+/ /g;
- return qq!<A CLASS="provision" HREF="${p}edit/$svcpart->{svcdb}.cgi?! .
- qq!pkgnum$pkg->{pkgnum}-svcpart$svcpart->{svcpart}">! .
- "Provision $svc_nbsp (".
- ($svcpart->{quantity} - $svcpart->{count}).
- ')</A>';
+ my $pkgnum_svcpart = "pkgnum$pkg->{pkgnum}-svcpart$svcpart->{svcpart}";
+ my $num_left = $svcpart->{quantity} - $svcpart->{count};
+
+ my $link = qq!<A CLASS="provision" HREF="${p}edit/$svcpart->{svcdb}.cgi?!.
+ qq!$pkgnum_svcpart">!.
+ "Provision $svc_nbsp ($num_left)</A>";
+ if ( $conf->exists('legacy_link') ) {
+ $link .= '<BR>'.
+ qq!<A CLASS="provision" HREF="${p}misc/link.cgi?!.
+ qq!$pkgnum_svcpart">!.
+ "Link to legacy $svc_nbsp ($num_left)</A>";
+ }
+ $link;
}
sub svc_unprovision_link {
$strip;
}
-sub pkg_details_link {
- my $pkg = shift or return '';
- return qq!<a href="${p}view/cust_pkg.cgi?$pkg->{pkgnum}">Details</a>!;
-}
-
sub pkg_change_link {
my $pkg = shift or return '';
return qq!<a href="${p}misc/change_pkg.cgi?$pkg->{pkgnum}">Change package</a>!;
sub pkg_cancel_link {
my $pkg = shift or return '';
- return qq!<A HREF="javascript:cust_pkg_areyousure('${p}misc/cancel_pkg.cgi?$pkg->{pkgnum}')">Cancel</A>!;
+ qq!<A HREF="javascript:cust_pkg_areyousure('${p}misc/cancel_pkg.cgi?$pkg->{pkgnum}')">Cancel now</A> | !.
+ qq!<A HREF="${p}misc/expire_pkg.cgi?$pkg->{pkgnum}">Cancel later</A>!;
}
sub pkg_dates_link {
<%= header('Account View', menubar(
( ( $pkgnum || $custnum )
- ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum",
- "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
+ ? ( "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
)
: ( "Cancel this (unaudited) account" =>
"javascript:areyousure(\'${p}misc/cancel-unaudited.cgi?$svcnum\')" )
<%= header('Domain View', menubar(
( ( $pkgnum || $custnum )
- ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum",
- "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
+ ? ( "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
)
: ( "Cancel this (unaudited) domain" =>
"${p}misc/cancel-unaudited.cgi?$svcnum" )
<BR>Domain name: <B><%= $domain %></B>
<BR>Catch all email <A HREF="<%= ${p} %>misc/catchall.cgi?<%= $svcnum %>">(change)</A>:
<%= $email ? "<B>$email</B>" : "<I>(none)<I>" %>
-<BR><BR><A HREF="http://www.geektools.com/cgi-bin/proxy.cgi?query=<%=$domain%>;targetnic=auto">View whois information.</A>
+<BR><BR><A HREF="<%= ${p} %>misc/whois.cgi?custnum=<%=$custnum%>;svcnum=<%=$svcnum%>;domain=<%=$domain%>">View whois information.</A>
<BR><BR>
<SCRIPT>
function areyousure(href) {
if ( confirm("Remove this record?") == true )
window.location.href = href;
}
+ function slave_areyousure() {
+ return confirm("Remove all records and slave from " + document.SlaveForm.recdata.value + "?");
+ }
</SCRIPT>
<% my @records; if ( @records = $svc_domain->domain_record ) { %>
</SELECT>
<INPUT TYPE="text" NAME="recdata"> <INPUT TYPE="submit" VALUE="Add record">
</FORM><BR><BR>or<BR><BR>
-<FORM METHOD="POST" ACTION="<%=$p%>edit/process/domain_record.cgi">
+<FORM NAME="SlaveForm" METHOD="POST" ACTION="<%=$p%>edit/process/domain_record.cgi">
<INPUT TYPE="hidden" NAME="svcnum" VALUE="<%=$svcnum%>">
<% if ( @records ) { %> Delete all records and <% } %>
<INPUT TYPE="hidden" NAME="reczone" VALUE="@">
<INPUT TYPE="hidden" NAME="recaf" VALUE="IN">
<INPUT TYPE="hidden" NAME="rectype" VALUE="_mstr">
-<INPUT TYPE="text" NAME="recdata"> <INPUT TYPE="submit" VALUE="Slave domain">
+<INPUT TYPE="text" NAME="recdata"> <INPUT TYPE="submit" VALUE="Slave domain" onClick="return slave_areyousure()">
</FORM>
<BR><BR><%= joblisting({'svcnum'=>$svcnum}, 1) %>
</BODY></HTML>
print header('Mail Forward View', menubar(
( ( $pkgnum || $custnum )
- ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum",
- "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
+ ? ( "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
)
- : ( "Cancel this (unaudited) account" =>
+ : ( "Cancel this (unaudited) mail forward" =>
"${p}misc/cancel-unaudited.cgi?$svcnum" )
),
"Main menu" => $p,
$svc_forward->dstsvc,
$svc_forward->dst,
);
+my $src = $svc_forward->dbdef_table->column('src') ? $svc_forward->src : '';
+
my $svc = $part_svc->svc;
-my $svc_acct = qsearchs('svc_acct',{'svcnum'=>$srcsvc})
- or die "Corrupted database: no svc_acct.svcnum matching srcsvc $srcsvc";
-my $source = $svc_acct->email;
+
+my $source;
+if ($srcsvc) {
+ my $svc_acct = qsearchs('svc_acct',{'svcnum'=>$srcsvc})
+ or die "Corrupted database: no svc_acct.svcnum matching srcsvc $srcsvc";
+ $source = $svc_acct->email;
+} else {
+ $source = $src;
+}
+
my $destination;
if ($dstsvc) {
my $svc_acct = qsearchs('svc_acct',{'svcnum'=>$dstsvc})
or die "Corrupted database: no svc_acct.svcnum matching dstsvc $dstsvc";
$destination = $svc_acct->email;
-}else{
+} else {
$destination = $dst;
}
print header('Website View', menubar(
( ( $custnum )
- ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum",
- "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
+ ? ( "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
)
: ( "Cancel this (unaudited) website" =>
"${p}misc/cancel-unaudited.cgi?$svcnum" )
FREESIDE_PATH="%%%FREESIDE_PATH%%%"
SELFSERVICE_USER=%%%SELFSERVICE_USER%%%
-SELFSERVICE_MACHINE=%%%SELFSERVICE_MACHINE%%%
+SELFSERVICE_MACHINES="%%%SELFSERVICE_MACHINES%%%"
+
+#INSTALLSCRIPT/INSTALLSITEBIN from Makefile.PL
+PATH="$PATH:/usr/local/bin"
+export PATH
case "$1" in
start)
freeside-queued $QUEUED_USER
echo "done."
- echo -n "Starting freeside-selfservice-server: "
- freeside-selfservice-server $SELFSERVICE_USER $SELFSERVICE_MACHINE
- echo "done."
+ for MACHINE in $SELFSERVICE_MACHINES; do
+ echo -n "Starting freeside-selfservice-server to $MACHINE: "
+ freeside-selfservice-server $SELFSERVICE_USER $MACHINE
+ echo "done."
+ done
;;
stop)
kill `cat /var/run/freeside-queued.pid`
echo "done."
- echo -n "Stopping freeside-selfservice-server: "
- kill `cat /var/run/freeside-selfservice-server.$SELFSERVICE_USER.pid`
- echo "done."
+ if [ -e /var/run/freeside-selfservice-server.$SELFSERVICE_USER.pid ]
+ then
+ echo -n "Stopping (old) freeside-selfservice-server: "
+ kill `cat /var/run/freeside-selfservice-server.$SELFSERVICE_USER.pid`
+ rm /var/run/freeside-selfservice-server.$SELFSERVICE_USER.pid
+ fi
+
+ for MACHINE in $SELFSERVICE_MACHINES; do
+ echo -n "Stopping freeside-selfservice-server to $MACHINE: "
+ kill `cat /var/run/freeside-selfservice-server.$SELFSERVICE_USER.$MACHINE.pid`
+ echo "done."
+ done
+
;;
restart)
--- /dev/null
+1.22 Wed Mar 26 22:33:44 EST 2003
+ - Win32 compile fix for snprintf [Joe Spears]
+ - Fix memory allocation problem in bytea escaping [Barrie Slaymaker]
+ - Add utf8 support [Dominic Mitchell <dom@semantico.com>]
+ - Transform Perl arrays into PostgreSQL arrays [Alexey Slynko]
+ - Fix for foreign_key_info() [Keith Keller]
+ - Fix PG_TEXT parameter binding
+ - Doc cleanups [turnstep]
+ - Fix warning from func($table, 'table_attributes') [turnstep]
+ - Added suppport for schemas [turnstep]
+ - Fix binary to a bytea field conversion [Chris Dunlop <chris@onthe.net.au>]
+1.21 Sun Jan 12 21:00:44 EST 2003
+ - System tables no longer returned by tables(). [Dave Rolsky]
+ - Fix table_attributes to handle removal of pg_relcheck in 7.3,
+ from Ian Barwick <barwick@gmx.net>
+ - Properly reset transaction status after failed transaction when
+ autocommit is off. Properly report transaction failure message.
+ Kai <kai@xs4all.nl>
+ - New pg_bool_tf database handle that when set to true booleans are
+ returned as 't'/'f' rather than 1/0.
+
+1.20 Wed Nov 27 16:19:26 2002
+ - Maintenance transferred to GBorg,
+ http://gborg.postgresql.org/project/dbdpg/projdisplay.php. Incremented
+ version number to reflect new management. [Bruce Momjian]
+ - README cleaned up. [Bruce Momjian]
+ - Added t/15funct.t, a series of tests that determine if the meta data
+ is working. [Thomas Lowery]
+ - Added implementations of column_info() and table_info(), and
+ primary_key_info(). [Thomas Lowery]
+ - The POD formatting was cleaned up. [David Wheeler]
+ - The preparser was updated to better handle escaped characters. [Rudy
+ Lippan]
+ - Removed redundant use of strlen() in pg_error() (Jason E. Stewart).
+ - Test suite cleaned up, converted to use Test::More, and updated to use
+ standard DBI environment variables for connecting to a test database.
+ [Jason E. Stewart]
+ - Added eg/lotest.pl as a demonstration of using large objects in buffers
+ rather than files. Contributed by Garth Webb.
+ - Added LISTEN/NOTIFY functionality. Congributed by Alex Pilosov.
+ - Added constants for common PostgreSQL data types, plus simple tests to
+ make sure that they work. These are exportable via "use DBD::Pg
+ qw(:pg_types);". [David Wheeler]
+ - Deprecatated the undocumented (and invalid) use of SQL_BINARY in
+ bind_param() and documented the correct approach: "bind_param($num,
+ $val { pg_type => PG_BYTEA });". Use of SQL_BINARY in bind_param() will
+ now issue a warning if $h->{Warn} is true. [David Wheeler]
+ - Removed invalid (and broken) support for SQL_BINARY in quote(). [David
+ Wheeler]
+ - Added App::Info::RDBMS::PostgreSQL to the distribution (but it won't
+ be installed) to help Makefile.PL find the PostgreSQL include and
+ library files. [David Wheeler]
+ - Fixed compile-time warnings. [David Wheeler and Jason E. Stewart]
+
+2002-04-27 Jeffrey W. Baker <jwbaker@acm.org>
+
+ - dbdimp.c: Add default at end of switch statement for pg_type attrib.
+ - t/13pgtype.t: test for above.
+
+2002-04-09 Jeffrey W. Baker <jwbaker@acm.org>
+
+ - Pg.pm, dbdimp.c: Applied patch from
+ Thomas A. Lowery <tlowery@stlowery.net> concerning metadata
+ in table_info and so forth.
+
+2002-03-06 Jeffrey W. Baker <jwbaker@acm.org>
+ - Pg.pm (quote): Applied patch from David Wheeler <david@wheeler.net>
+ to simplfiy and speed up quoting.
+ - t/11quoting.t: Tests for above patch.
+ - t/12placeholders.t: Tests for placeholder parsing in quoted strings.
+
+2002-03-06 Jeffrey W. Baker
+ - Version 1.10 uploaded to CPAN.
+
+1.01 Jun 27, 2001
+ - fixed core dump when trying to use a BYTEA value with
+ a byte outside 0..127 Alex Pilosov <alex@pilosoft.com>
+
+1.00 May 27, 2001
+ - Fetching all records now resets Active flag as it should.
+
+0.99 May 24, 2001
+ - fix the segmentation fault in pg_error.
+
+0.98 Apr 25, 2001
+ - bug-fix for core-dump after any failed function call.
+ - applied patch from Alex Pilosov <alex@pilosoft.com>
+ which adds support for the datatype bytea
+
+0.97 Apr 20, 2001
+ - fix bug in connect method, which erroneously set the userid
+ and the password to the environment variables DBI_USER and
+ DBI_PASS.
+ - applied patch from Jan-Pieter Cornet <john@pc.xs4all.nl>,
+ which removed the special handling of a backslash when
+ used for octal presentation. Now a backslash always will
+ be escaped.
+
+0.96 Apr 09, 2001
+ - remove memory-leak in ping function, bug-fix
+ from Doug Perham <dperham@wgate.com>
+ - correct the recognition of primary keys in
+ table_attributes(). Patch from Brian Powell
+ <brian@nicklebys.com>.
+ - applied patch from David D. Kilzer <ddkilzer@lubricants-oil.com>
+ which fixes a segmentation fault in DBD::pg::blob_read() when
+ reading LOBs that required perl to reallocate space for the
+ variable holding the scalar value
+ - updated test.pl to create a test blob larger than 256 bytes
+ (now 128 Kbytes)
+ - apply patch from Tom Lane, which fixes a seg-fault when
+ inserting large amounts of text.
+ - apply patch from Peter Haworth pmh@edison.ioppublishing.com,
+ which removes the newlines from the error messages and which
+ quotes date placeholders.
+
+0.95 Jul 10, 2000
+ - add Win32 port from Bob Kline <bkline@rksystems.com>.
+
+0.94 Jul 07, 2000
+ - applied patch from Rudy Lippan <almighty@randomc.com>
+ which fixes a memory-leak with failed connections.
+ - applied patch from Hein Roehrig <hein@acm.org>
+ which fixes a bug with escaping a backslash except for
+ octal presentation
+ - applied patch from Francis J. Lacoste <francis.lacoste@iNsu.COM
+ which fixes a segmentation fault when all binded parameters are NULL
+ - adapt test.pl to avoid warnings with postgresql-7.0
+ - added support for 'COPY FROM STDIN' and 'COPY TO STDOUT'
+ - added patch from Mark Stosberg <mark@summersault.com>
+ to enhance the table_attributes subroutine
+
+0.93 Sep 29, 1999
+ - it is required now to set the environment variables POSTGRES_INCLUDE
+ and POSTGRES_LIB for compiling the module.
+ - add Win32 port from Bob Kline <bkline@rksystems.com>.
+ - support for all large-object functions via the func
+ interface.
+ - fixed bug with placeholders and casts spotted by
+ mschout@gkg.net
+ - replaced the method attributes by the method table_attributes,
+ from Scott Williams <scott@james.com>.
+ - fix type definitions for type_info_all().
+ bug spotted by "carlos" <emarcet@intramed.net.ar>.
+ - now the Pg-specific quote() method also evaluates the
+ data-type paramater.
+
+0.92 Jun 16, 1999
+ - proposal from Philip Warner <pjw@rhyme.com.au>:
+ increase BUFSIZE from 1024 to 32768 in order to improve
+ I/O performance.
+ - bug-fix in Makefile.PL for $POSTGRES_HOME not defined
+ spotted by mdalphin@amgen.com (Mark Dalphin)
+ - bug-fix for data-type datetime in type_info_all
+ spotted by Alan Grover <awgrover@iconnect-inc.com>
+ - bug-fix for escaped 's spotted by Hankin <hankin@consultco.com>
+ - removed 'large objects' related tests from test.pl
+
+0.91 Feb 14, 1999
+ - removed restriction for commercial use in copyright
+ - corrected DATA_TYPE in type_info_all()
+
+0.90 Jan 15, 1998
+ - discard parameter authtype from connect string
+ - remove work-around for bug in the large object
+ interface of postgresql
+
+0.89 Nov 05, 1998
+ - bug-fix from Jan Iven <j.iven@rz.uni-sb.de>:
+ fix problem with quoting Null in bind variables.
+
+0.88 Oct 10, 1998
+ - fixed blob_read
+ - suppressed warning when testing DBI::errstr
+
+0.87 Sep 05, 1998
+ - Pg.xs adapted to Driver.xst from DBI-1.0
+ - major rewrite of module documentation
+ - major rewrite of the test script
+ - use built-in DBI method for $dbh->do
+ - add macro dHTR in order to avoid compile errors
+ with threaded perl5.005
+ - renamed attribute AutoEscape to pg_auto_escape
+ - renamed attribute SIZE to pg_size
+ - new attribute pg_type
+ - added support for DBI->data_sources($driver)
+ - added support for $dbh->table_info
+ - blob_read documented and added to test.pl
+ - added support for attr parameter in bind_param()
+
+0.86 Aug 21, 1998
+ - added /usr/lib/ to search path for libpq.
+ - added ChopBlanks, patch from
+ Victor Krasinsky <victor@rdovira.lviv.ua>
+ - changed test.pl to test multiple database handles
+
+0.85 July 19, 1998
+ - non-printable characters in parameters will not be
+ converted to '.'. They are passed unchanged to the
+ database.
+
+0.84 July 18, 1998
+ - bug-fix from Max Cohan <mcohan@adnc.net>:
+ check for \xxx presentation before escaping backslash
+ in parameters.
+ - introduce new database handle attribute AutoEscape, which
+ controls escaping of quotes and backslashes in parameters.
+ When set to on, all quotes except at the beginning and
+ at the end of a line will be escaped and all backslashes
+ except when used to indicate an octal presentation (\xxx)
+ will be escaped. Default of AutoEscape is on.
+
+0.83 July 10, 1998
+ - bug-fix from Max Cohan <mcohan@adnc.net>:
+ using traces together with undef in place-holders dumped
+ core.
+
+0.82 June 20, 1998
+ - bug-fix from Matthew Lenz <matthew@nocturnal.org>:
+ corrected include path in Makefile.PL .
+ - added 'use strict;' to test.pl
+
+0.81 June 13, 1998
+ - bug-fix from Rolf Grossmann <grossman@securitas.net>:
+ undefined parameters in an execute statement will be
+ translated from 'undef' to 'NULL'. Also every parameter
+ for bind_param() will be quoted by default (escape quote
+ and backslash). Appropriate tests have been added to test.pl.
+ - change ping method to use libpq-interface.
+
+0.80 June 07, 1998
+ - adapted to postgresql-6.4:
+ the backend protocol has changed, which needs an adapted
+ ping method. A ping-test has been added to the test-script.
+ Also some type identifiers have changed.
+
+0.73 June 03, 1998
+ - changed include directives in Makefile.PL from
+ archlib to installarchlib and from sitearch to
+ installsitearch (Tony.Curtis@vcpc.univie.ac.at).
+ - applied patch from Junio Hamano <junio@twinsun.com>
+ quote method also doubles backslash.
+
+0.72 April 20, 1998
+ - applied patch from Michael J Schout <mschout@gkg.net>
+ which fixed the bug with queries containing the cast
+ operator.
+ - applied patch from "Irving Reid" <irving@tor.securecomputing.com>
+ which fixed a memory leak.
+
+0.71 April 04, 1998
+ - applied patch from "Irving Reid"
+ <irving@tor.securecomputing.com> which fixed the
+ the problem with the InactiveDestroy message.
+
+0.70 March 28, 1998
+ - linking again with the shared version of libpq
+ due to problems on several operating systems.
+
+0.69 March 6, 1998
+ - expanded the search path for include files
+ - module is now linked with static libpq.a
+
+0.68 March 3, 1998
+ - return to UNIX domain sockets in test-scripts
+
+0.67 February 21, 1998
+ - remove part of Driver.xst due to compile
+ error on some systems.
+
+0.66 February 19, 1998
+ - remove defines in Pg.h so that
+ it compiles also with postgresql-6.2.1
+ - changed ping method: set RaiseError=0
+
+0.65 February 14, 1998
+ - adapted to changes in DBI-0.91, so that the
+ default setting for AutoCommit and PrintError is
+ again conformant to the DBI specs.
+
+0.64 February 01, 1998
+ - changed syntax of data_source (ODBC-conformant):
+ 'dbi:Pg:dbname=dbname;host=host;port=port'
+ !!! PLEASE ADAPT YOUR SCRIPTS !!!
+ - implemented place-holders
+ - implemented ping-method
+ - added support for $dbh->{RaiseError} and $dbh->{PrintError},
+ note: DBI-default for PrintError is on !
+ - allow commit and rollback only if AutoCommit = off
+ - added documentation for $dbh->tables;
+ - new method to get meta-information about a given table:
+ $dbh->DBD::Pg::db::attributes($table);
+ - host-parameter in test.pl is set explicitly to localhost
+
+0.63 October 05, 1997
+ - adapted to PostgreSQL-6.2:
+ o $sth->rows as well as $sth->execute
+ and $sth->do return the number of
+ affected rows even for non-Select
+ statements.
+ o support for password authorization added,
+ please check the man-page for pg_passwd.
+ - the data_source parameter of the connect
+ method accepts two additional parameters
+ which are treated as host and port:
+ DBI->connect("dbi:Pg:dbname:host:port", "uid", "pwd")
+ - support for AutoCommit, please read the
+ module documentation for impacts on your
+ scripts !
+ - more perl-ish handling of data type bool,
+ please read the module documentation for
+ impacts on your scripts !
+
+0.62 August 26, 1997
+ - added blobs/README
+
+0.61 August 23, 1997
+ - adapted to DBI-0.89/Driver.xst
+ - added support for blob_read
+
+0.52 August 15, 1997
+ - added support for literal $sth->{'TYPE'},
+ pg_type.pl / pg_type.pm.
+
+0.51 August 12, 1997
+ - changed attributes to be DBI conformant:
+ o OID_STATUS to pg_oid_status
+ o CMD_STATUS to pg_cmd_status
+
+0.5 August 05, 1997
+ - support for user authentication
+ - support for bind_columns
+ - added $dbh->tables
+
+0.4 Jun 24, 1997
+ - adapted to DBI-0.84:
+ o new syntax for DBI->connect !
+ o execute returns 0E0 -> n for SELECT stmt
+ -1 for non SELECT stmt
+ -2 on error
+ - new attribute $sth->{'OID_STATUS'}
+ - new attribute $sth->{'CMD_STATUS'}
+
+0.3 Apr 24, 1997
+ - bug fix release, ( still alpha ! )
+
+0.2 Mar 13, 1997
+ - complete rewrite, ( still alpha ! )
+
+0.1 Feb 15, 1997
+ - creation, ( totally pre-alpha ! )
+
--- /dev/null
+Changes
+MANIFEST
+Makefile.PL
+Pg.h
+Pg.pm
+Pg.xs
+README
+README.win32
+dbd-pg.pod
+dbdimp.c
+dbdimp.h
+eg/ApacheDBI.pl
+eg/lotest.pl
+eg/notify_test.patch
+t/00basic.t
+t/01connect.t
+t/01constants.t
+t/01setup.t
+t/02prepare.t
+t/03bind.t
+t/04execute.t
+t/05fetch.t
+t/06disconnect.t
+t/07reuse.t
+t/08txn.t
+t/09autocommit.t
+t/11quoting.t
+t/12placeholders.t
+t/13pgtype.t
+t/15funct.t
+t/99cleanup.t
+t/lib/App/Info.pm
+t/lib/App/Info/Handler.pm
+t/lib/App/Info/Handler/Prompt.pm
+t/lib/App/Info/RDBMS.pm
+t/lib/App/Info/RDBMS/PostgreSQL.pm
+t/lib/App/Info/Request.pm
+t/lib/App/Info/Util.pm
--- /dev/null
+
+# $Id: Makefile.PL,v 1.1.2.1 2004-04-29 09:40:07 ivan Exp $
+
+use ExtUtils::MakeMaker;
+use Config;
+use strict;
+
+use DBI 1.00;
+use DBI::DBD;
+
+my $lib;
+BEGIN {
+ my %sep = (MacOS => ':',
+ MSWin32 => '\\',
+ os2 => '\\',
+ VMS => '\\',
+ NetWare => '\\',
+ dos => '\\');
+ my $s = $sep{$^O} || '/';
+ $lib = join $s, 't', 'lib';
+}
+
+use lib $lib;
+print "Configuring Pg\n";
+print "Remember to actually read the README file !\n";
+
+my $POSTGRES_INCLUDE;
+my $POSTGRES_LIB;
+
+if ((!$ENV{POSTGRES_INCLUDE} or !$ENV{POSTGRES_LIB}) and !$ENV{POSTGRES_HOME}) {
+ # Use App::Info to get the data we need.
+ require App::Info::RDBMS::PostgreSQL;
+ require App::Info::Handler::Prompt;
+ my $p = App::Info::Handler::Prompt->new;
+ my $pg = App::Info::RDBMS::PostgreSQL->new(on_unknown => $p);
+ $POSTGRES_INCLUDE = $pg->inc_dir;
+ $POSTGRES_LIB = $pg->lib_dir;
+} elsif ((!$ENV{POSTGRES_INCLUDE} or !$ENV{POSTGRES_LIB}) and $ENV{POSTGRES_HOME}) {
+ $POSTGRES_INCLUDE = "$ENV{POSTGRES_HOME}/include";
+ $POSTGRES_LIB = "$ENV{POSTGRES_HOME}/lib";
+} else {
+ $POSTGRES_INCLUDE = "$ENV{POSTGRES_INCLUDE}";
+ $POSTGRES_LIB = "$ENV{POSTGRES_LIB}";
+}
+
+my $os = $^O;
+print "OS: $os\n";
+
+my $dbi_arch_dir;
+if ($os eq 'MSWin32') {
+ $dbi_arch_dir = "\$(INSTALLSITEARCH)/auto/DBI";
+} else {
+ $dbi_arch_dir = dbd_dbi_arch_dir();
+}
+
+my %opts = (
+ NAME => 'DBD::Pg',
+ VERSION_FROM => 'Pg.pm',
+ INC => "-I$POSTGRES_INCLUDE -I$dbi_arch_dir",
+ OBJECT => "Pg\$(OBJ_EXT) dbdimp\$(OBJ_EXT)",
+ LIBS => ["-L$POSTGRES_LIB -lpq"],
+ AUTHOR => 'http://gborg.postgresql.org/project/dbdpg/projdisplay.php',
+ ABSTRACT => 'PostgreSQL database driver for the DBI module',
+ PREREQ_PM => { 'Test::Simple' => 0.17 }, # Need Test::More
+);
+
+if ($os eq 'hpux') {
+ my $osvers = $Config{osvers};
+ if ($osvers < 10) {
+ print "Warning: Forced to build static not dynamic on $os $osvers.\a\n";
+ $opts{LINKTYPE} = 'static';
+ }
+}
+
+if ($Config{dlsrc} =~ /dl_none/) {
+ $opts{LINKTYPE} = 'static';
+}
+
+WriteMakefile(%opts);
+
+exit(0);
+
+# end of Makefile.PL
--- /dev/null
+/*
+ $Id: Pg.h,v 1.1.2.1 2004-04-29 09:40:07 ivan Exp $
+
+ Copyright (c) 1997,1998,1999,2000 Edmund Mergl
+ Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
+
+ You may distribute under the terms of either the GNU General Public
+ License or the Artistic License, as specified in the Perl README file.
+
+*/
+
+
+#ifdef WIN32
+static int errno;
+#endif
+
+#include "libpq-fe.h"
+
+#ifdef NEVER
+#include<sys/stat.h>
+#include "libpq/libpq-fs.h"
+#endif
+#ifndef INV_READ
+#define INV_READ 0x00040000
+#endif
+#ifndef INV_WRITE
+#define INV_WRITE 0x00020000
+#endif
+
+#ifdef BUFSIZ
+#undef BUFSIZ
+#endif
+/* this should improve I/O performance for large objects */
+#define BUFSIZ 32768
+
+
+#define NEED_DBIXS_VERSION 93
+
+#include <DBIXS.h> /* installed by the DBI module */
+
+#include "dbdimp.h" /* read in our implementation details */
+
+#include <dbd_xsh.h> /* installed by the DBI module */
+
+
+/* end of Pg.h */
--- /dev/null
+
+# $Id: Pg.pm,v 1.1.2.1 2004-04-29 09:40:07 ivan Exp $
+#
+# Copyright (c) 1997,1998,1999,2000 Edmund Mergl
+# Copyright (c) 2002 Jeffrey W. Baker
+# Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
+#
+# You may distribute under the terms of either the GNU General Public
+# License or the Artistic License, as specified in the Perl README file.
+
+
+require 5.004;
+
+$DBD::Pg::VERSION = '1.22';
+
+{
+ package DBD::Pg;
+
+ use DBI ();
+ use DynaLoader ();
+ use Exporter ();
+ @ISA = qw(DynaLoader Exporter);
+
+ %EXPORT_TAGS = (
+ pg_types => [ qw(
+ PG_BOOL PG_BYTEA PG_CHAR PG_INT8 PG_INT2 PG_INT4 PG_TEXT PG_OID
+ PG_FLOAT4 PG_FLOAT8 PG_ABSTIME PG_RELTIME PG_TINTERVAL PG_BPCHAR
+ PG_VARCHAR PG_DATE PG_TIME PG_DATETIME PG_TIMESPAN PG_TIMESTAMP
+ )]);
+
+ Exporter::export_ok_tags('pg_types');
+
+ require_version DBI 1.00;
+
+ bootstrap DBD::Pg $VERSION;
+
+ $err = 0; # holds error code for DBI::err
+ $errstr = ""; # holds error string for DBI::errstr
+ $drh = undef; # holds driver handle once initialized
+
+ sub driver{
+ return $drh if $drh;
+ my($class, $attr) = @_;
+
+ $class .= "::dr";
+
+ # not a 'my' since we use it above to prevent multiple drivers
+
+ $drh = DBI::_new_drh($class, {
+ 'Name' => 'Pg',
+ 'Version' => $VERSION,
+ 'Err' => \$DBD::Pg::err,
+ 'Errstr' => \$DBD::Pg::errstr,
+ 'Attribution' => 'PostgreSQL DBD by Edmund Mergl',
+ });
+
+ $drh;
+ }
+
+ ## Used by both the dr and db packages
+ sub pg_server_version {
+ my $dbh = shift;
+ return $dbh->{pg_server_version} if defined $dbh->{pg_server_version};
+ my ($version) = $dbh->selectrow_array("SELECT version();");
+ return 0 unless $version =~ /^PostgreSQL ([\d\.]+)/;
+ $dbh{pg_server_version} = $1;
+ return $dbh{pg_server_version};
+ }
+
+ sub pg_use_catalog {
+ my $dbh = shift;
+ my $version = DBD::Pg::pg_server_version($dbh);
+ $version =~ /^(\d+\.\d+)/;
+ return $1 < 7.3 ? "" : "pg_catalog.";
+ }
+
+ 1;
+}
+
+
+{ package DBD::Pg::dr; # ====== DRIVER ======
+ use strict;
+
+ sub data_sources {
+ my $drh = shift;
+ my $dbh = DBD::Pg::dr::connect($drh, 'dbname=template1') or return undef;
+ $dbh->{AutoCommit} = 1;
+ my $CATALOG = DBD::Pg::pg_use_catalog($dbh);
+ my $sth = $dbh->prepare("SELECT datname FROM ${CATALOG}pg_database ORDER BY datname");
+ $sth->execute or return undef;
+ my (@sources, @datname);
+ while (@datname = $sth->fetchrow_array) {
+ push @sources, "dbi:Pg:dbname=$datname[0]";
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return @sources;
+ }
+
+
+ sub connect {
+ my($drh, $dbname, $user, $auth)= @_;
+
+ # create a 'blank' dbh
+
+ my $Name = $dbname;
+ $Name =~ s/^.*dbname\s*=\s*//;
+ $Name =~ s/\s*;.*$//;
+
+ $user = "" unless defined($user);
+ $auth = "" unless defined($auth);
+
+ $user = $ENV{DBI_USER} if $user eq "";
+ $auth = $ENV{DBI_PASS} if $auth eq "";
+
+ $user = "" unless defined($user);
+ $auth = "" unless defined($auth);
+
+ my($dbh) = DBI::_new_dbh($drh, {
+ 'Name' => $Name,
+ 'User' => $user, 'CURRENT_USER' => $user,
+ });
+
+ # Connect to the database..
+ DBD::Pg::db::_login($dbh, $dbname, $user, $auth) or return undef;
+
+ $dbh;
+ }
+
+}
+
+
+{ package DBD::Pg::db; # ====== DATABASE ======
+ use strict;
+ use Carp ();
+
+ sub prepare {
+ my($dbh, $statement, @attribs)= @_;
+
+ # create a 'blank' sth
+
+ my $sth = DBI::_new_sth($dbh, {
+ 'Statement' => $statement,
+ });
+
+ DBD::Pg::st::_prepare($sth, $statement, @attribs) or return undef;
+
+ $sth;
+ }
+
+
+ sub ping {
+ my($dbh) = @_;
+
+ local $SIG{__WARN__} = sub { } if $dbh->{PrintError};
+ local $dbh->{RaiseError} = 0 if $dbh->{RaiseError};
+ my $ret = DBD::Pg::db::_ping($dbh);
+
+ return $ret;
+ }
+
+ # Column expected in statement handle returned.
+ # table_cat, table_schem, table_name, column_name, data_type, type_name,
+ # column_size, buffer_length, DECIMAL_DIGITS, NUM_PREC_RADIX, NULLABLE,
+ # REMARKS, COLUMN_DEF, SQL_DATA_TYPE, SQL_DATETIME_SUB, CHAR_OCTET_LENGTH,
+ # ORDINAL_POSITION, IS_NULLABLE
+ # The result set is ordered by TABLE_CAT, TABLE_SCHEM,
+ # TABLE_NAME and ORDINAL_POSITION.
+
+ sub column_info {
+ my ($dbh) = shift;
+ my @attrs = @_;
+ # my ($dbh, $catalog, $schema, $table, $column) = @_;
+ my $CATALOG = DBD::Pg::pg_use_catalog($dbh);
+
+ my @wh = ();
+ my @flds = qw/catname n.nspname c.relname a.attname/;
+
+ for my $idx (0 .. $#attrs) {
+ next if ($flds[$idx] eq 'catname'); # Skip catalog
+ if(defined $attrs[$idx] and length $attrs[$idx]) {
+ # Insure that the value is enclosed in single quotes.
+ $attrs[$idx] =~ s/^'?(\w+)'?$/'$1'/;
+ if ($attrs[$idx] =~ m/[,%]/) {
+ # contains a meta character.
+ push( @wh, q{( } . join ( " OR "
+ , map { m/\%/
+ ? qq{$flds[$idx] ILIKE $_ }
+ : qq{$flds[$idx] = $_ }
+ } (split /,/, $attrs[$idx]) )
+ . q{ )}
+ );
+ }
+ else {
+ push( @wh, qq{$flds[$idx] = $attrs[$idx]} );
+ }
+ }
+ }
+
+ my $wh = ""; # ();
+ $wh = join( " AND ", '', @wh ) if (@wh);
+ my $version = DBD::Pg::pg_server_version($dbh);
+ $version =~ /^(\d+\.\d+)/;
+ $version = $1;
+ my $showschema = $version < 7.3 ? "NULL::text" : "n.nspname";
+ my $schemajoin = $version < 7.3 ? "" : "LEFT JOIN pg_catalog.pg_namespace n ON (n.oid = c.relnamespace)";
+ my $col_info_sql = qq{
+ SELECT
+ NULL::text AS "TABLE_CAT"
+ , $showschema AS "TABLE_SCHEM"
+ , c.relname AS "TABLE_NAME"
+ , a.attname AS "COLUMN_NAME"
+ , t.typname AS "DATA_TYPE"
+ , NULL::text AS "TYPE_NAME"
+ , a.attlen AS "COLUMN_SIZE"
+ , NULL::text AS "BUFFER_LENGTH"
+ , NULL::text AS "DECIMAL_DIGITS"
+ , NULL::text AS "NUM_PREC_RADIX"
+ , a.attnotnull AS "NULLABLE"
+ , NULL::text AS "REMARKS"
+ , a.atthasdef AS "COLUMN_DEF"
+ , NULL::text AS "SQL_DATA_TYPE"
+ , NULL::text AS "SQL_DATETIME_SUB"
+ , NULL::text AS "CHAR_OCTET_LENGTH"
+ , a.attnum AS "ORDINAL_POSITION"
+ , a.attnotnull AS "IS_NULLABLE"
+ , a.atttypmod as atttypmod
+ , a.attnotnull as attnotnull
+ , a.atthasdef as atthasdef
+ , a.attnum as attnum
+ FROM
+ ${CATALOG}pg_attribute a
+ , ${CATALOG}pg_type t
+ , ${CATALOG}pg_class c
+ $schemajoin
+ WHERE
+ a.attrelid = c.oid
+ AND a.attnum >= 0
+ AND t.oid = a.atttypid
+ AND c.relkind in ('r','v')
+ $wh
+ ORDER BY 2, 3, 4
+ };
+
+ my $sth = $dbh->prepare( $col_info_sql ) or return undef;
+ $sth->execute();
+
+ return $sth;
+ }
+
+ sub primary_key_info {
+ my $dbh = shift;
+ my ($catalog, $schema, $table) = @_;
+ my @attrs = @_;
+ my $CATALOG = DBD::Pg::pg_use_catalog($dbh);
+
+ # TABLE_CAT:, TABLE_SCHEM:, TABLE_NAME:, COLUMN_NAME:, KEY_SEQ:
+ # , PK_NAME:
+
+ my @wh = (); my @dat = (); # Used to hold data for the attributes.
+
+ my $version = DBD::Pg::pg_server_version($dbh);
+ $version =~ /^(\d+\.\d+)/;
+ $version = $1;
+
+ my @flds = qw/catname u.usename bc.relname/;
+ $flds[1] = 'n.nspname' unless ($version < 7.3);
+
+ for my $idx (0 .. $#attrs) {
+ next if ($flds[$idx] eq 'catname'); # Skip catalog
+ if(defined $attrs[$idx] and length $attrs[$idx]) {
+ if ($attrs[$idx] =~ m/[,%_?]/) {
+ # contains a meta character.
+ push( @wh, q{( } . join ( " OR "
+ , map { push(@dat, $_);
+ m/[%_?]/
+ ? qq{$flds[$idx] iLIKE ? }
+ : qq{$flds[$idx] = ? }
+ } (split /,/, $attrs[$idx]) )
+ . q{ )}
+ );
+ }
+ else {
+ push( @dat, $attrs[$idx] );
+ push( @wh, qq{$flds[$idx] = ? } );
+ }
+ }
+ }
+
+ my $wh = '';
+ $wh = join( " AND ", '', @wh ) if (@wh);
+
+ # Base primary key selection query borrowed from phpPgAdmin.
+ my $showschema = $version < 7.3 ? "NULL::text" : "n.nspname";
+ my $schemajoin = $version < 7.3 ? "" : "LEFT JOIN pg_catalog.pg_namespace n ON (n.oid = bc.relnamespace)";
+ my $pri_key_sql = qq{
+ SELECT
+ NULL::text AS "TABLE_CAT"
+ , $showschema AS "TABLE_SCHEM"
+ , bc.relname AS "TABLE_NAME"
+ , a.attname AS "COLUMN_NAME"
+ , a.attnum AS "KEY_SEQ"
+ , ic.relname AS "PK_NAME"
+ FROM
+ ${CATALOG}pg_index i
+ , ${CATALOG}pg_attribute a
+ , ${CATALOG}pg_class ic
+ , ${CATALOG}pg_class bc
+ $schemajoin
+ WHERE
+ i.indrelid = bc.oid
+ AND i.indexrelid = ic.oid
+ AND
+ (
+ i.indkey[0] = a.attnum
+ OR
+ i.indkey[1] = a.attnum
+ OR
+ i.indkey[2] = a.attnum
+ OR
+ i.indkey[3] = a.attnum
+ OR
+ i.indkey[4] = a.attnum
+ OR
+ i.indkey[5] = a.attnum
+ OR
+ i.indkey[6] = a.attnum
+ OR
+ i.indkey[7] = a.attnum
+ OR
+ i.indkey[8] = a.attnum
+ OR
+ i.indkey[9] = a.attnum
+ OR
+ i.indkey[10] = a.attnum
+ OR
+ i.indkey[11] = a.attnum
+ OR
+ i.indkey[12] = a.attnum
+ )
+ AND a.attrelid = bc.oid
+ AND i.indproc = '0'::oid
+ AND i.indisprimary = 't'
+ $wh
+ ORDER BY 2, 3, 5
+ };
+
+ my $sth = $dbh->prepare( $pri_key_sql ) or return undef;
+ $sth->execute(@dat);
+
+ return $sth;
+ }
+
+ sub foreign_key_info {
+ # todo: verify schema work as expected
+ # add code to handle multiple-column keys correctly
+ # return something nicer for pre-7.3?
+ # try to clean up SQL, perl code
+ # create a test script?
+
+ my $dbh = shift;
+ my ($pk_catalog, $pk_schema, $pk_table,
+ $fk_catalog, $fk_schema, $fk_table) = @_;
+
+ # this query doesn't work for Postgres before 7.3
+ my $version = $dbh->pg_server_version;
+ $version =~ /^(\d+)\.(\d)/;
+ return undef if ($1.$2 < 73);
+
+ # Used to hold data for the attributes.
+ my @dat = ();
+
+ # SQL to find primary/unique keys of a table
+ my $pkey_sql = qq{
+ SELECT
+ NULL::text AS PKTABLE_CAT,
+ pknam.nspname AS PKTABLE_SCHEM,
+ pkc.relname AS PKTABLE_NAME,
+ pka.attname AS PKCOLUMN_NAME,
+ NULL::text AS FKTABLE_CAT,
+ NULL::text AS FKTABLE_SCHEM,
+ NULL::text AS FKTABLE_NAME,
+ NULL::text AS FKCOLUMN_NAME,
+ pkcon.conkey[1] AS KEY_SEQ,
+ CASE
+ WHEN pkcon.confupdtype = 'c' THEN 0
+ WHEN pkcon.confupdtype = 'r' THEN 1
+ WHEN pkcon.confupdtype = 'n' THEN 2
+ WHEN pkcon.confupdtype = 'a' THEN 3
+ WHEN pkcon.confupdtype = 'd' THEN 4
+ END AS UPDATE_RULE,
+ CASE
+ WHEN pkcon.confdeltype = 'c' THEN 0
+ WHEN pkcon.confdeltype = 'r' THEN 1
+ WHEN pkcon.confdeltype = 'n' THEN 2
+ WHEN pkcon.confdeltype = 'a' THEN 3
+ WHEN pkcon.confdeltype = 'd' THEN 4
+ END AS DELETE_RULE,
+ NULL::text AS FK_NAME,
+ pkcon.conname AS PK_NAME,
+ CASE
+ WHEN pkcon.condeferrable = 'f' THEN 7
+ WHEN pkcon.condeferred = 't' THEN 6
+ WHEN pkcon.condeferred = 'f' THEN 5
+ END AS DEFERRABILITY,
+ CASE
+ WHEN pkcon.contype = 'p' THEN 'PRIMARY'
+ WHEN pkcon.contype = 'u' THEN 'UNIQUE'
+ END AS UNIQUE_OR_PRIMARY
+ FROM
+ pg_constraint AS pkcon
+ JOIN
+ pg_class pkc ON pkc.oid=pkcon.conrelid
+ JOIN
+ pg_namespace pknam ON pkcon.connamespace=pknam.oid
+ JOIN
+ pg_attribute pka ON pka.attnum=pkcon.conkey[1] AND pka.attrelid=pkc.oid
+ };
+
+ # SQL to find foreign keys of a table
+ my $fkey_sql = qq{
+ SELECT
+ NULL::text AS PKTABLE_CAT,
+ pknam.nspname AS PKTABLE_SCHEM,
+ pkc.relname AS PKTABLE_NAME,
+ pka.attname AS PKCOLUMN_NAME,
+ NULL::text AS FKTABLE_CAT,
+ fknam.nspname AS FKTABLE_SCHEM,
+ fkc.relname AS FKTABLE_NAME,
+ fka.attname AS FKCOLUMN_NAME,
+ fkcon.conkey[1] AS KEY_SEQ,
+ CASE
+ WHEN fkcon.confupdtype = 'c' THEN 0
+ WHEN fkcon.confupdtype = 'r' THEN 1
+ WHEN fkcon.confupdtype = 'n' THEN 2
+ WHEN fkcon.confupdtype = 'a' THEN 3
+ WHEN fkcon.confupdtype = 'd' THEN 4
+ END AS UPDATE_RULE,
+ CASE
+ WHEN fkcon.confdeltype = 'c' THEN 0
+ WHEN fkcon.confdeltype = 'r' THEN 1
+ WHEN fkcon.confdeltype = 'n' THEN 2
+ WHEN fkcon.confdeltype = 'a' THEN 3
+ WHEN fkcon.confdeltype = 'd' THEN 4
+ END AS DELETE_RULE,
+ fkcon.conname AS FK_NAME,
+ pkcon.conname AS PK_NAME,
+ CASE
+ WHEN fkcon.condeferrable = 'f' THEN 7
+ WHEN fkcon.condeferred = 't' THEN 6
+ WHEN fkcon.condeferred = 'f' THEN 5
+ END AS DEFERRABILITY,
+ CASE
+ WHEN pkcon.contype = 'p' THEN 'PRIMARY'
+ WHEN pkcon.contype = 'u' THEN 'UNIQUE'
+ END AS UNIQUE_OR_PRIMARY
+ FROM
+ pg_constraint AS fkcon
+ JOIN
+ pg_constraint AS pkcon ON fkcon.confrelid=pkcon.conrelid
+ AND fkcon.confkey=pkcon.conkey
+ JOIN
+ pg_class fkc ON fkc.oid=fkcon.conrelid
+ JOIN
+ pg_class pkc ON pkc.oid=fkcon.confrelid
+ JOIN
+ pg_namespace pknam ON pkcon.connamespace=pknam.oid
+ JOIN
+ pg_namespace fknam ON fkcon.connamespace=fknam.oid
+ JOIN
+ pg_attribute fka ON fka.attnum=fkcon.conkey[1] AND fka.attrelid=fkc.oid
+ JOIN
+ pg_attribute pka ON pka.attnum=pkcon.conkey[1] AND pka.attrelid=pkc.oid
+ };
+
+ # if schema are provided, use this SQL
+ my $pk_schema_sql = " AND pknam.nspname = ? ";
+ my $fk_schema_sql = " AND fknam.nspname = ? ";
+
+ my $key_sql;
+
+ # if $fk_table: generate SQL stub, which will be same
+ # whether or not $pk_table supplied
+ if ($fk_table)
+ {
+ $key_sql = $fkey_sql . qq{
+ WHERE
+ fkc.relname = ?
+ };
+ push @dat, $fk_table;
+
+ if ($fk_schema)
+ {
+ $key_sql .= $fk_schema_sql;
+ push @dat,$fk_schema;
+ }
+ }
+
+ # if $fk_table and $pk_table: (defined by DBI, not SQL/CLI)
+ # return foreign key of $fk_table that refers to $pk_table
+ # (if any)
+ if ($pk_table and $fk_table)
+ {
+ $key_sql .= qq{
+ AND
+ pkc.relname = ?
+ };
+ push @dat, $pk_table;
+
+ if ($pk_schema)
+ {
+ $key_sql .= $pk_schema_sql;
+ push @dat,$pk_schema;
+ }
+ }
+
+ # if $fk_table but no $pk_table:
+ # return all foreign keys of $fk_table, and all
+ # primary keys of tables to which $fk_table refers
+ if (!$pk_table and $fk_table)
+ {
+ # find primary/unique keys referenced by $fk_table
+ # (this one is a little tricky)
+ $key_sql .= ' UNION ' . $pkey_sql . qq{
+ WHERE
+ pkcon.conname IN
+ (
+ SELECT
+ pkcon.conname
+ FROM
+ pg_constraint AS fkcon
+ JOIN
+ pg_constraint AS pkcon ON fkcon.confrelid=pkcon.conrelid AND
+ fkcon.confkey=pkcon.conkey
+ JOIN
+ pg_class fkc ON fkc.oid=fkcon.conrelid
+ WHERE
+ fkc.relname = ?
+ )
+ };
+ push @dat, $fk_table;
+
+ if ($fk_schema)
+ {
+ $key_sql .= $pk_schema_sql;
+ push @dat,$fk_schema;
+ }
+ }
+
+ # if $pk_table but no $fk_table:
+ # return primary key of $pk_table and all foreign keys
+ # that reference $pk_table
+ # question: what about unique keys?
+ # (DBI and SQL/CLI both state to omit unique keys)
+
+ if ($pk_table and !$fk_table)
+ {
+ # find primary key (only!) of $pk_table
+ $key_sql = $pkey_sql . qq{
+ WHERE
+ pkc.relname = ?
+ AND
+ pkcon.contype = 'p'
+ };
+ @dat = ($pk_table);
+
+ if ($pk_schema)
+ {
+ $key_sql .= $pk_schema_sql;
+ push @dat,$pk_schema;
+ }
+
+ # find all foreign keys that reference $pk_table
+ $key_sql .= 'UNION ' . $fkey_sql . qq{
+ WHERE
+ pkc.relname = ?
+ AND
+ pkcon.contype = 'p'
+ };
+ push @dat, $pk_table;
+
+ if ($pk_schema)
+ {
+ $key_sql .= $fk_schema_sql;
+ push @dat,$pk_schema;
+ }
+ }
+
+ return undef unless $key_sql;
+ my $sth = $dbh->prepare( $key_sql ) or
+ return undef;
+ $sth->execute(@dat);
+
+ return $sth;
+ }
+
+
+ sub table_info { # DBI spec: TABLE_CAT, TABLE_SCHEM, TABLE_NAME, TABLE_TYPE, REMARKS
+ my $dbh = shift;
+ my ($catalog, $schema, $table, $type) = @_;
+ my @attrs = @_;
+
+ my $tbl_sql = ();
+
+ my $version = DBD::Pg::pg_server_version($dbh);
+ $version =~ /^(\d+\.\d+)/;
+ $version = $1;
+ my $CATALOG = DBD::Pg::pg_use_catalog($dbh);
+
+ if ( # Rules 19a
+ (defined $catalog and $catalog eq '%')
+ and (defined $schema and $schema eq '')
+ and (defined $table and $table eq '')
+ ) {
+ $tbl_sql = q{
+ SELECT
+ NULL::text AS "TABLE_CAT"
+ , NULL::text AS "TABLE_SCHEM"
+ , NULL::text AS "TABLE_NAME"
+ , NULL::text AS "TABLE_TYPE"
+ , NULL::text AS "REMARKS"
+ };
+ }
+ elsif (# Rules 19b
+ (defined $catalog and $catalog eq '')
+ and (defined $schema and $schema eq '%')
+ and (defined $table and $table eq '')
+ ) {
+ $tbl_sql = ($version < 7.3) ? q{
+ SELECT
+ NULL::text AS "TABLE_CAT"
+ , NULL::text AS "TABLE_SCHEM"
+ , NULL::text AS "TABLE_NAME"
+ , NULL::text AS "TABLE_TYPE"
+ , NULL::text AS "REMARKS"
+ } : q{
+ SELECT
+ NULL::text AS "TABLE_CAT"
+ , n.nspname AS "TABLE_SCHEM"
+ , NULL::text AS "TABLE_NAME"
+ , NULL::text AS "TABLE_TYPE"
+ , NULL::text AS "REMARKS"
+ FROM pg_catalog.pg_namespace n
+ ORDER BY 1
+ };
+ }
+ elsif (# Rules 19c
+ (defined $catalog and $catalog eq '')
+ and (defined $schema and $schema eq '')
+ and (defined $table and $table eq '')
+ and (defined $type and $type eq '%')
+ ) {
+ # From the postgresql 7.2.1 manual 3.5 pg_class
+ # 'r' = ordinary table
+ #, 'i' = index
+ #, 'S' = sequence
+ #, 'v' = view
+ #, 's' = special
+ #, 't' = secondary TOAST table
+ $tbl_sql = q{
+ SELECT
+ NULL::text AS "TABLE_CAT"
+ , NULL::text AS "TABLE_SCHEM"
+ , NULL::text AS "TABLE_NAME"
+ , 'table' AS "TABLE_TYPE"
+ , 'ordinary table - r' AS "REMARKS"
+ union
+ SELECT
+ NULL::text AS "TABLE_CAT"
+ , NULL::text AS "TABLE_SCHEM"
+ , NULL::text AS "TABLE_NAME"
+ , 'index' AS "TABLE_TYPE"
+ , 'index - i' AS "REMARKS"
+ union
+ SELECT
+ NULL::text AS "TABLE_CAT"
+ , NULL::text AS "TABLE_SCHEM"
+ , NULL::text AS "TABLE_NAME"
+ , 'sequence' AS "TABLE_TYPE"
+ , 'sequence - S' AS "REMARKS"
+ union
+ SELECT
+ NULL::text AS "TABLE_CAT"
+ , NULL::text AS "TABLE_SCHEM"
+ , NULL::text AS "TABLE_NAME"
+ , 'view' AS "TABLE_TYPE"
+ , 'view - v' AS "REMARKS"
+ union
+ SELECT
+ NULL::text AS "TABLE_CAT"
+ , NULL::text AS "TABLE_SCHEM"
+ , NULL::text AS "TABLE_NAME"
+ , 'special' AS "TABLE_TYPE"
+ , 'special - s' AS "REMARKS"
+ union
+ SELECT
+ NULL::text AS "TABLE_CAT"
+ , NULL::text AS "TABLE_SCHEM"
+ , NULL::text AS "TABLE_NAME"
+ , 'secondary' AS "TABLE_TYPE"
+ , 'secondary TOAST table - t' AS "REMARKS"
+ };
+ }
+ else {
+ # Default SQL
+ my $showschema = $version < 7.3 ? "NULL::text" : "n.nspname";
+ my $schemajoin = $version < 7.3 ? "" : "LEFT JOIN pg_catalog.pg_namespace n ON (n.oid = c.relnamespace)";
+ my $schemacase = $version < 7.3 ? "CASE WHEN c.relname ~ '^pg_' THEN 'SYSTEM TABLE' ELSE 'TABLE' END" :
+ "CASE WHEN n.nspname ~ '^pg_' THEN 'SYSTEM TABLE' ELSE 'TABLE' END";
+ $tbl_sql = qq{
+ SELECT NULL::text AS "TABLE_CAT"
+ , $showschema AS "TABLE_SCHEM"
+ , c.relname AS "TABLE_NAME"
+ , CASE
+ WHEN c.relkind = 'v' THEN 'VIEW'
+ ELSE $schemacase
+ END AS "TABLE_TYPE"
+ , d.description AS "REMARKS"
+ FROM ${CATALOG}pg_user AS u
+ , ${CATALOG}pg_class AS c
+ LEFT JOIN
+ ${CATALOG}pg_description AS d
+ ON (c.relfilenode = d.objoid AND d.objsubid = 0)
+ $schemajoin
+ WHERE
+ ((c.relkind = 'r'
+ AND c.relhasrules = FALSE) OR
+ (c.relkind = 'v'
+ AND c.relhasrules = TRUE))
+ AND c.relname !~ '^xin[vx][0-9]+'
+ AND c.relowner = u.usesysid
+ ORDER BY 1, 2, 3
+ };
+
+ # Did we receive any arguments?
+ if (@attrs) {
+ my @wh = ();
+ my @flds = qw/catname n.nspname c.relname c.relkind/;
+
+ for my $idx (0 .. $#attrs) {
+ next if ($flds[$idx] eq 'catname'); # Skip catalog
+ if(defined $attrs[$idx] and length $attrs[$idx]) {
+ # Change the "name" of the types to the real value.
+ if ($flds[$idx] =~ m/relkind/) {
+ $attrs[$idx] =~ s/^\'?table\'?/'r'/i;
+ $attrs[$idx] =~ s/^\'?index\'?/'i'/i;
+ $attrs[$idx] =~ s/^\'?sequence\'?/'S'/i;
+ $attrs[$idx] =~ s/^\'?view\'?/'v'/i;
+ $attrs[$idx] =~ s/^\'?special\'?/'s'/i;
+ $attrs[$idx] =~ s/^\'?secondary\'?/'t'/i;
+ }
+ # Insure that the value is enclosed in single quotes.
+ $attrs[$idx] =~ s/^'?(\w+)'?$/'$1'/;
+ if ($attrs[$idx] =~ m/[,%]/) {
+ # contains a meta character.
+ push( @wh, q{( } . join ( " OR "
+ , map { m/\%/
+ ? qq{$flds[$idx] LIKE $_ }
+ : qq{$flds[$idx] = $_ }
+ } (split /,/, $attrs[$idx]) )
+ . q{ )}
+ );
+ }
+ else {
+ push( @wh, qq{$flds[$idx] = $attrs[$idx]} );
+ }
+ }
+ }
+
+ my $wh = ();
+ if (@wh) {
+ $wh = join( " AND ",'', @wh );
+ $tbl_sql = qq{
+ SELECT NULL::text AS "TABLE_CAT"
+ , $showschema AS "TABLE_SCHEM"
+ , c.relname AS "TABLE_NAME"
+ , CASE
+ WHEN c.relkind = 'r' THEN
+ CASE WHEN n.nspname ~ '^pg_' THEN 'SYSTEM TABLE' ELSE 'TABLE' END
+ WHEN c.relkind = 'v' THEN 'VIEW'
+ WHEN c.relkind = 'i' THEN 'INDEX'
+ WHEN c.relkind = 'S' THEN 'SEQUENCE'
+ WHEN c.relkind = 's' THEN 'SPECIAL'
+ WHEN c.relkind = 't' THEN 'SECONDARY'
+ ELSE 'UNKNOWN'
+ END AS "TABLE_TYPE"
+ , d.description AS "REMARKS"
+ FROM ${CATALOG}pg_class AS c
+ LEFT JOIN
+ ${CATALOG}pg_description AS d
+ ON (c.relfilenode = d.objoid AND d.objsubid = 0)
+ $schemajoin
+ WHERE
+ c.relname !~ '^xin[vx][0-9]+'
+ $wh
+ ORDER BY 2, 3
+ };
+ }
+ }
+ }
+
+ my $sth = $dbh->prepare( $tbl_sql ) or return undef;
+ $sth->execute();
+
+ return $sth;
+ }
+
+
+ sub tables {
+ my($dbh) = @_;
+ my $version = DBD::Pg::pg_server_version($dbh);
+ $version =~ /^(\d+\.\d+)/;
+ $version = $1;
+ my $SQL = ($version < 7.3) ?
+ "SELECT relname AS \"TABLE_NAME\"
+ FROM pg_class
+ WHERE relkind = 'r'
+ AND relname !~ '^pg_'
+ AND relname !~ '^xin[vx][0-9]+'
+ ORDER BY 1" :
+ "SELECT n.nspname AS \"SCHEMA_NAME\", c.relname AS \"TABLE_NAME\"
+ FROM pg_catalog.pg_class c
+ LEFT JOIN pg_catalog.pg_namespace n ON (n.oid = c.relnamespace)
+ WHERE c.relkind = 'r'
+ AND n.nspname NOT IN ('pg_catalog', 'pg_toast')
+ AND pg_catalog.pg_table_is_visible(c.oid)
+ ORDER BY 1,2";
+ my $sth = $dbh->prepare($SQL) or return undef;
+ $sth->execute or return undef;
+ my (@tables, @relname);
+ while (@relname = $sth->fetchrow_array) {
+ push @tables, $version < 7.3 ? $relname[0] : "$relname[0].$relname[1]";
+ }
+ $sth->finish;
+
+ return @tables;
+ }
+
+
+ sub table_attributes {
+ my ($dbh, $table) = @_;
+ my $CATALOG = DBD::Pg::pg_use_catalog($dbh);
+ my $result = [];
+ my $attrs = $dbh->selectall_arrayref(
+ "select a.attname, t.typname, a.attlen, a.atttypmod, a.attnotnull, a.atthasdef, a.attnum
+ from ${CATALOG}pg_attribute a,
+ ${CATALOG}pg_class c,
+ ${CATALOG}pg_type t
+ where c.relname = ?
+ and a.attrelid = c.oid
+ and a.attnum >= 0
+ and t.oid = a.atttypid
+ order by 1
+ ", undef, $table);
+
+ return $result unless scalar(@$attrs);
+
+ # Select the array value for tables primary key.
+ my $pk_key_sql = qq{SELECT pg_index.indkey
+ FROM ${CATALOG}pg_class, ${CATALOG}pg_index
+ WHERE
+ pg_class.oid = pg_index.indrelid
+ AND pg_class.relname = '$table'
+ AND pg_index.indisprimary = 't'
+ };
+ # Expand this (returned as a string) a real array.
+ my @pk = ();
+ my $pkeys = $dbh->selectrow_array( $pk_key_sql );
+ if (defined $pkeys) {
+ foreach (split( /\s+/, $pkeys))
+ {
+ push @pk, $_;
+ }
+ }
+ my $pk_bt =
+ (@pk) ? "AND pg_attribute.attnum in (" . join ( ", ", @pk ) . ")"
+ : "";
+
+ # Get the primary key
+ my $pri_key = $dbh->selectcol_arrayref("SELECT pg_attribute.attname
+ FROM ${CATALOG}pg_class, ${CATALOG}pg_attribute, ${CATALOG}pg_index
+ WHERE pg_class.oid = pg_attribute.attrelid
+ AND pg_class.oid = pg_index.indrelid
+ $pk_bt
+ AND pg_index.indisprimary = 't'
+ AND pg_class.relname = ?
+ ORDER BY pg_attribute.attnum
+ ", undef, $table );
+ $pri_key = [] unless $pri_key;
+
+ foreach my $attr (reverse @$attrs) {
+ my ($col_name, $col_type, $size, $mod, $notnull, $hasdef, $attnum) = @$attr;
+ my $col_size = do {
+ if ($size > 0) {
+ $size;
+ } elsif ($mod > 0xffff) {
+ my $prec = ($mod & 0xffff) - 4;
+ $mod >>= 16;
+ my $dig = $mod;
+ $dig;
+ } elsif ($mod >= 4) {
+ $mod - 4;
+ } else {
+ $mod;
+ }
+ };
+
+ # Get the default value, if any
+ my ($default) = $dbh->selectrow_array("SELECT adsrc FROM ${CATALOG}pg_attrdef WHERE adnum = $attnum") if -1 == $attnum;
+ $default = '' unless $default;
+
+ # Test for any constraints
+ # Note: as of PostgreSQL 7.3 pg_relcheck has been replaced
+ # by pg_constraint. To maintain compatibility, check
+ # version number and execute appropriate query.
+
+ my $version = pg_server_version( $dbh );
+
+ my $con_query = $version < 7.3
+ ? "SELECT rcsrc FROM pg_relcheck WHERE rcname = '${table}_$col_name'"
+ : "SELECT consrc FROM pg_catalog.pg_constraint WHERE contype = 'c' AND conname = '${table}_$col_name'";
+ my ($constraint) = $dbh->selectrow_array($con_query);
+ $constraint = '' unless $constraint;
+
+ # Check to see if this is the primary key
+ my $is_primary_key = scalar(grep { /^$col_name$/i } @$pri_key) ? 1 : 0;
+
+ push @$result,
+ { NAME => $col_name,
+ TYPE => $col_type,
+ SIZE => $col_size,
+ NOTNULL => $notnull,
+ DEFAULT => $default,
+ CONSTRAINT => $constraint,
+ PRIMARY_KEY => $is_primary_key,
+ };
+ }
+
+ return $result;
+ }
+
+
+ sub type_info_all {
+ my ($dbh) = @_;
+
+ #my $names = {
+ # TYPE_NAME => 0,
+ # DATA_TYPE => 1,
+ # PRECISION => 2,
+ # LITERAL_PREFIX => 3,
+ # LITERAL_SUFFIX => 4,
+ # CREATE_PARAMS => 5,
+ # NULLABLE => 6,
+ # CASE_SENSITIVE => 7,
+ # SEARCHABLE => 8,
+ # UNSIGNED_ATTRIBUTE => 9,
+ # MONEY =>10,
+ # AUTO_INCREMENT =>11,
+ # LOCAL_TYPE_NAME =>12,
+ # MINIMUM_SCALE =>13,
+ # MAXIMUM_SCALE =>14,
+ # };
+
+ my $names = {
+ TYPE_NAME => 0,
+ DATA_TYPE => 1,
+ COLUMN_SIZE => 2, # was PRECISION originally
+ LITERAL_PREFIX => 3,
+ LITERAL_SUFFIX => 4,
+ CREATE_PARAMS => 5,
+ NULLABLE => 6,
+ CASE_SENSITIVE => 7,
+ SEARCHABLE => 8,
+ UNSIGNED_ATTRIBUTE=> 9,
+ FIXED_PREC_SCALE => 10, # was MONEY originally
+ AUTO_UNIQUE_VALUE => 11, # was AUTO_INCREMENT originally
+ LOCAL_TYPE_NAME => 12,
+ MINIMUM_SCALE => 13,
+ MAXIMUM_SCALE => 14,
+ NUM_PREC_RADIX => 15,
+ };
+
+
+ # typname |typlen|typprtlen| SQL92
+ # --------------+------+---------+ -------
+ # bool | 1| 1| BOOLEAN
+ # text | -1| -1| like VARCHAR, but automatic storage allocation
+ # bpchar | -1| -1| CHARACTER(n) bp=blank padded
+ # varchar | -1| -1| VARCHAR(n)
+ # int2 | 2| 5| SMALLINT
+ # int4 | 4| 10| INTEGER
+ # int8 | 8| 20| /
+ # money | 4| 24| /
+ # float4 | 4| 12| FLOAT(p) for p<7=float4, for p<16=float8
+ # float8 | 8| 24| REAL
+ # abstime | 4| 20| /
+ # reltime | 4| 20| /
+ # tinterval | 12| 47| /
+ # date | 4| 10| /
+ # time | 8| 16| /
+ # datetime | 8| 47| /
+ # timespan | 12| 47| INTERVAL
+ # timestamp | 4| 19| TIMESTAMP
+ # --------------+------+---------+
+
+ # DBI type definitions / PostgreSQL definitions # type needs to be DBI-specific (not pg_type)
+ #
+ # SQL_ALL_TYPES 0
+ # SQL_CHAR 1 1042 bpchar
+ # SQL_NUMERIC 2 700 float4
+ # SQL_DECIMAL 3 700 float4
+ # SQL_INTEGER 4 23 int4
+ # SQL_SMALLINT 5 21 int2
+ # SQL_FLOAT 6 700 float4
+ # SQL_REAL 7 701 float8
+ # SQL_DOUBLE 8 20 int8
+ # SQL_DATE 9 1082 date
+ # SQL_TIME 10 1083 time
+ # SQL_TIMESTAMP 11 1296 timestamp
+ # SQL_VARCHAR 12 1043 varchar
+
+ my $ti = [
+ $names,
+ # name type prec prefix suffix create params null case se unsign mon incr local min max
+ #
+ [ 'bytea', -2, 4096, '\'', '\'', undef, 1, '1', 3, undef, '0', '0', 'BYTEA', undef, undef, undef ],
+ [ 'bool', 0, 1, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'BOOLEAN', undef, undef, undef ],
+ [ 'int8', 8, 20, undef, undef, undef, 1, '0', 2, '0', '0', '0', 'LONGINT', undef, undef, undef ],
+ [ 'int2', 5, 5, undef, undef, undef, 1, '0', 2, '0', '0', '0', 'SMALLINT', undef, undef, undef ],
+ [ 'int4', 4, 10, undef, undef, undef, 1, '0', 2, '0', '0', '0', 'INTEGER', undef, undef, undef ],
+ [ 'text', 12, 4096, '\'', '\'', undef, 1, '1', 3, undef, '0', '0', 'TEXT', undef, undef, undef ],
+ [ 'float4', 6, 12, undef, undef, 'precision', 1, '0', 2, '0', '0', '0', 'FLOAT', undef, undef, undef ],
+ [ 'float8', 7, 24, undef, undef, 'precision', 1, '0', 2, '0', '0', '0', 'REAL', undef, undef, undef ],
+ [ 'abstime', 10, 20, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'ABSTIME', undef, undef, undef ],
+ [ 'reltime', 10, 20, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'RELTIME', undef, undef, undef ],
+ [ 'tinterval', 11, 47, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'TINTERVAL', undef, undef, undef ],
+ [ 'money', 0, 24, undef, undef, undef, 1, '0', 2, undef, '1', '0', 'MONEY', undef, undef, undef ],
+ [ 'bpchar', 1, 4096, '\'', '\'', 'max length', 1, '1', 3, undef, '0', '0', 'CHARACTER', undef, undef, undef ],
+ [ 'bpchar', 12, 4096, '\'', '\'', 'max length', 1, '1', 3, undef, '0', '0', 'CHARACTER', undef, undef, undef ],
+ [ 'varchar', 12, 4096, '\'', '\'', 'max length', 1, '1', 3, undef, '0', '0', 'VARCHAR', undef, undef, undef ],
+ [ 'date', 9, 10, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'DATE', undef, undef, undef ],
+ [ 'time', 10, 16, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'TIME', undef, undef, undef ],
+ [ 'datetime', 11, 47, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'DATETIME', undef, undef, undef ],
+ [ 'timespan', 11, 47, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'INTERVAL', undef, undef, undef ],
+ [ 'timestamp', 10, 19, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'TIMESTAMP', undef, undef, undef ]
+ #
+ # intentionally omitted: char, all geometric types, all array types
+ ];
+ return $ti;
+ }
+
+
+ # Characters that need to be escaped by quote().
+ my %esc = ( "'" => '\\047', # '\\' . sprintf("%03o", ord("'")), # ISO SQL 2
+ '\\' => '\\134', # '\\' . sprintf("%03o", ord("\\")),
+ );
+
+ # Set up lookup for SQL types we don't want to escape.
+ my %no_escape = map { $_ => 1 }
+ DBI::SQL_INTEGER, DBI::SQL_SMALLINT, DBI::SQL_DECIMAL,
+ DBI::SQL_FLOAT, DBI::SQL_REAL, DBI::SQL_DOUBLE, DBI::SQL_NUMERIC;
+
+ sub quote {
+ my ($dbh, $str, $data_type) = @_;
+ return "NULL" unless defined $str;
+ return $str if $data_type && $no_escape{$data_type};
+
+ $dbh->DBI::set_err(1, "Use of SQL_BINARY invalid in quote()")
+ if $data_type && $data_type == DBI::SQL_BINARY;
+
+ $str =~ s/(['\\\0])/$esc{$1}/g;
+ return "'$str'";
+ }
+
+} # end of package DBD::Pg::db
+
+{ package DBD::Pg::st; # ====== STATEMENT ======
+
+ # all done in XS
+
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+DBD::Pg - PostgreSQL database driver for the DBI module
+
+=head1 SYNOPSIS
+
+ use DBI;
+
+ $dbh = DBI->connect("dbi:Pg:dbname=$dbname", "", "");
+
+ # for some advanced uses you may need PostgreSQL type values:
+ use DBD::Oracle qw(:pg_types);
+
+ # See the DBI module documentation for full details
+
+=head1 DESCRIPTION
+
+DBD::Pg is a Perl module which works with the DBI module to provide access to
+PostgreSQL databases.
+
+=head1 MODULE DOCUMENTATION
+
+This documentation describes driver specific behavior and restrictions. It is
+not supposed to be used as the only reference for the user. In any case
+consult the DBI documentation first!
+
+=head1 THE DBI CLASS
+
+=head2 DBI Class Methods
+
+=over 4
+
+=item B<connect>
+
+To connect to a database with a minimum of parameters, use the following
+syntax:
+
+ $dbh = DBI->connect("dbi:Pg:dbname=$dbname", "", "");
+
+This connects to the database $dbname at localhost without any user
+authentication. This is sufficient for the defaults of PostgreSQL.
+
+The following connect statement shows all possible parameters:
+
+ $dbh = DBI->connect("dbi:Pg:dbname=$dbname;host=$host;port=$port;" .
+ "options=$options;tty=$tty", "$username", "$password");
+
+If a parameter is undefined PostgreSQL first looks for specific environment
+variables and then it uses hard coded defaults:
+
+ parameter environment variable hard coded default
+ --------------------------------------------------
+ dbname PGDATABASE current userid
+ host PGHOST localhost
+ port PGPORT 5432
+ options PGOPTIONS ""
+ tty PGTTY ""
+ username PGUSER current userid
+ password PGPASSWORD ""
+
+If a host is specified, the postmaster on this host needs to be started with
+the C<-i> option (TCP/IP sockets).
+
+The options parameter specifies runtime options for the Postgres
+backend. Common usage is to increase the number of buffers with the C<-B>
+option. Also important is the C<-F> option, which disables automatic fsync()
+call after each transaction. For further details please refer to the
+L<postgres>.
+
+For authentication with username and password appropriate entries have to be
+made in pg_hba.conf. Please refer to the L<pg_hba.conf> and the L<pg_passwd>
+for the different types of authentication. Note that for these two parameters
+DBI distinguishes between empty and undefined. If these parameters are
+undefined DBI substitutes the values of the environment variables DBI_USER and
+DBI_PASS if present.
+
+=item B<available_drivers>
+
+ @driver_names = DBI->available_drivers;
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<data_sources>
+
+ @data_sources = DBI->data_sources('Pg');
+
+The driver supports this method. Note that the necessary database connection to
+the database template1 will be done on the localhost without any
+user-authentication. Other preferences can only be set with the environment
+variables PGHOST, DBI_USER and DBI_PASS.
+
+=item B<trace>
+
+ DBI->trace($trace_level, $trace_file)
+
+Implemented by DBI, no driver-specific impact.
+
+=back
+
+=head2 DBI Dynamic Attributes
+
+See Common Methods.
+
+=head1 METHODS COMMON TO ALL HANDLES
+
+=over 4
+
+=item B<err>
+
+ $rv = $h->err;
+
+Supported by the driver as proposed by DBI. For the connect method it returns
+PQstatus. In all other cases it returns PQresultStatus of the current handle.
+
+=item B<errstr>
+
+ $str = $h->errstr;
+
+Supported by the driver as proposed by DBI. It returns the PQerrorMessage
+related to the current handle.
+
+=item B<state>
+
+ $str = $h->state;
+
+This driver does not (yet) support the state method.
+
+=item B<trace>
+
+ $h->trace($trace_level, $trace_filename);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<trace_msg>
+
+ $h->trace_msg($message_text);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<func>
+
+This driver supports a variety of driver specific functions accessible via the
+func interface:
+
+ $attrs = $dbh->func($table, 'table_attributes');
+
+This method returns for the given table a reference to an array of hashes:
+
+ NAME attribute name
+ TYPE attribute type
+ SIZE attribute size (-1 for variable size)
+ NULLABLE flag nullable
+ DEFAULT default value
+ CONSTRAINT constraint
+ PRIMARY_KEY flag is_primary_key
+
+ $lobjId = $dbh->func($mode, 'lo_creat');
+
+Creates a new large object and returns the object-id. $mode is a bit-mask
+describing different attributes of the new object. Use the following
+constants:
+
+ $dbh->{pg_INV_WRITE}
+ $dbh->{pg_INV_READ}
+
+Upon failure it returns undef.
+
+ $lobj_fd = $dbh->func($lobjId, $mode, 'lo_open');
+
+Opens an existing large object and returns an object-descriptor for use in
+subsequent lo_* calls. For the mode bits see lo_create. Returns undef upon
+failure. Note that 0 is a perfectly correct object descriptor!
+
+ $nbytes = $dbh->func($lobj_fd, $buf, $len, 'lo_write');
+
+Writes $len bytes of $buf into the large object $lobj_fd. Returns the number
+of bytes written and undef upon failure.
+
+ $nbytes = $dbh->func($lobj_fd, $buf, $len, 'lo_read');
+
+Reads $len bytes into $buf from large object $lobj_fd. Returns the number of
+bytes read and undef upon failure.
+
+ $loc = $dbh->func($lobj_fd, $offset, $whence, 'lo_lseek');
+
+Change the current read or write location on the large object
+$obj_id. Currently $whence can only be 0 (L_SET). Returns the current location
+and undef upon failure.
+
+ $loc = $dbh->func($lobj_fd, 'lo_tell');
+
+Returns the current read or write location on the large object $lobj_fd and
+undef upon failure.
+
+ $lobj_fd = $dbh->func($lobj_fd, 'lo_close');
+
+Closes an existing large object. Returns true upon success and false upon
+failure.
+
+ $lobj_fd = $dbh->func($lobj_fd, 'lo_unlink');
+
+Deletes an existing large object. Returns true upon success and false upon
+failure.
+
+ $lobjId = $dbh->func($filename, 'lo_import');
+
+Imports a Unix file as large object and returns the object id of the new
+object or undef upon failure.
+
+ $ret = $dbh->func($lobjId, 'lo_export', 'filename');
+
+Exports a large object into a Unix file. Returns false upon failure, true
+otherwise.
+
+ $ret = $dbh->func($line, 'putline');
+
+Used together with the SQL-command 'COPY table FROM STDIN' to copy large
+amount of data into a table avoiding the overhead of using single
+insert commands. The application must explicitly send the two characters "\."
+to indicate to the backend that it has finished sending its data. See test.pl
+for an example on how to use this function.
+
+ $ret = $dbh->func($buffer, length, 'getline');
+
+Used together with the SQL-command 'COPY table TO STDOUT' to dump a complete
+table. See test.pl for an example on how to use this function.
+
+ $ret = $dbh->func('pg_notifies');
+
+Returns either undef or a reference to two-element array [ $table,
+$backend_pid ] of asynchronous notifications received.
+
+ $fd = $dbh->func('getfd');
+
+Returns fd of the actual connection to server. Can be used with select() and
+func('pg_notifies').
+
+=back
+
+=head1 ATTRIBUTES COMMON TO ALL HANDLES
+
+=over 4
+
+=item B<Warn> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<Active> (boolean, read-only)
+
+Supported by the driver as proposed by DBI. A database handle is active while
+it is connected and statement handle is active until it is finished.
+
+=item B<Kids> (integer, read-only)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<ActiveKids> (integer, read-only)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<CachedKids> (hash ref)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<CompatMode> (boolean, inherited)
+
+Not used by this driver.
+
+=item B<InactiveDestroy> (boolean)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<PrintError> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<RaiseError> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<HandleError> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<ChopBlanks> (boolean, inherited)
+
+Supported by the driver as proposed by DBI. This method is similar to the
+SQL-function RTRIM.
+
+=item B<LongReadLen> (integer, inherited)
+
+Implemented by DBI, not used by the driver.
+
+=item B<LongTruncOk> (boolean, inherited)
+
+Implemented by DBI, not used by the driver.
+
+=item B<Taint> (boolean, inherited)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<private_*>
+
+Implemented by DBI, no driver-specific impact.
+
+=back
+
+=head1 DBI DATABASE HANDLE OBJECTS
+
+=head2 Database Handle Methods
+
+=over 4
+
+=item B<selectrow_array>
+
+ @row_ary = $dbh->selectrow_array($statement, \%attr, @bind_values);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<selectrow_arrayref>
+
+ $ary_ref = $dbh->selectrow_arrayref($statement, \%attr, @bind_values);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<selectrow_hashref>
+
+ $hash_ref = $dbh->selectrow_hashref($statement, \%attr, @bind_values);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<selectall_arrayref>
+
+ $ary_ref = $dbh->selectall_arrayref($statement, \%attr, @bind_values);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<selectall_hashref>
+
+ $hash_ref = $dbh->selectall_hashref($statement, $key_field);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<selectcol_arrayref>
+
+ $ary_ref = $dbh->selectcol_arrayref($statement, \%attr, @bind_values);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<prepare>
+
+ $sth = $dbh->prepare($statement, \%attr);
+
+PostgreSQL does not have the concept of preparing a statement. Hence the
+prepare method just stores the statement after checking for place-holders. No
+information about the statement is available after preparing it.
+
+=item B<prepare_cached>
+
+ $sth = $dbh->prepare_cached($statement, \%attr);
+
+Implemented by DBI, no driver-specific impact. This method is not useful for
+this driver, because preparing a statement has no database interaction.
+
+=item B<do>
+
+ $rv = $dbh->do($statement, \%attr, @bind_values);
+
+Implemented by DBI, no driver-specific impact. See the notes for the execute
+method elsewhere in this document.
+
+=item B<commit>
+
+ $rc = $dbh->commit;
+
+Supported by the driver as proposed by DBI. See also the notes about
+B<Transactions> elsewhere in this document.
+
+=item B<rollback>
+
+ $rc = $dbh->rollback;
+
+Supported by the driver as proposed by DBI. See also the notes about
+B<Transactions> elsewhere in this document.
+
+=item B<disconnect>
+
+ $rc = $dbh->disconnect;
+
+Supported by the driver as proposed by DBI.
+
+=item B<ping>
+
+ $rc = $dbh->ping;
+
+This driver supports the ping-method, which can be used to check the validity
+of a database-handle. The ping method issues an empty query and checks the
+result status.
+
+=item B<table_info>
+
+ $sth = $dbh->table_info;
+
+Supported by the driver as proposed by DBI. This method returns all tables and
+views which are owned by the current user. It does not select any indexes and
+sequences. Also System tables are not selected. As TABLE_QUALIFIER the reltype
+attribute is returned and the REMARKS are undefined.
+
+=item B<foreign_key_info>
+
+ $sth = $dbh->foreign_key_info( $pk_catalog, $pk_schema, $pk_table,
+ $fk_catalog, $fk_schema, $fk_table );
+
+Supported by the driver as proposed by DBI. Unimplemented for Postgres
+servers before 7.3 (returns undef). Currently only returns information
+about first column of any multiple-column keys.
+
+=item B<tables>
+
+ @names = $dbh->tables;
+
+Supported by the driver as proposed by DBI. This method returns all tables and
+views which are owned by the current user. It does not select any indexes and
+sequences, or system tables.
+
+=item B<type_info_all>
+
+ $type_info_all = $dbh->type_info_all;
+
+Supported by the driver as proposed by DBI. Only for SQL data-types and for
+frequently used data-types information is provided. The mapping between the
+PostgreSQL typename and the SQL92 data-type (if possible) has been done
+according to the following table:
+
+ +---------------+------------------------------------+
+ | typname | SQL92 |
+ |---------------+------------------------------------|
+ | bool | BOOL |
+ | text | / |
+ | bpchar | CHAR(n) |
+ | varchar | VARCHAR(n) |
+ | int2 | SMALLINT |
+ | int4 | INT |
+ | int8 | / |
+ | money | / |
+ | float4 | FLOAT(p) p<7=float4, p<16=float8 |
+ | float8 | REAL |
+ | abstime | / |
+ | reltime | / |
+ | tinterval | / |
+ | date | / |
+ | time | / |
+ | datetime | / |
+ | timespan | TINTERVAL |
+ | timestamp | TIMESTAMP |
+ +---------------+------------------------------------+
+
+For further details concerning the PostgreSQL specific data-types please read
+the L<pgbuiltin>.
+
+=item B<type_info>
+
+ @type_info = $dbh->type_info($data_type);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<quote>
+
+ $sql = $dbh->quote($value, $data_type);
+
+This module implements its own quote method. In addition to the DBI method it
+also doubles the backslash, because PostgreSQL treats a backslash as an escape
+character.
+
+B<NOTE:> The undocumented (and invalid) support for the C<SQL_BINARY> data
+type is officially deprecated. Use C<PG_BYTEA> with C<bind_param()> instead:
+
+ $rv = $sth->bind_param($param_num, $bind_value,
+ { pg_type => DBD::Pg::PG_BYTEA });
+
+=back
+
+=head2 Database Handle Attributes
+
+=over 4
+
+=item B<AutoCommit> (boolean)
+
+Supported by the driver as proposed by DBI. According to the classification of
+DBI, PostgreSQL is a database, in which a transaction must be explicitly
+started. Without starting a transaction, every change to the database becomes
+immediately permanent. The default of AutoCommit is on, which corresponds to
+the default behavior of PostgreSQL. When setting AutoCommit to off, a
+transaction will be started and every commit or rollback will automatically
+start a new transaction. For details see the notes about B<Transactions>
+elsewhere in this document.
+
+=item B<Driver> (handle)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<Name> (string, read-only)
+
+The default method of DBI is overridden by a driver specific method, which
+returns only the database name. Anything else from the connection string is
+stripped off. Note, that here the method is read-only in contrast to the DBI
+specs.
+
+=item B<RowCacheSize> (integer)
+
+Implemented by DBI, not used by the driver.
+
+=item B<pg_auto_escape> (boolean)
+
+PostgreSQL specific attribute. If true, then quotes and backslashes in all
+parameters will be escaped in the following way:
+
+ escape quote with a quote (SQL)
+ escape backslash with a backslash
+
+The default is on. Note, that PostgreSQL also accepts quotes, which are
+escaped by a backslash. Any other ASCII character can be used directly in a
+string constant.
+
+=item B<pg_enable_utf8> (boolean)
+
+PostgreSQL specific attribute. If true, then the utf8 flag will be
+turned for returned character data (if the data is valid utf8). For
+details about the utf8 flag, see L<Encode>. This is only relevant under
+perl 5.8 and higher.
+
+B<NB>: This attribute is experimental and may be subject to change.
+
+=item B<pg_INV_READ> (integer, read-only)
+
+Constant to be used for the mode in lo_creat and lo_open.
+
+=item B<pg_INV_WRITE> (integer, read-only)
+
+Constant to be used for the mode in lo_creat and lo_open.
+
+=back
+
+=head1 DBI STATEMENT HANDLE OBJECTS
+
+=head2 Statement Handle Methods
+
+=over 4
+
+=item B<bind_param>
+
+ $rv = $sth->bind_param($param_num, $bind_value, \%attr);
+
+Supported by the driver as proposed by DBI.
+
+B<NOTE:> The undocumented (and invalid) support for the C<SQL_BINARY>
+SQL type is officially deprecated. Use C<PG_BYTEA> instead:
+
+ $rv = $sth->bind_param($param_num, $bind_value,
+ { pg_type => DBD::Pg::PG_BYTEA });
+
+=item B<bind_param_inout>
+
+Not supported by this driver.
+
+=item B<execute>
+
+ $rv = $sth->execute(@bind_values);
+
+Supported by the driver as proposed by DBI. In addition to 'UPDATE', 'DELETE',
+'INSERT' statements, for which it returns always the number of affected rows,
+the execute method can also be used for 'SELECT ... INTO table' statements.
+
+=item B<fetchrow_arrayref>
+
+ $ary_ref = $sth->fetchrow_arrayref;
+
+Supported by the driver as proposed by DBI.
+
+=item B<fetchrow_array>
+
+ @ary = $sth->fetchrow_array;
+
+Supported by the driver as proposed by DBI.
+
+=item B<fetchrow_hashref>
+
+ $hash_ref = $sth->fetchrow_hashref;
+
+Supported by the driver as proposed by DBI.
+
+=item B<fetchall_arrayref>
+
+ $tbl_ary_ref = $sth->fetchall_arrayref;
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<finish>
+
+ $rc = $sth->finish;
+
+Supported by the driver as proposed by DBI.
+
+=item B<rows>
+
+ $rv = $sth->rows;
+
+Supported by the driver as proposed by DBI. In contrast to many other drivers
+the number of rows is available immediately after executing the statement.
+
+=item B<bind_col>
+
+ $rc = $sth->bind_col($column_number, \$var_to_bind, \%attr);
+
+Supported by the driver as proposed by DBI.
+
+=item B<bind_columns>
+
+ $rc = $sth->bind_columns(\%attr, @list_of_refs_to_vars_to_bind);
+
+Supported by the driver as proposed by DBI.
+
+=item B<dump_results>
+
+ $rows = $sth->dump_results($maxlen, $lsep, $fsep, $fh);
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<blob_read>
+
+ $blob = $sth->blob_read($id, $offset, $len);
+
+Supported by this driver as proposed by DBI. Implemented by DBI but not
+documented, so this method might change.
+
+This method seems to be heavily influenced by the current implementation of
+blobs in Oracle. Nevertheless we try to be as compatible as possible. Whereas
+Oracle suffers from the limitation that blobs are related to tables and every
+table can have only one blob (data-type LONG), PostgreSQL handles its blobs
+independent of any table by using so called object identifiers. This explains
+why the blob_read method is blessed into the STATEMENT package and not part of
+the DATABASE package. Here the field parameter has been used to handle this
+object identifier. The offset and len parameter may be set to zero, in which
+case the driver fetches the whole blob at once.
+
+Starting with PostgreSQL-6.5 every access to a blob has to be put into a
+transaction. This holds even for a read-only access.
+
+See also the PostgreSQL-specific functions concerning blobs which are
+available via the func-interface.
+
+For further information and examples about blobs, please read the chapter
+about Large Objects in the PostgreSQL Programmer's Guide.
+
+=back
+
+=head2 Statement Handle Attributes
+
+=over 4
+
+=item B<NUM_OF_FIELDS> (integer, read-only)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<NUM_OF_PARAMS> (integer, read-only)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<NAME> (array-ref, read-only)
+
+Supported by the driver as proposed by DBI.
+
+=item B<NAME_lc> (array-ref, read-only)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<NAME_uc> (array-ref, read-only)
+
+Implemented by DBI, no driver-specific impact.
+
+=item B<TYPE> (array-ref, read-only)
+
+Supported by the driver as proposed by DBI, with the restriction, that the
+types are PostgreSQL specific data-types which do not correspond to
+international standards.
+
+=item B<PRECISION> (array-ref, read-only)
+
+Not supported by the driver.
+
+=item B<SCALE> (array-ref, read-only)
+
+Not supported by the driver.
+
+=item B<NULLABLE> (array-ref, read-only)
+
+Not supported by the driver.
+
+=item B<CursorName> (string, read-only)
+
+Not supported by the driver. See the note about B<Cursors> elsewhere in this
+document.
+
+=item B<Statement> (string, read-only)
+
+Supported by the driver as proposed by DBI.
+
+=item B<RowCache> (integer, read-only)
+
+Not supported by the driver.
+
+=item B<pg_size> (array-ref, read-only)
+
+PostgreSQL specific attribute. It returns a reference to an array of integer
+values for each column. The integer shows the size of the column in
+bytes. Variable length columns are indicated by -1.
+
+=item B<pg_type> (hash-ref, read-only)
+
+PostgreSQL specific attribute. It returns a reference to an array of strings
+for each column. The string shows the name of the data_type.
+
+=item B<pg_oid_status> (integer, read-only)
+
+PostgreSQL specific attribute. It returns the OID of the last INSERT command.
+
+=item B<pg_cmd_status> (integer, read-only)
+
+PostgreSQL specific attribute. It returns the type of the last
+command. Possible types are: INSERT, DELETE, UPDATE, SELECT.
+
+=back
+
+=head1 FURTHER INFORMATION
+
+=head2 Transactions
+
+The transaction behavior is now controlled with the attribute AutoCommit. For
+a complete definition of AutoCommit please refer to the DBI documentation.
+
+According to the DBI specification the default for AutoCommit is TRUE. In this
+mode, any change to the database becomes valid immediately. Any 'begin',
+'commit' or 'rollback' statement will be rejected.
+
+If AutoCommit is switched-off, immediately a transaction will be started by
+issuing a 'begin' statement. Any 'commit' or 'rollback' will start a new
+transaction. A disconnect will issue a 'rollback' statement.
+
+=head2 Large Objects
+
+The driver supports all large-objects related functions provided by libpq via
+the func-interface. Please note, that starting with PostgreSQL 6.5 any access
+to a large object - even read-only - has to be put into a transaction!
+
+=head2 Cursors
+
+Although PostgreSQL has a cursor concept, it has not been used in the current
+implementation. Cursors in PostgreSQL can only be used inside a transaction
+block. Because only one transaction block at a time is allowed, this would
+have implied the restriction, not to use any nested SELECT statements. Hence
+the execute method fetches all data at once into data structures located in
+the frontend application. This has to be considered when selecting large
+amounts of data!
+
+=head2 Data-Type bool
+
+The current implementation of PostgreSQL returns 't' for true and 'f' for
+false. From the Perl point of view a rather unfortunate choice. The DBD::Pg
+module translates the result for the data-type bool in a perl-ish like manner:
+'f' -> '0' and 't' -> '1'. This way the application does not have to check the
+database-specific returned values for the data-type bool, because Perl treats
+'0' as false and '1' as true.
+
+Boolean values can be passed to PostgreSQL as TRUE, 't', 'true', 'y', 'yes' or
+'1' for true and FALSE, 'f', 'false', 'n', 'no' or '0' for false.
+
+=head2 Schema support
+
+PostgreSQL version 7.3 introduced schema support. Note that the PostgreSQL
+schema concept may differ to that of other databases. Please refer to the
+PostgreSQL documentation for more details.
+
+Currently DBD::Pg does not provide explicit support for PostgreSQL schemas.
+However, schema functionality may be used without any restrictions by
+explicitly addressing schema objects, e.g.
+
+ my $res = $dbh->selectall_arrayref("SELECT * FROM my_schema.my_table");
+
+or by manipulating the schema search path with SET search_path, e.g.
+
+ $dbh->do("SET search_path TO my_schema, public");
+
+B<NOTE:> If you create an object with the same name as a PostgreSQL system
+object (as contained in the pg_catalog schema) and explicitly set the search
+path so that pg_catalog comes after the new object's schema, some DBD::Pg
+methods (particularly those querying PostgreSQL system objects) may fail.
+This problem should be fixed in a future release of DBD::Pg. Creating objects
+with the same name as system objects (or beginning with 'pg_') is not
+recommended practice and should be avoided in any case.
+
+=head1 SEE ALSO
+
+L<DBI>
+
+=head1 AUTHORS
+
+DBI and DBD-Oracle by Tim Bunce (Tim.Bunce@ig.co.uk)
+
+DBD-Pg by Edmund Mergl (E.Mergl@bawue.de) and Jeffrey W. Baker
+(jwbaker@acm.org). By David Wheeler <david@wheeler.net>, Jason
+Stewart <jason@openinformatics.com> and Bruce Momjian
+<pgman@candle.pha.pa.us> after v1.13.
+
+Major parts of this package have been copied from DBI and DBD-Oracle.
+
+=head1 COPYRIGHT
+
+The DBD::Pg module is free software. You may distribute under the terms of
+either the GNU General Public License or the Artistic License, as specified in
+the Perl README file.
+
+=head1 ACKNOWLEDGMENTS
+
+See also B<DBI/ACKNOWLEDGMENTS>.
+
+=cut
+
--- /dev/null
+/*
+ $Id: Pg.xs,v 1.1.2.1 2004-04-29 09:40:07 ivan Exp $
+
+ Copyright (c) 1997,1998,1999,2000 Edmund Mergl
+ Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
+
+ You may distribute under the terms of either the GNU General Public
+ License or the Artistic License, as specified in the Perl README file.
+
+*/
+
+
+#include "Pg.h"
+
+
+#ifdef _MSC_VER
+#define strncasecmp(a,b,c) _strnicmp((a),(b),(c))
+#endif
+
+
+
+DBISTATE_DECLARE;
+
+
+MODULE = DBD::Pg PACKAGE = DBD::Pg
+
+I32
+constant(name=Nullch)
+ char *name
+ PROTOTYPE:
+ ALIAS:
+ PG_BOOL = 16
+ PG_BYTEA = 17
+ PG_CHAR = 18
+ PG_INT8 = 20
+ PG_INT2 = 21
+ PG_INT4 = 23
+ PG_TEXT = 25
+ PG_OID = 26
+ PG_FLOAT4 = 700
+ PG_FLOAT8 = 701
+ PG_ABSTIME = 702
+ PG_RELTIME = 703
+ PG_TINTERVAL = 704
+ PG_BPCHAR = 1042
+ PG_VARCHAR = 1043
+ PG_DATE = 1082
+ PG_TIME = 1083
+ PG_DATETIME = 1184
+ PG_TIMESPAN = 1186
+ PG_TIMESTAMP = 1296
+ CODE:
+ if (!ix) {
+ if (!name) name = GvNAME(CvGV(cv));
+ croak("Unknown DBD::Pg constant '%s'", name);
+ }
+ else RETVAL = ix;
+ OUTPUT:
+ RETVAL
+
+PROTOTYPES: DISABLE
+
+BOOT:
+ items = 0; /* avoid 'unused variable' warning */
+ DBISTATE_INIT;
+ /* XXX this interface will change: */
+ DBI_IMP_SIZE("DBD::Pg::dr::imp_data_size", sizeof(imp_drh_t));
+ DBI_IMP_SIZE("DBD::Pg::db::imp_data_size", sizeof(imp_dbh_t));
+ DBI_IMP_SIZE("DBD::Pg::st::imp_data_size", sizeof(imp_sth_t));
+ dbd_init(DBIS);
+
+
+# ------------------------------------------------------------
+# driver level interface
+# ------------------------------------------------------------
+MODULE = DBD::Pg PACKAGE = DBD::Pg::dr
+
+# disconnect_all renamed and ALIASed to avoid length clash on VMS :-(
+void
+discon_all_(drh)
+ SV * drh
+ ALIAS:
+ disconnect_all = 1
+ CODE:
+ D_imp_drh(drh);
+ ST(0) = dbd_discon_all(drh, imp_drh) ? &sv_yes : &sv_no;
+
+
+
+# ------------------------------------------------------------
+# database level interface
+# ------------------------------------------------------------
+MODULE = DBD::Pg PACKAGE = DBD::Pg::db
+
+void
+_login(dbh, dbname, username, pwd)
+ SV * dbh
+ char * dbname
+ char * username
+ char * pwd
+ CODE:
+ D_imp_dbh(dbh);
+ ST(0) = pg_db_login(dbh, imp_dbh, dbname, username, pwd) ? &sv_yes : &sv_no;
+
+
+int
+_ping(dbh)
+ SV * dbh
+ CODE:
+ int ret;
+ ret = dbd_db_ping(dbh);
+ if (ret == 0) {
+ XST_mUNDEF(0);
+ }
+ else {
+ XST_mIV(0, ret);
+ }
+
+void
+getfd(dbh)
+ SV * dbh
+ CODE:
+ int ret;
+ D_imp_dbh(dbh);
+
+ ret = dbd_db_getfd(dbh, imp_dbh);
+ ST(0) = sv_2mortal( newSViv( ret ) );
+
+void
+pg_notifies(dbh)
+ SV * dbh
+ CODE:
+ D_imp_dbh(dbh);
+
+ ST(0) = dbd_db_pg_notifies(dbh, imp_dbh);
+
+void
+commit(dbh)
+ SV * dbh
+ CODE:
+ D_imp_dbh(dbh);
+ if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) {
+ warn("commit ineffective with AutoCommit enabled");
+ }
+ ST(0) = dbd_db_commit(dbh, imp_dbh) ? &sv_yes : &sv_no;
+
+
+void
+rollback(dbh)
+ SV * dbh
+ CODE:
+ D_imp_dbh(dbh);
+ if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) {
+ warn("rollback ineffective with AutoCommit enabled");
+ }
+ ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &sv_yes : &sv_no;
+
+
+void
+disconnect(dbh)
+ SV * dbh
+ CODE:
+ D_imp_dbh(dbh);
+ if ( !DBIc_ACTIVE(imp_dbh) ) {
+ XSRETURN_YES;
+ }
+ /* pre-disconnect checks and tidy-ups */
+ if (DBIc_CACHED_KIDS(imp_dbh)) {
+ SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh));
+ DBIc_CACHED_KIDS(imp_dbh) = Nullhv;
+ }
+ /* Check for disconnect() being called whilst refs to cursors */
+ /* still exists. This possibly needs some more thought. */
+ if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !dirty) {
+ char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? "" : "s";
+ warn("disconnect(%s) invalidates %d active statement%s. %s",
+ SvPV(dbh,na), (int)DBIc_ACTIVE_KIDS(imp_dbh), plural,
+ "Either destroy statement handles or call finish on them before disconnecting.");
+ }
+ ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &sv_yes : &sv_no;
+
+
+void
+STORE(dbh, keysv, valuesv)
+ SV * dbh
+ SV * keysv
+ SV * valuesv
+ CODE:
+ D_imp_dbh(dbh);
+ ST(0) = &sv_yes;
+ if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv)) {
+ if (!DBIS->set_attr(dbh, keysv, valuesv)) {
+ ST(0) = &sv_no;
+ }
+ }
+
+
+void
+FETCH(dbh, keysv)
+ SV * dbh
+ SV * keysv
+ CODE:
+ D_imp_dbh(dbh);
+ SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv);
+ if (!valuesv) {
+ valuesv = DBIS->get_attr(dbh, keysv);
+ }
+ ST(0) = valuesv; /* dbd_db_FETCH_attrib did sv_2mortal */
+
+
+void
+DESTROY(dbh)
+ SV * dbh
+ PPCODE:
+ D_imp_dbh(dbh);
+ ST(0) = &sv_yes;
+ if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */
+ if (DBIc_WARN(imp_dbh) && !dirty && dbis->debug >= 2) {
+ warn("Database handle %s DESTROY ignored - never set up", SvPV(dbh,na));
+ }
+ }
+ else {
+ /* pre-disconnect checks and tidy-ups */
+ if (DBIc_CACHED_KIDS(imp_dbh)) {
+ SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh));
+ DBIc_CACHED_KIDS(imp_dbh) = Nullhv;
+ }
+ if (DBIc_IADESTROY(imp_dbh)) { /* want's ineffective destroy */
+ DBIc_ACTIVE_off(imp_dbh);
+ }
+ if (DBIc_ACTIVE(imp_dbh)) {
+ if (DBIc_WARN(imp_dbh) && (!dirty || dbis->debug >= 3)) {
+ warn("Database handle destroyed without explicit disconnect");
+ }
+ /* The application has not explicitly disconnected. That's bad. */
+ /* To ensure integrity we *must* issue a rollback. This will be */
+ /* harmless if the application has issued a commit. If it hasn't */
+ /* then it'll ensure integrity. Consider a Ctrl-C killing perl */
+ /* between two statements that must be executed as a transaction. */
+ /* Perl will call DESTROY on the dbh and, if we don't rollback, */
+ /* the server will automatically commit! Bham! Corrupt database! */
+ if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) {
+ dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */
+ }
+ dbd_db_disconnect(dbh, imp_dbh);
+ }
+ dbd_db_destroy(dbh, imp_dbh);
+ }
+
+
+# driver specific functions
+
+
+void
+lo_open(dbh, lobjId, mode)
+ SV * dbh
+ unsigned int lobjId
+ int mode
+ CODE:
+ int ret = pg_db_lo_open(dbh, lobjId, mode);
+ ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
+
+void
+lo_close(dbh, fd)
+ SV * dbh
+ int fd
+ CODE:
+ ST(0) = (-1 != pg_db_lo_close(dbh, fd)) ? &sv_yes : &sv_no;
+
+
+void
+lo_read(dbh, fd, buf, len)
+ SV * dbh
+ int fd
+ char * buf
+ int len
+ PREINIT:
+ SV *bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2);
+ int ret;
+ CODE:
+ buf = SvGROW(bufsv, len + 1);
+ ret = pg_db_lo_read(dbh, fd, buf, len);
+ if (ret > 0) {
+ SvCUR_set(bufsv, ret);
+ *SvEND(bufsv) = '\0';
+ sv_setpvn(ST(2), buf, ret);
+ SvSETMAGIC(ST(2));
+ }
+ ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
+
+
+void
+lo_write(dbh, fd, buf, len)
+ SV * dbh
+ int fd
+ char * buf
+ int len
+ CODE:
+ int ret = pg_db_lo_write(dbh, fd, buf, len);
+ ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
+
+
+void
+lo_lseek(dbh, fd, offset, whence)
+ SV * dbh
+ int fd
+ int offset
+ int whence
+ CODE:
+ int ret = pg_db_lo_lseek(dbh, fd, offset, whence);
+ ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
+
+
+void
+lo_creat(dbh, mode)
+ SV * dbh
+ int mode
+ CODE:
+ int ret = pg_db_lo_creat(dbh, mode);
+ ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
+
+
+void
+lo_tell(dbh, fd)
+ SV * dbh
+ int fd
+ CODE:
+ int ret = pg_db_lo_tell(dbh, fd);
+ ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
+
+
+void
+lo_unlink(dbh, lobjId)
+ SV * dbh
+ unsigned int lobjId
+ CODE:
+ ST(0) = (-1 != pg_db_lo_unlink(dbh, lobjId)) ? &sv_yes : &sv_no;
+
+
+void
+lo_import(dbh, filename)
+ SV * dbh
+ char * filename
+ CODE:
+ unsigned int ret = pg_db_lo_import(dbh, filename);
+ ST(0) = (ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
+
+
+void
+lo_export(dbh, lobjId, filename)
+ SV * dbh
+ unsigned int lobjId
+ char * filename
+ CODE:
+ ST(0) = (-1 != pg_db_lo_export(dbh, lobjId, filename)) ? &sv_yes : &sv_no;
+
+
+void
+putline(dbh, buf)
+ SV * dbh
+ char * buf
+ CODE:
+ int ret = pg_db_putline(dbh, buf);
+ ST(0) = (-1 != ret) ? &sv_yes : &sv_no;
+
+
+void
+getline(dbh, buf, len)
+ PREINIT:
+ SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
+ INPUT:
+ SV * dbh
+ int len
+ char * buf = sv_grow(bufsv, len);
+ CODE:
+ int ret = pg_db_getline(dbh, buf, len);
+ if (*buf == '\\' && *(buf+1) == '.') {
+ ret = -1;
+ }
+ sv_setpv((SV*)ST(1), buf);
+ SvSETMAGIC(ST(1));
+ ST(0) = (-1 != ret) ? &sv_yes : &sv_no;
+
+
+void
+endcopy(dbh)
+ SV * dbh
+ CODE:
+ ST(0) = (-1 != pg_db_endcopy(dbh)) ? &sv_yes : &sv_no;
+
+
+# -- end of DBD::Pg::db
+
+
+# ------------------------------------------------------------
+# statement interface
+# ------------------------------------------------------------
+MODULE = DBD::Pg PACKAGE = DBD::Pg::st
+
+void
+_prepare(sth, statement, attribs=Nullsv)
+ SV * sth
+ char * statement
+ SV * attribs
+ CODE:
+ {
+ D_imp_sth(sth);
+ D_imp_dbh_from_sth;
+ DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
+ if (!strncasecmp(statement, "begin", 5) ||
+ !strncasecmp(statement, "end", 4) ||
+ !strncasecmp(statement, "commit", 6) ||
+ !strncasecmp(statement, "abort", 5) ||
+ !strncasecmp(statement, "rollback", 8) ) {
+ warn("please use DBI functions for transaction handling");
+ ST(0) = &sv_no;
+ } else {
+ ST(0) = dbd_st_prepare(sth, imp_sth, statement, attribs) ? &sv_yes : &sv_no;
+ }
+ }
+
+
+void
+rows(sth)
+ SV * sth
+ CODE:
+ D_imp_sth(sth);
+ XST_mIV(0, dbd_st_rows(sth, imp_sth));
+
+
+void
+bind_param(sth, param, value, attribs=Nullsv)
+ SV * sth
+ SV * param
+ SV * value
+ SV * attribs
+ CODE:
+ {
+ IV sql_type = 0;
+ D_imp_sth(sth);
+ if (attribs) {
+ if (SvNIOK(attribs)) {
+ sql_type = SvIV(attribs);
+ attribs = Nullsv;
+ }
+ else {
+ SV **svp;
+ DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
+ /* XXX we should perhaps complain if TYPE is not SvNIOK */
+ DBD_ATTRIB_GET_IV(attribs, "TYPE", 4, svp, sql_type);
+ }
+ }
+ ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0) ? &sv_yes : &sv_no;
+ }
+
+
+void
+bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv)
+ SV * sth
+ SV * param
+ SV * value_ref
+ IV maxlen
+ SV * attribs
+ CODE:
+ {
+ IV sql_type = 0;
+ D_imp_sth(sth);
+ if (!SvROK(value_ref) || SvTYPE(SvRV(value_ref)) > SVt_PVMG) {
+ croak("bind_param_inout needs a reference to a scalar value");
+ }
+ if (SvREADONLY(SvRV(value_ref))) {
+ croak(no_modify);
+ }
+ if (attribs) {
+ if (SvNIOK(attribs)) {
+ sql_type = SvIV(attribs);
+ attribs = Nullsv;
+ }
+ else {
+ SV **svp;
+ DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
+ DBD_ATTRIB_GET_IV(attribs, "TYPE", 4, svp, sql_type);
+ }
+ }
+ ST(0) = dbd_bind_ph(sth, imp_sth, param, SvRV(value_ref), sql_type, attribs, TRUE, maxlen) ? &sv_yes : &sv_no;
+ }
+
+
+void
+execute(sth, ...)
+ SV * sth
+ CODE:
+ D_imp_sth(sth);
+ int ret;
+ if (items > 1) {
+ /* Handle binding supplied values to placeholders */
+ int i;
+ SV *idx;
+ imp_sth->all_params_len = 0; /* used for malloc of statement string in case we have placeholders */
+ if (items-1 != DBIc_NUM_PARAMS(imp_sth)) {
+ croak("execute called with %ld bind variables, %d needed", items-1, DBIc_NUM_PARAMS(imp_sth));
+ XSRETURN_UNDEF;
+ }
+ idx = sv_2mortal(newSViv(0));
+ for(i=1; i < items ; ++i) {
+ sv_setiv(idx, i);
+ if (!dbd_bind_ph(sth, imp_sth, idx, ST(i), 0, Nullsv, FALSE, 0)) {
+ XSRETURN_UNDEF; /* dbd_bind_ph already registered error */
+ }
+ }
+ }
+ ret = dbd_st_execute(sth, imp_sth);
+ /* remember that dbd_st_execute must return <= -2 for error */
+ if (ret == 0) { /* ok with no rows affected */
+ XST_mPV(0, "0E0"); /* (true but zero) */
+ }
+ else if (ret < -1) { /* -1 == unknown number of rows */
+ XST_mUNDEF(0); /* <= -2 means error */
+ }
+ else {
+ XST_mIV(0, ret); /* typically 1, rowcount or -1 */
+ }
+
+
+void
+fetchrow_arrayref(sth)
+ SV * sth
+ ALIAS:
+ fetch = 1
+ CODE:
+ D_imp_sth(sth);
+ AV *av = dbd_st_fetch(sth, imp_sth);
+ ST(0) = (av) ? sv_2mortal(newRV_inc((SV *)av)) : &sv_undef;
+
+
+void
+fetchrow_array(sth)
+ SV * sth
+ ALIAS:
+ fetchrow = 1
+ PPCODE:
+ D_imp_sth(sth);
+ AV *av;
+ av = dbd_st_fetch(sth, imp_sth);
+ if (av) {
+ int num_fields = AvFILL(av)+1;
+ int i;
+ EXTEND(sp, num_fields);
+ for(i=0; i < num_fields; ++i) {
+ PUSHs(AvARRAY(av)[i]);
+ }
+ }
+
+
+void
+finish(sth)
+ SV * sth
+ CODE:
+ D_imp_sth(sth);
+ D_imp_dbh_from_sth;
+ if (!DBIc_ACTIVE(imp_dbh)) {
+ /* Either an explicit disconnect() or global destruction */
+ /* has disconnected us from the database. Finish is meaningless */
+ /* XXX warn */
+ XSRETURN_YES;
+ }
+ if (!DBIc_ACTIVE(imp_sth)) {
+ /* No active statement to finish */
+ XSRETURN_YES;
+ }
+ ST(0) = dbd_st_finish(sth, imp_sth) ? &sv_yes : &sv_no;
+
+
+void
+blob_read(sth, field, offset, len, destrv=Nullsv, destoffset=0)
+ SV * sth
+ int field
+ long offset
+ long len
+ SV * destrv
+ long destoffset
+ CODE:
+ {
+ D_imp_sth(sth);
+ if (!destrv) {
+ destrv = sv_2mortal(newRV_inc(sv_2mortal(newSViv(0))));
+ }
+ ST(0) = dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset) ? SvRV(destrv) : &sv_undef;
+ }
+
+void
+STORE(sth, keysv, valuesv)
+ SV * sth
+ SV * keysv
+ SV * valuesv
+ CODE:
+ D_imp_sth(sth);
+ ST(0) = &sv_yes;
+ if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv)) {
+ if (!DBIS->set_attr(sth, keysv, valuesv)) {
+ ST(0) = &sv_no;
+ }
+ }
+
+
+# FETCH renamed and ALIASed to avoid case clash on VMS :-(
+void
+FETCH_attrib(sth, keysv)
+ SV * sth
+ SV * keysv
+ ALIAS:
+ FETCH = 1
+ CODE:
+ D_imp_sth(sth);
+ SV *valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv);
+ if (!valuesv) {
+ valuesv = DBIS->get_attr(sth, keysv);
+ }
+ ST(0) = valuesv; /* dbd_st_FETCH_attrib did sv_2mortal */
+
+
+void
+DESTROY(sth)
+ SV * sth
+ PPCODE:
+ D_imp_sth(sth);
+ ST(0) = &sv_yes;
+ if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */
+ if (DBIc_WARN(imp_sth) && !dirty && dbis->debug >= 2) {
+ warn("Statement handle %s DESTROY ignored - never set up", SvPV(sth,na));
+ }
+ }
+ else {
+ if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy */
+ DBIc_ACTIVE_off(imp_sth);
+ }
+ if (DBIc_ACTIVE(imp_sth)) {
+ dbd_st_finish(sth, imp_sth);
+ }
+ dbd_st_destroy(sth, imp_sth);
+ }
+
+
+# end of Pg.xs
--- /dev/null
+
+DBD::Pg -- the DBI PostgreSQL interface for Perl
+
+# $Id: README,v 1.1.2.1 2004-04-29 09:40:07 ivan Exp $
+
+DESCRIPTION:
+------------
+
+This is version 1.21 of DBD-Pg. The web site for this interface is at:
+
+ http://gborg.postgresql.org/project/dbdpg/projdisplay.php
+
+For further information about DBI look at:
+
+ http://dbi.perl.org/
+
+For information about PostgreSQL, visit:
+
+ http://www.postgresql.org/
+
+COPYRIGHT:
+----------
+
+ Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
+ Copyright (c) 1997,1998,1999,2000 Edmund Mergl
+ Copyright (c) 2002 Jeffrey W. Baker
+ Copyright (c) 2002 PostgreSQL Global Development Group
+
+You may distribute under the terms of either the GNU General Public
+License or the Artistic License, as specified in the Perl README file.
+
+
+HOW TO GET THE LATEST VERSION:
+------------------------------
+
+Use the following URL to look for new versions of this module:
+
+ http://gborg.postgresql.org/project/dbdpg/projdisplay.php
+
+or
+
+ http://www.perl.com/CPAN/modules/by-module/DBD/
+
+Note, that this request will be redirected automatically to the
+nearest CPAN site.
+
+
+IF YOU HAVE PROBLEMS:
+---------------------
+
+Please send comments and bug-reports to <dbd-general@gborg.postgresql.org>
+
+Please include the output of perl -v and perl -V, the version of PostgreSQL,
+the version of DBD-Pg, the version of DBI, and details about your platform
+in your bug-report.
+
+
+REQUIREMENTS:
+-------------
+
+ build, test, and install Perl 5 (at least 5.005)
+ build, test, and install the DBI module (at least 1.30)
+ build, test, and install PostgreSQL (at least 7.3)
+ build, test, and install Test::Simple (at least 0.17)
+
+INSTALLATION:
+-------------
+
+By default Makefile.PL uses App:Info to find the location of the
+PostgreSQL library and include directories. However, if you want to
+control it yourself, define the environment variables POSTGRES_INCLUDE
+and POSTGRES_LIB, or POSTGRES_HOME.
+
+ 1. perl Makefile.PL
+ 2. make
+ 3. make test
+ 4. make install
+
+Do steps 1 to 3 as normal user, not as root!
+
+
+TESTING:
+--------
+
+The tests are designed to connect to a live database. The following
+environment variables must be set for the tests to run:
+
+ DBI_DSN=dbi:Pg:dbname=<database>
+ DBI_USER=<username>
+ DBI_PASS=<password>
+
+If you are using the shared library libpq.so check if your dynamic
+loader finds libpq.so. With Linux the command /sbin/ldconfig -v should
+tell you, where it finds libpq.so. If ldconfig does not find libpq.so,
+either add an appropriate entry to /etc/ld.so.conf and re-run ldconfig
+or add the path to the environment variable LD_LIBRARY_PATH.
+
+A typical error message resulting from not finding libpq.so is:
+
+ install_driver(Pg) failed: Can't load './blib/arch/auto/DBD/Pg/Pg.so'
+ for module DBD::Pg: File not found at
+
+If you get an error message like:
+
+ perl: error while loading shared libraries:
+ /usr/lib/perl5/site_perl/5.6.0/i386-linux/auto/DBD/Pg/Pg.so: undefined
+ symbol: PQconnectdb
+
+when you call DBI->connect, then your libpq.so was probably not seen at
+build-time. This should have caused 'make test' to fail; did you really
+run it and look at the output? Check the setting of POSTGRES_LIB and
+recompile DBD-Pg.
+
+Some linux distributions have incomplete perl installations. If you have
+compile errors like "XS_VERSION_BOOTCHECK undeclared", do:
+
+ find .../lib/perl5 -name XSUB.h -print
+
+If this file is not present, you need to recompile and re-install perl.
+
+SGI users: if you get segmentation faults make sure, you use the malloc
+which comes with perl when compiling perl (the default is not to).
+"David R. Noble" <drnoble@engsci.sandia.gov>
+
+HP users: if you get error messages like:
+
+ can't open shared library: .../lib/libpq.sl
+ No such file or directory
+
+when running the test script, try to replace the 'shared' option in the
+LDDFLAGS with 'archive'. Dan Lauterbach <danla@dimensional.com>
+
+
+FreeBSD users: if you get during make test the error message:
+
+ 'DBD driver has not implemented the AutoCommit attribute'
+
+recompile the DBI module and the DBD-Pg module and disable optimization.
+This error message is due to the broken optimization in gcc-2.7.2.1.
+
+If you get compiler errors like:
+ In function `XS_DBD__Pg__dr_discon_all_'
+ `sv_yes' undeclared (first use in this function)
+
+It may be because there is a 'patchlevel.h' file from another package
+(such as 'hdf') in your POSTGRES_INCLUDE dir. The presence of this file
+prevents the compiler from finding the perl include file
+'mach/CORE/patchlevel.h'. Do 'pg_config --includedir' to identify the
+POSTGRES_INCLUDE dir. Rename patchlevel.h whilst you build DBD::Pg.
+
+
+Sun Users: if you get compile errors like:
+
+ /usr/include/string.h:57: parse error before `]'
+
+then you need to remove from pgsql/include/libpq-fe.h the define for
+strerror, which clashes with the definition in the standard include
+file.
+
+Win32 Users: Running DBD-Pg scripts on Win32 needs some configuration work
+on the server side:
+
+ o add a postgres user with the same name as the NT-User
+ (eg Administrator)
+ o make sure, that your pg_hba.conf on the server is configured,
+ such that a connection from another host will be accepted
--- /dev/null
+
+$Id: README.win32,v 1.1.2.1 2004-04-29 09:40:07 ivan Exp $
+
+
+Here is a step-by-step procedure for getting DBD-Pg to work on Windows
+NT. This Port has been done by Bob Kline <bkline@rksystems.com>.
+
+
+prerequisites: (older versions might also work, but these are the
+-------------- versions I used)
+
+ o Windows NT4 SP4
+ o Visual Studio 6.0
+ o ActivePerl-5_6_0_613 with DBI-1.13
+ o postgresql-7.0.2
+ o DBD-Pg-0.95
+
+Here we assume, that perl and postgresql have been installed in C:\. Now
+perform the following steps:
+
+
+1. compile libpq
+----------------
+
+set POSTGRES_HOME=C:\postgresql-7.0.2
+cd postgresql-7.0.2
+mkdir lib
+mkdir include
+cd src
+copy include\port\win32.h include\os.h
+edit interfaces\libpq\fe-connect.c and add as first statement in connectDBStart() the following code:
+ #ifdef WIN32
+ static int WeHaveCalledWSAStartup;
+ if (!WeHaveCalledWSAStartup) {
+ WSADATA wsaData;
+ if (WSAStartup(MAKEWORD(1, 1), &wsaData)) {
+ printfPQExpBuffer(&conn->errorMessage, "WSAStartup failed: errno=%d\n", h_errno);
+ goto connect_errReturn;
+ }
+ WeHaveCalledWSAStartup = 1;
+ }
+ #endif
+edit interfaces\libpq\win32.mak and change the flag /ML to /MD: CPP_PROJ=/nologo /MD ...
+nmake /f win32.mak
+cd ..
+copy src\interfaces\libpq\Release\libpq.lib lib
+copy src\interfaces\libpq\libpq-fe.h include
+copy src\include\postgres_ext.h include
+cd ..
+
+
+2. build DBD-Pg
+---------------
+
+cd DBD-Pg
+perl Makefile.PL CAPI=TRUE
+nmake
+set the environment variable PGHOST to the name of the postgresql server: set PGHOST=myserver
+add on the server a postgres user with the same name as the NT-User (eg Administrator)
+make sure, that your pg_hba.conf on the server is configured, such that a connection from another host will be accepted
+mkdir C:\tmp
+nmake test (expect to get errors concerning blobs)
+nmake install
--- /dev/null
+
+# $Id: dbd-pg.pod,v 1.1.2.1 2004-04-29 09:40:07 ivan Exp $
+
+=head1 NAME
+
+DBD::Pg - PostgreSQL database driver for the DBI module
+
+=head1 DESCRIPTION
+
+DBD::Pg is a Perl module which works with the DBI module to provide
+access to PostgreSQL databases.
+
+=head1 DBD::Pg
+
+=begin docbook
+<!-- The following blank =head1 is to allow us to use purely =head2 headings -->
+<!-- This keeps the POD fairly simple with regards to Pod::DocBook -->
+
+=end docbook
+
+=head1
+
+=head2 Version
+
+Version 0.91.
+
+=head2 Author and Contact Details
+
+The driver author is Edmund Mergl. He can be contacted via the
+I<dbi-users> mailing list.
+
+
+=head2 Supported Database Versions and Options
+
+The DBD-Pg-0.92 module supports Postgresql 6.5.
+
+
+=head2 Connect Syntax
+
+The C<DBI-E<gt>connect()> Data Source Name, or I<DSN>, can be one of the
+following:
+
+ dbi:Pg:dbname=$dbname
+ dbi:Pg:dbname=$dbname;host=$host;port=$port;options=$options;tty=$tty
+
+All parameters, including the userid and password parameter of the
+connect command, have a hard-coded default which can be overridden
+by setting appropriate environment variables:
+
+ Parameter Environment Variable Default
+ --------- -------------------- --------------
+ dbname PGDATABASE current userid
+ host PGHOST localhost
+ port PGPORT 5432
+ options PGOPTIONS ""
+ tty PGTTY ""
+ username PGUSER current userid
+ password PGPASSWORD ""
+
+There are no driver specific attributes for the C<DBI->connect()> method.
+
+
+=head2 Numeric Data Handling
+
+Postgresql supports the following numeric types:
+
+ Postgresql Range
+ ---------- --------------------------
+ int2 -32768 to +32767
+ int4 -2147483648 to +2147483647
+ float4 6 decimal places
+ float8 15 decimal places
+
+Some platforms also support the int8 type.
+C<DBD::Pg> always returns all numbers as strings.
+
+
+=head2 String Data Handling
+
+Postgresql supports the following string data types:
+
+ CHAR single character
+ CHAR(size) fixed length blank-padded
+ VARCHAR(size) variable length with limit
+ TEXT variable length
+
+All string data types have a limit of 4096 bytes.
+The CHAR type is fixed length and blank padded.
+
+There is no special handling for data with the 8th bit set. They
+are stored unchanged in the database.
+None of the character types can store embedded nulls and Unicode is
+not formally supported.
+
+Strings can be concatenated using the C<||> operator.
+
+
+=head2 Date Data Handling
+
+Postgresql supports the following date time data types:
+
+ Type Storage Recommendation Description
+ --------- -------- -------------------------- ----------------------------
+ abstime 4 bytes original date and time limited range
+ date 4 bytes SQL92 type wide range
+ datetime 8 bytes best general date and time wide range, high precision
+ interval 12 bytes SQL92 type equivalent to timespan
+ reltime 4 bytes original time interval limited range, low precision
+ time 4 bytes SQL92 type wide range
+ timespan 12 bytes best general time interval wide range, high precision
+ timestamp 4 bytes SQL92 type limited range
+
+ Data Type Range Resolution
+ ---------- ---------------------------------- -----------
+ abstime 1901-12-14 2038-01-19 1 sec
+ timestamp 1901-12-14 2038-01-19 1 sec
+ reltime -68 years +68 years 1 sec
+ tinterval -178000000 years +178000000 years 1 microsec
+ timespan -178000000 years 178000000 years 1 microsec
+ date 4713 BC 32767 AD 1 day
+ datetime 4713 BC 1465001 AD 1 microsec
+ time 00:00:00:00 23:59:59:99 1 microsec
+
+Postgresql supports a range of date formats:
+
+ Name Example
+ ----------- ----------------------
+ ISO 1997-12-17 0:37:16-08
+ SQL 12/17/1997 07:37:16.00 PST
+ Postgres Wed Dec 17 07:37:16 1997 PST
+ European 17/12/1997 15:37:16.00 MET
+ NonEuropean 12/17/1997 15:37:16.00 MET
+ US 12/17/1997 07:37:16.00 MET
+
+The default output format does not depend on the client/server locale.
+It depends on, in increasing priority: the PGDATESTYLE environment
+variable at the server, the PGDATESTYLE environment variable at the client, and
+the C<SET DATESTYLE> SQL command.
+
+All of the formats described above can be used for input. A great many
+others can also be used. There is no specific default input format.
+If the format of a date input is ambiguous then the current DATESTYLE
+is used to help disambiguate.
+
+If you specify a date/time value without a time component, the default
+time is 00:00:00 (midnight). To specify a date/time value without a date
+is not allowed.
+If a date with a two digit year is input then if the year was less than
+70, add 2000; otherwise, add 1900.
+
+The currect date/time is returned by the keyword C<'now'> or C<'current'>,
+which has to be casted to a valid data type. For example:
+
+ SELECT 'now'::datetime
+
+Postgresql supports a range of date time functions for converting
+between types, extracting parts of a date time value, truncating to a
+given unit, etc. The usual arithmetic can be performed on date and
+interval values, e.g., date-date=interval, etc.
+
+The following SQL expression can be used to convert an integer "seconds
+since 1-jan-1970 GMT" value to the corresponding database date time:
+
+ DATETIME(unixtime_field)
+
+and to do the reverse:
+
+ DATE_PART('epoch', datetime_field)
+
+The server stores all dates internally in GMT. Times are converted to
+local time on the database server before being sent to the client
+frontend, hence by default are in the server time zone.
+
+The TZ environment variable is used by the server as default time
+zone. The PGTZ environment variable on the client side is used to send
+the time zone information to the backend upon connection. The SQL C<SET
+TIME ZONE> command can set the time zone for the current session.
+
+
+=head2 LONG/BLOB Data Handling
+
+Postgresql handles BLOBS using a so called "large objects" type. The
+handling of this type differs from all other data types. The data are
+broken into chunks, which are stored in tuples in the database. Access
+to large objects is given by an interface which is modelled closely
+after the UNIX file system. The maximum size is limited by the file
+size of the operating system.
+
+
+If you just select the field, you get a "large object identifier" and
+not the data itself. The I<LongReadLen> and I<LongTruncOk> attributes are
+not implemented because they don't make sense in this case. The only
+method implemented by the driver is the undocumented DBI method
+C<blob_read()>.
+
+
+=head2 Other Data Handling issues
+
+The C<DBD::Pg> driver supports the C<type_info()> method.
+
+Postgresql supports automatic conversions between data types wherever
+it's reasonable.
+
+=head2 Transactions, Isolation and Locking
+
+Postgresql supports transactions.
+The current default isolation transaction level is "Serializable" and
+is currently implemented using table level locks. Both may change.
+No other isolation levels for transactions are supported.
+
+With AutoCommit on, a query never places a lock on a table. Readers
+never block writers and writers never block readers. This behavior
+changes whenever a transaction is started (AutoCommit off). Then a
+query induces a shared lock on a table and blocks anyone else
+until the transaction has been finished.
+
+The C<LOCK TABLE table_name> statement can be used to apply an explicit
+lock on a table. This only works inside a transaction (AutoCommit off).
+
+To ensure that a table being selected does not change before you make
+an update later in the transaction, you must explicitly lock it with a
+C<LOCK TABLE> statement before executing the select.
+
+
+=head2 No-Table Expression Select Syntax
+
+To select a constant expression, that is, an expression that doesn't involve
+data from a database table or view, just omit the "from" clause.
+Here's an example that selects the current time as a datetime:
+
+ SELECT 'now'::datetime;
+
+=head2 Table Join Syntax
+
+Outer joins are not supported. Inner joins use the traditional syntax.
+
+=head2 Table and Column Names
+
+The max size of table and column names cannot exceed 31 charaters in
+length.
+Only alphanumeric characters can be used; the first character must
+be a letter.
+
+If an identifier is enclosed by double quotation marks (C<">), it can
+contain any combination of characters except double quotation marks.
+
+Postgresql converts all identifiers to lower-case unless enclosed in
+double quotation marks.
+National character set characters can be used, if enclosed in quotation
+marks.
+
+
+=head2 Case Sensitivity of LIKE Operator
+
+Postgresql has the following string matching operators:
+
+ Glyph Description Example
+ ----- ---------------------------------------- -----------------------------
+ ~~ Same as SQL "LIKE" operator 'scrappy,marc' ~~ '%scrappy%'
+ !~~ Same as SQL "NOT LIKE" operator 'bruce' !~~ '%al%'
+ ~ Match (regex), case sensitive 'thomas' ~ '.*thomas.*'
+ ~* Match (regex), case insensitive 'thomas' ~* '.*Thomas.*'
+ !~ Does not match (regex), case sensitive 'thomas' !~ '.*Thomas.*'
+ !~* Does not match (regex), case insensitive 'thomas' !~ '.*vadim.*'
+
+
+=head2 Row ID
+
+The Postgresql "row id" pseudocolumn is called I<oid>, object identifier.
+It can be treated as a string and used to rapidly (re)select rows.
+
+
+=head2 Automatic Key or Sequence Generation
+
+Postgresql does not support automatic key generation such as "auto
+increment" or "system generated" keys.
+
+However, Postgresql does support "sequence generators". Any number of
+named sequence generators can be created in a database. Sequences
+are used via functions called C<NEXTVAL> and C<CURRVAL>. Typical usage:
+
+ INSERT INTO table (k, v) VALUES (nextval('seq_name'), ?);
+
+To get the value just inserted, you can use the corresponding C<currval()>
+SQL function in the same session, or
+
+ SELECT last_value FROM seq_name
+
+
+=head2 Automatic Row Numbering and Row Count Limiting
+
+Postgresql does not support any way of automatically numbering returned rows.
+
+
+=head2 Parameter Binding
+
+Parameter binding is emulated by the driver.
+Both the C<?> and C<:1> style of placeholders are supported.
+
+The TYPE attribute of the C<bind_param()> method may be used to
+influence how parameters are treated. These SQL types are bound as
+VARCHAR: SQL_NUMERIC, SQL_DECIMAL, SQL_INTEGER, SQL_SMALLINT,
+SQL_FLOAT, SQL_REAL, SQL_DOUBLE, SQL_VARCHAR.
+
+The SQL_CHAR type is bound as a CHAR thus enabling fixed-width blank
+padded comparison semantics.
+
+Unsupported values of the TYPE attribute generate a warning.
+
+
+=head2 Stored Procedures
+
+C<DBD::Pg> does not support stored procedures.
+
+
+=head2 Table Metadata
+
+C<DBD::Pg> supports the C<table_info()> method.
+
+The I<pg_attribute> table contains detailed information about all columns
+of all the tables in the database, one row per table.
+
+The I<pg_index> table contains detailed information about all indexes in
+the database, one row per index.
+
+Primary keys are implemented as unique indexes. See I<pg_index> above.
+
+
+=head2 Driver-specific Attributes and Methods
+
+There are no significant C<DBD::Pg> driver-specific database handle attributes.
+
+C<DBD::Pg> has the following driver-specific statement handle attributes:
+
+=over 8
+
+=item I<pg_size>
+
+Returns a reference to an array of integer values for each column. The
+integer shows the storage (not display) size of the column in bytes.
+Variable length columns are indicated by -1.
+
+=item I<pg_type>
+
+Returns a reference to an array of strings for each column. The string
+shows the name of the data type.
+
+=item I<pg_oid_status>
+
+Returns the OID of the last INSERT command.
+
+=item I<pg_cmd_status>
+
+Returns the name of the last command type. Possible types are: INSERT,
+DELETE, UPDATE, SELECT.
+
+=back
+
+
+C<DBD::Pg> has no private methods.
+
+
+=head2 Positioned updates and deletes
+
+Postgresql does not support positioned updates or deletes.
+
+
+=head2 Differences from the DBI Specification
+
+C<DBD::Pg> has no significant differences in behavior from the
+current DBI specification.
+
+Note that C<DBD::Pg> does not fully parse the statement until
+it's executed. Thus attributes like I<$sth-E<gt>{NUM_OF_FIELDS}> are not
+available until after C<$sth-E<gt>execute> has been called. This is valid
+behaviour but is important to note when porting applications
+originally written for other drivers.
+
+
+=head2 URLs to More Database/Driver Specific Information
+
+ http://www.postgresql.org
+
+
+=head2 Concurrent use of Multiple Handles
+
+C<DBD::Pg> supports an unlimited number of concurrent database
+connections to one or more databases.
+
+It also supports the preparation and execution of a new statement
+handle while still fetching data from another statement handle,
+provided it is
+associated with the same database handle.
+
+
+=head2 Other Significant Database or Driver Features
+
+Postgres offers substantial additional power by incorporating the
+following four additional basic concepts in such a way that users can
+easily extend the system: classes, inheritance, types, and functions.
+
+Other features provide additional power and flexibility: constraints,
+triggers, rules, transaction integrity, procedural languages, and large objects.
+
+It's also free Open Source Software with an active community of developers.
+
+=cut
+
+# This driver summary for DBD::Pg is Copyright (c) 1999 Tim Bunce
+# and Edmund Mergl.
+# $Id: dbd-pg.pod,v 1.1.2.1 2004-04-29 09:40:07 ivan Exp $
--- /dev/null
+/*
+ $Id: dbdimp.c,v 1.1.2.1 2004-04-29 09:40:07 ivan Exp $
+
+ Copyright (c) 1997,1998,1999,2000 Edmund Mergl
+ Copyright (c) 2002 Jeffrey W. Baker
+ Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
+
+ You may distribute under the terms of either the GNU General Public
+ License or the Artistic License, as specified in the Perl README file.
+
+*/
+
+
+/*
+ hard-coded OIDs: (here we need the postgresql types)
+ pg_sql_type() 1042 (bpchar), 1043 (varchar)
+ ddb_st_fetch() 1042 (bpchar), 16 (bool)
+ ddb_preparse() 1043 (varchar)
+ pgtype_bind_ok()
+*/
+
+#include "Pg.h"
+
+/* XXX DBI should provide a better version of this */
+#define IS_DBI_HANDLE(h) (SvROK(h) && SvTYPE(SvRV(h)) == SVt_PVHV && SvRMAGICAL(SvRV(h)) && (SvMAGIC(SvRV(h)))->mg_type == 'P')
+
+DBISTATE_DECLARE;
+
+/* hard-coded array delimiter */
+static char* array_delimiter = ",";
+
+static void dbd_preparse (imp_sth_t *imp_sth, char *statement);
+
+
+void
+dbd_init (dbistate)
+ dbistate_t *dbistate;
+{
+ DBIS = dbistate;
+}
+
+
+int
+dbd_discon_all (drh, imp_drh)
+ SV *drh;
+ imp_drh_t *imp_drh;
+{
+ dTHR;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_discon_all\n"); }
+
+ /* The disconnect_all concept is flawed and needs more work */
+ if (!dirty && !SvTRUE(perl_get_sv("DBI::PERL_ENDING",0))) {
+ sv_setiv(DBIc_ERR(imp_drh), (IV)1);
+ sv_setpv(DBIc_ERRSTR(imp_drh),
+ (char*)"disconnect_all not implemented");
+ DBIh_EVENT2(drh, ERROR_event,
+ DBIc_ERR(imp_drh), DBIc_ERRSTR(imp_drh));
+ return FALSE;
+ }
+ if (perl_destruct_level) {
+ perl_destruct_level = 0;
+ }
+ return FALSE;
+}
+
+
+/* Database specific error handling. */
+
+void
+pg_error (h, error_num, error_msg)
+ SV *h;
+ int error_num;
+ char *error_msg;
+{
+ D_imp_xxh(h);
+ char *err, *src, *dst;
+ int len = strlen(error_msg);
+
+ err = (char *)malloc(len + 1);
+ if (!err) {
+ return;
+ }
+ src = error_msg;
+ dst = err;
+
+ /* copy error message without trailing newlines */
+ while (*src != '\0' && *src != '\n') {
+ *dst++ = *src++;
+ }
+ *dst = '\0';
+
+ sv_setiv(DBIc_ERR(imp_xxh), (IV)error_num); /* set err early */
+ sv_setpv(DBIc_ERRSTR(imp_xxh), (char*)err);
+ DBIh_EVENT2(h, ERROR_event, DBIc_ERR(imp_xxh), DBIc_ERRSTR(imp_xxh));
+ if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "%s error %d recorded: %s\n", err, error_num, SvPV(DBIc_ERRSTR(imp_xxh),na)); }
+ free(err);
+}
+
+static int
+pgtype_bind_ok (dbtype)
+ int dbtype;
+{
+ /* basically we support types that can be returned as strings */
+ switch(dbtype) {
+ case 16: /* bool */
+ case 17: /* bytea */
+ case 18: /* char */
+ case 20: /* int8 */
+ case 21: /* int2 */
+ case 23: /* int4 */
+ case 25: /* text */
+ case 26: /* oid */
+ case 700: /* float4 */
+ case 701: /* float8 */
+ case 702: /* abstime */
+ case 703: /* reltime */
+ case 704: /* tinterval */
+ case 1042: /* bpchar */
+ case 1043: /* varchar */
+ case 1082: /* date */
+ case 1083: /* time */
+ case 1184: /* datetime */
+ case 1186: /* timespan */
+ case 1296: /* timestamp */
+ return 1;
+ }
+ return 0;
+}
+
+
+/* ================================================================== */
+
+int
+pg_db_login (dbh, imp_dbh, dbname, uid, pwd)
+ SV *dbh;
+ imp_dbh_t *imp_dbh;
+ char *dbname;
+ char *uid;
+ char *pwd;
+{
+ dTHR;
+
+ char *conn_str;
+ char *src;
+ char *dest;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "pg_db_login\n"); }
+
+ /* build connect string */
+ /* DBD-Pg syntax: 'dbname=dbname;host=host;port=port' */
+ /* pgsql syntax: 'dbname=dbname host=host port=port user=uid password=pwd' */
+
+ conn_str = (char *)malloc(strlen(dbname) + strlen(uid) + strlen(pwd) + 16 + 1);
+ if (! conn_str) {
+ return 0;
+ }
+
+ src = dbname;
+ dest = conn_str;
+ while (*src) {
+ if (*src != ';') {
+ *dest++ = *src++;
+ continue;
+ }
+ *dest++ = ' ';
+ src++;
+ }
+ *dest = '\0';
+
+ if (strlen(uid)) {
+ strcat(conn_str, " user=");
+ strcat(conn_str, uid);
+ }
+ if (strlen(uid) && strlen(pwd)) {
+ strcat(conn_str, " password=");
+ strcat(conn_str, pwd);
+ }
+
+ if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "pg_db_login: conn_str = >%s<\n", conn_str); }
+
+ /* make a connection to the database */
+ imp_dbh->conn = PQconnectdb(conn_str);
+ free(conn_str);
+
+ /* check to see that the backend connection was successfully made */
+ if (PQstatus(imp_dbh->conn) != CONNECTION_OK) {
+ pg_error(dbh, PQstatus(imp_dbh->conn), PQerrorMessage(imp_dbh->conn));
+ PQfinish(imp_dbh->conn);
+ return 0;
+ }
+
+ imp_dbh->init_commit = 1; /* initialize AutoCommit */
+ imp_dbh->pg_auto_escape = 1; /* initialize pg_auto_escape */
+ imp_dbh->pg_bool_tf = 0; /* initialize pg_bool_tf */
+
+ DBIc_IMPSET_on(imp_dbh); /* imp_dbh set up now */
+ DBIc_ACTIVE_on(imp_dbh); /* call disconnect before freeing */
+ return 1;
+}
+
+
+int
+dbd_db_getfd (dbh, imp_dbh)
+ SV *dbh;
+ imp_dbh_t *imp_dbh;
+{
+ char id;
+ SV* retsv;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_getfd\n"); }
+
+ return PQsocket(imp_dbh->conn);
+}
+
+SV *
+dbd_db_pg_notifies (dbh, imp_dbh)
+ SV *dbh;
+ imp_dbh_t *imp_dbh;
+{
+ char id;
+ PGnotify* notify;
+ AV* ret;
+ SV* retsv;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_pg_notifies\n"); }
+
+ PQconsumeInput(imp_dbh->conn);
+
+ notify = PQnotifies(imp_dbh->conn);
+
+ if (!notify) return &sv_undef;
+
+ ret=newAV();
+
+ av_push(ret, newSVpv(notify->relname,0) );
+ av_push(ret, newSViv(notify->be_pid) );
+
+ /* Should free notify memory with PQfreemem() */
+
+ retsv = newRV(sv_2mortal((SV*)ret));
+
+ return retsv;
+}
+
+int
+dbd_db_ping (dbh)
+ SV *dbh;
+{
+ char id;
+ D_imp_dbh(dbh);
+ PGresult* result;
+ ExecStatusType status;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_ping\n"); }
+
+ if (NULL != imp_dbh->conn) {
+ result = PQexec(imp_dbh->conn, " ");
+ status = result ? PQresultStatus(result) : -1;
+ PQclear(result);
+
+ if (PGRES_EMPTY_QUERY != status) {
+ return 0;
+ }
+
+ return 1;
+ }
+
+ return 0;
+}
+
+
+int
+dbd_db_commit (dbh, imp_dbh)
+ SV *dbh;
+ imp_dbh_t *imp_dbh;
+{
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_commit\n"); }
+
+ /* no commit if AutoCommit = on */
+ if (DBIc_has(imp_dbh, DBIcf_AutoCommit) != FALSE) {
+ return 0;
+ }
+
+ if (NULL != imp_dbh->conn) {
+ PGresult* result = 0;
+ ExecStatusType commitstatus, beginstatus;
+
+ /* execute commit */
+ result = PQexec(imp_dbh->conn, "commit");
+ commitstatus = result ? PQresultStatus(result) : -1;
+ PQclear(result);
+
+ /* check result */
+ if (commitstatus != PGRES_COMMAND_OK) {
+ /* Only put the error message in DBH->errstr */
+ pg_error(dbh, commitstatus, PQerrorMessage(imp_dbh->conn));
+ }
+
+ /* start new transaction. AutoCommit must be FALSE, ref. 20 lines up */
+ result = PQexec(imp_dbh->conn, "begin");
+ beginstatus = result ? PQresultStatus(result) : -1;
+ PQclear(result);
+ if (beginstatus != PGRES_COMMAND_OK) {
+ /* Maybe add some loud barf here? Raising some very high error? */
+ pg_error(dbh, beginstatus, "begin failed\n");
+ return 0;
+ }
+
+ /* if the initial COMMIT failed, return 0 now */
+ if (commitstatus != PGRES_COMMAND_OK) {
+ return 0;
+ }
+
+ return 1;
+ }
+
+ return 0;
+}
+
+
+int
+dbd_db_rollback (dbh, imp_dbh)
+ SV *dbh;
+ imp_dbh_t *imp_dbh;
+{
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_rollback\n"); }
+
+ /* no rollback if AutoCommit = on */
+ if (DBIc_has(imp_dbh, DBIcf_AutoCommit) != FALSE) {
+ return 0;
+ }
+
+ if (NULL != imp_dbh->conn) {
+ PGresult* result = 0;
+ ExecStatusType status;
+
+ /* execute rollback */
+ result = PQexec(imp_dbh->conn, "rollback");
+ status = result ? PQresultStatus(result) : -1;
+ PQclear(result);
+
+ /* check result */
+ if (status != PGRES_COMMAND_OK) {
+ pg_error(dbh, status, "rollback failed\n");
+ return 0;
+ }
+
+ /* start new transaction. AutoCommit must be FALSE, ref. 20 lines up */
+ result = PQexec(imp_dbh->conn, "begin");
+ status = result ? PQresultStatus(result) : -1;
+ PQclear(result);
+ if (status != PGRES_COMMAND_OK) {
+ pg_error(dbh, status, "begin failed\n");
+ return 0;
+ }
+
+ return 1;
+ }
+
+ return 0;
+}
+
+
+int
+dbd_db_disconnect (dbh, imp_dbh)
+ SV *dbh;
+ imp_dbh_t *imp_dbh;
+{
+ dTHR;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_disconnect\n"); }
+
+ /* We assume that disconnect will always work */
+ /* since most errors imply already disconnected. */
+ DBIc_ACTIVE_off(imp_dbh);
+
+ if (NULL != imp_dbh->conn) {
+ /* rollback if AutoCommit = off */
+ if (DBIc_has(imp_dbh, DBIcf_AutoCommit) == FALSE) {
+ PGresult* result = 0;
+ ExecStatusType status;
+ result = PQexec(imp_dbh->conn, "rollback");
+ status = result ? PQresultStatus(result) : -1;
+ PQclear(result);
+ if (status != PGRES_COMMAND_OK) {
+ pg_error(dbh, status, "rollback failed\n");
+ return 0;
+ }
+ if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "dbd_db_disconnect: AutoCommit=off -> rollback\n"); }
+ }
+
+ PQfinish(imp_dbh->conn);
+
+ imp_dbh->conn = NULL;
+ }
+
+ /* We don't free imp_dbh since a reference still exists */
+ /* The DESTROY method is the only one to 'free' memory. */
+ /* Note that statement objects may still exists for this dbh! */
+ return 1;
+}
+
+
+void
+dbd_db_destroy (dbh, imp_dbh)
+ SV *dbh;
+ imp_dbh_t *imp_dbh;
+{
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_destroy\n"); }
+
+ if (DBIc_ACTIVE(imp_dbh)) {
+ dbd_db_disconnect(dbh, imp_dbh);
+ }
+
+ /* Nothing in imp_dbh to be freed */
+ DBIc_IMPSET_off(imp_dbh);
+}
+
+
+int
+dbd_db_STORE_attrib (dbh, imp_dbh, keysv, valuesv)
+ SV *dbh;
+ imp_dbh_t *imp_dbh;
+ SV *keysv;
+ SV *valuesv;
+{
+ STRLEN kl;
+ char *key = SvPV(keysv,kl);
+ int newval = SvTRUE(valuesv);
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_STORE\n"); }
+
+ if (kl==10 && strEQ(key, "AutoCommit")) {
+ int oldval = DBIc_has(imp_dbh, DBIcf_AutoCommit);
+ DBIc_set(imp_dbh, DBIcf_AutoCommit, newval);
+ if (oldval == FALSE && newval != FALSE && imp_dbh->init_commit) {
+ /* do nothing, fall through */
+ if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "dbd_db_STORE: initialize AutoCommit to on\n"); }
+ } else if (oldval == FALSE && newval != FALSE) {
+ if (NULL != imp_dbh->conn) {
+ /* commit any outstanding changes */
+ PGresult* result = 0;
+ ExecStatusType status;
+ result = PQexec(imp_dbh->conn, "commit");
+ status = result ? PQresultStatus(result) : -1;
+ PQclear(result);
+ if (status != PGRES_COMMAND_OK) {
+ pg_error(dbh, status, "commit failed\n");
+ return 0;
+ }
+ }
+ if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "dbd_db_STORE: switch AutoCommit to on: commit\n"); }
+ } else if ((oldval != FALSE && newval == FALSE) || (oldval == FALSE && newval == FALSE && imp_dbh->init_commit)) {
+ if (NULL != imp_dbh->conn) {
+ /* start new transaction */
+ PGresult* result = 0;
+ ExecStatusType status;
+ result = PQexec(imp_dbh->conn, "begin");
+ status = result ? PQresultStatus(result) : -1;
+ PQclear(result);
+ if (status != PGRES_COMMAND_OK) {
+ pg_error(dbh, status, "begin failed\n");
+ return 0;
+ }
+ }
+ if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "dbd_db_STORE: switch AutoCommit to off: begin\n"); }
+ }
+ /* only needed once */
+ imp_dbh->init_commit = 0;
+ return 1;
+ } else if (kl==14 && strEQ(key, "pg_auto_escape")) {
+ imp_dbh->pg_auto_escape = newval;
+ } else if (kl==10 && strEQ(key, "pg_bool_tf")) {
+ imp_dbh->pg_bool_tf = newval;
+#ifdef SvUTF8_off
+ } else if (kl==14 && strEQ(key, "pg_enable_utf8")) {
+ imp_dbh->pg_enable_utf8 = newval;
+#endif
+ } else {
+ return 0;
+ }
+}
+
+
+SV *
+dbd_db_FETCH_attrib (dbh, imp_dbh, keysv)
+ SV *dbh;
+ imp_dbh_t *imp_dbh;
+ SV *keysv;
+{
+ STRLEN kl;
+ char *key = SvPV(keysv,kl);
+ SV *retsv = Nullsv;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_db_FETCH\n"); }
+
+ if (kl==10 && strEQ(key, "AutoCommit")) {
+ retsv = boolSV(DBIc_has(imp_dbh, DBIcf_AutoCommit));
+ } else if (kl==14 && strEQ(key, "pg_auto_escape")) {
+ retsv = newSViv((IV)imp_dbh->pg_auto_escape);
+ } else if (kl==10 && strEQ(key, "pg_bool_tf")) {
+ retsv = newSViv((IV)imp_dbh->pg_bool_tf);
+#ifdef SvUTF8_off
+ } else if (kl==14 && strEQ(key, "pg_enable_utf8")) {
+ retsv = newSViv((IV)imp_dbh->pg_enable_utf8);
+#endif
+ } else if (kl==11 && strEQ(key, "pg_INV_READ")) {
+ retsv = newSViv((IV)INV_READ);
+ } else if (kl==12 && strEQ(key, "pg_INV_WRITE")) {
+ retsv = newSViv((IV)INV_WRITE);
+ }
+
+ if (!retsv) {
+ return Nullsv;
+ }
+ if (retsv == &sv_yes || retsv == &sv_no) {
+ return retsv; /* no need to mortalize yes or no */
+ }
+ return sv_2mortal(retsv);
+}
+
+
+/* driver specific functins */
+
+
+int
+pg_db_lo_open (dbh, lobjId, mode)
+ SV *dbh;
+ unsigned int lobjId;
+ int mode;
+{
+ D_imp_dbh(dbh);
+ return lo_open(imp_dbh->conn, lobjId, mode);
+}
+
+
+int
+pg_db_lo_close (dbh, fd)
+ SV *dbh;
+ int fd;
+{
+ D_imp_dbh(dbh);
+ return lo_close(imp_dbh->conn, fd);
+}
+
+
+int
+pg_db_lo_read (dbh, fd, buf, len)
+ SV *dbh;
+ int fd;
+ char *buf;
+ int len;
+{
+ D_imp_dbh(dbh);
+ return lo_read(imp_dbh->conn, fd, buf, len);
+}
+
+
+int
+pg_db_lo_write (dbh, fd, buf, len)
+ SV *dbh;
+ int fd;
+ char *buf;
+ int len;
+{
+ D_imp_dbh(dbh);
+ return lo_write(imp_dbh->conn, fd, buf, len);
+}
+
+
+int
+pg_db_lo_lseek (dbh, fd, offset, whence)
+ SV *dbh;
+ int fd;
+ int offset;
+ int whence;
+{
+ D_imp_dbh(dbh);
+ return lo_lseek(imp_dbh->conn, fd, offset, whence);
+}
+
+
+unsigned int
+pg_db_lo_creat (dbh, mode)
+ SV *dbh;
+ int mode;
+{
+ D_imp_dbh(dbh);
+ return lo_creat(imp_dbh->conn, mode);
+}
+
+
+int
+pg_db_lo_tell (dbh, fd)
+ SV *dbh;
+ int fd;
+{
+ D_imp_dbh(dbh);
+ return lo_tell(imp_dbh->conn, fd);
+}
+
+
+int
+pg_db_lo_unlink (dbh, lobjId)
+ SV *dbh;
+ unsigned int lobjId;
+{
+ D_imp_dbh(dbh);
+ return lo_unlink(imp_dbh->conn, lobjId);
+}
+
+
+unsigned int
+pg_db_lo_import (dbh, filename)
+ SV *dbh;
+ char *filename;
+{
+ D_imp_dbh(dbh);
+ return lo_import(imp_dbh->conn, filename);
+}
+
+
+int
+pg_db_lo_export (dbh, lobjId, filename)
+ SV *dbh;
+ unsigned int lobjId;
+ char *filename;
+{
+ D_imp_dbh(dbh);
+ return lo_export(imp_dbh->conn, lobjId, filename);
+}
+
+
+int
+pg_db_putline (dbh, buffer)
+ SV *dbh;
+ char *buffer;
+{
+ D_imp_dbh(dbh);
+ return PQputline(imp_dbh->conn, buffer);
+}
+
+
+int
+pg_db_getline (dbh, buffer, length)
+ SV *dbh;
+ char *buffer;
+ int length;
+{
+ D_imp_dbh(dbh);
+ return PQgetline(imp_dbh->conn, buffer, length);
+}
+
+
+int
+pg_db_endcopy (dbh)
+ SV *dbh;
+{
+ D_imp_dbh(dbh);
+ return PQendcopy(imp_dbh->conn);
+}
+
+
+/* ================================================================== */
+
+
+int
+dbd_st_prepare (sth, imp_sth, statement, attribs)
+ SV *sth;
+ imp_sth_t *imp_sth;
+ char *statement;
+ SV *attribs;
+{
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_prepare: statement = >%s<\n", statement); }
+
+ /* scan statement for '?', ':1' and/or ':foo' style placeholders */
+ dbd_preparse(imp_sth, statement);
+
+ /* initialize new statement handle */
+ imp_sth->result = 0;
+ imp_sth->cur_tuple = 0;
+
+ DBIc_IMPSET_on(imp_sth);
+ return 1;
+}
+
+
+static void
+dbd_preparse (imp_sth, statement)
+ imp_sth_t *imp_sth;
+ char *statement;
+{
+ bool in_literal = FALSE;
+ char in_comment = '\0';
+ char *src, *start, *dest;
+ phs_t phs_tpl;
+ SV *phs_sv;
+ int idx=0;
+ char *style="", *laststyle=Nullch;
+ STRLEN namelen;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_preparse: statement = >%s<\n", statement); }
+
+ /* allocate room for copy of statement with spare capacity */
+ /* for editing '?' or ':1' into ':p1'. */
+ /* */
+ /* Note: the calculated length used here for the safemalloc */
+ /* isn't related in any way to the actual worst case length */
+ /* of the translated statement, but allowing for 3 times */
+ /* the length of the original statement should be safe... */
+ imp_sth->statement = (char*)safemalloc(strlen(statement) * 3 + 1);
+
+ /* initialise phs ready to be cloned per placeholder */
+ memset(&phs_tpl, 0, sizeof(phs_tpl));
+ phs_tpl.ftype = 1043; /* VARCHAR */
+
+ src = statement;
+ dest = imp_sth->statement;
+ while(*src) {
+
+ if (in_comment) {
+ /* SQL-style and C++-style */
+ if ((in_comment == '-' || in_comment == '/') && *src == '\n') {
+ in_comment = '\0';
+ }
+ /* C-style */
+ else if (in_comment == '*' && *src == '*' && *(src+1) == '/') {
+ *dest++ = *src++; /* avoids asterisk-slash-asterisk issues */
+ in_comment = '\0';
+ }
+ *dest++ = *src++;
+ continue;
+ }
+
+ if (in_literal) {
+ /* check if literal ends but keep quotes in literal */
+ if (*src == in_literal) {
+ int bs=0;
+ char *str;
+ str = src-1;
+ while (*(str-bs) == '\\')
+ bs++;
+ if (!(bs & 1))
+ in_literal = 0;
+ }
+ *dest++ = *src++;
+ continue;
+ }
+
+ /* Look for comments: SQL-style or C++-style or C-style */
+ if ((*src == '-' && *(src+1) == '-') ||
+ (*src == '/' && *(src+1) == '/') ||
+ (*src == '/' && *(src+1) == '*'))
+ {
+ in_comment = *(src+1);
+ /* We know *src & the next char are to be copied, so do */
+ /* it. In the case of C-style comments, it happens to */
+ /* help us avoid slash-asterisk-slash oddities. */
+ *dest++ = *src++;
+ *dest++ = *src++;
+ continue;
+ }
+
+ /* check if no placeholders */
+ if (*src != ':' && *src != '?') {
+ if (*src == '\'' || *src == '"') {
+ in_literal = *src;
+ }
+ *dest++ = *src++;
+ continue;
+ }
+
+ /* check for cast operator */
+ if (*src == ':' && (*(src-1) == ':' || *(src+1) == ':')) {
+ *dest++ = *src++;
+ continue;
+ }
+
+ /* only here for : or ? outside of a comment or literal and no cast */
+
+ start = dest; /* save name inc colon */
+ *dest++ = *src++;
+ if (*start == '?') { /* X/Open standard */
+ sprintf(start,":p%d", ++idx); /* '?' -> ':p1' (etc) */
+ dest = start+strlen(start);
+ style = "?";
+
+ } else if (isDIGIT(*src)) { /* ':1' */
+ idx = atoi(src);
+ *dest++ = 'p'; /* ':1'->':p1' */
+ if (idx <= 0) {
+ croak("Placeholder :%d invalid, placeholders must be >= 1", idx);
+ }
+ while(isDIGIT(*src)) {
+ *dest++ = *src++;
+ }
+ style = ":1";
+
+ } else if (isALNUM(*src)) { /* ':foo' */
+ while(isALNUM(*src)) { /* includes '_' */
+ *dest++ = *src++;
+ }
+ style = ":foo";
+ } else { /* perhaps ':=' PL/SQL construct */
+ continue;
+ }
+ *dest = '\0'; /* handy for debugging */
+ namelen = (dest-start);
+ if (laststyle && style != laststyle) {
+ croak("Can't mix placeholder styles (%s/%s)",style,laststyle);
+ }
+ laststyle = style;
+ if (imp_sth->all_params_hv == NULL) {
+ imp_sth->all_params_hv = newHV();
+ }
+ phs_tpl.sv = &sv_undef;
+ phs_sv = newSVpv((char*)&phs_tpl, sizeof(phs_tpl)+namelen+1);
+ hv_store(imp_sth->all_params_hv, start, namelen, phs_sv, 0);
+ strcpy( ((phs_t*)(void*)SvPVX(phs_sv))->name, start);
+ }
+ *dest = '\0';
+ if (imp_sth->all_params_hv) {
+ DBIc_NUM_PARAMS(imp_sth) = (int)HvKEYS(imp_sth->all_params_hv);
+ if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, " dbd_preparse scanned %d distinct placeholders\n", (int)DBIc_NUM_PARAMS(imp_sth)); }
+ }
+}
+
+
+/* if it LOOKS like a string, this function will determine whether the type needs to be surrounded in single quotes */
+static int pg_sql_needquote (sql_type)
+ int sql_type;
+{
+ if (sql_type > 1000 || sql_type == 17 || sql_type == 25 ) {
+ return 1;
+ }
+ return 0;
+}
+
+
+
+static int
+pg_sql_type (imp_sth, name, sql_type)
+ imp_sth_t *imp_sth;
+ char *name;
+ int sql_type;
+{
+ switch (sql_type) {
+ case SQL_CHAR:
+ return 1042; /* bpchar */
+ case SQL_NUMERIC:
+ return 700; /* float4 */
+ case SQL_DECIMAL:
+ return 700; /* float4 */
+ case SQL_INTEGER:
+ return 23; /* int4 */
+ case SQL_SMALLINT:
+ return 21; /* int2 */
+ case SQL_FLOAT:
+ return 700; /* float4 */
+ case SQL_REAL:
+ return 701; /* float8 */
+ case SQL_DOUBLE:
+ return 20; /* int8 */
+ case SQL_VARCHAR:
+ return 1043; /* varchar */
+ case SQL_BINARY:
+ return 17; /* bytea */
+ default:
+ if (DBIc_WARN(imp_sth) && imp_sth && name) {
+ warn("SQL type %d for '%s' is not fully supported, bound as VARCHAR instead",
+ sql_type, name);
+ }
+ return pg_sql_type(imp_sth, name, SQL_VARCHAR);
+ }
+}
+
+static int
+sql_pg_type (imp_sth, name, sql_type)
+ imp_sth_t *imp_sth;
+ char *name;
+ int sql_type;
+{
+ if (dbis->debug >= 1) {
+ PerlIO_printf(DBILOGFP, "sql_pg_type name '%s' type '%d'\n", name, sql_type );
+ }
+
+ switch (sql_type) {
+ case 17: /* bytea */
+ return SQL_BINARY;
+ case 20: /* int8 */
+ return SQL_DOUBLE;
+ case 21: /* int2 */
+ return SQL_SMALLINT;
+ case 23: /* int4 */
+ return SQL_INTEGER;
+ case 700: /* float4 */
+ return SQL_NUMERIC;
+ case 701: /* float8 */
+ return SQL_REAL;
+ case 1042: /* bpchar */
+ return SQL_CHAR;
+ case 1043: /* varchar */
+ return SQL_VARCHAR;
+ case 1082: /* date */
+ return SQL_DATE;
+ case 1083: /* time */
+ return SQL_TIME;
+ case 1296: /* date */
+ return SQL_TIMESTAMP;
+
+ default:
+ return sql_type;
+ }
+}
+
+
+static int
+dbd_rebind_ph (sth, imp_sth, phs)
+ SV *sth;
+ imp_sth_t *imp_sth;
+ phs_t *phs;
+{
+ STRLEN value_len;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_rebind\n"); }
+
+ /* convert to a string ASAP */
+ if (!SvPOK(phs->sv) && SvOK(phs->sv)) {
+ sv_2pv(phs->sv, &na);
+ }
+
+ if (dbis->debug >= 2) {
+ char *val = neatsvpv(phs->sv,0);
+ PerlIO_printf(DBILOGFP, " bind %s <== %.1000s (", phs->name, val);
+ if (SvOK(phs->sv)) {
+ PerlIO_printf(DBILOGFP, "size %ld/%ld/%ld, ", (long)SvCUR(phs->sv),(long)SvLEN(phs->sv),phs->maxlen);
+ } else {
+ PerlIO_printf(DBILOGFP, "NULL, ");
+ }
+ PerlIO_printf(DBILOGFP, "ptype %d, otype %d%s)\n", (int)SvTYPE(phs->sv), phs->ftype, (phs->is_inout) ? ", inout" : "");
+ }
+
+ /* At the moment we always do sv_setsv() and rebind. */
+ /* Later we may optimise this so that more often we can */
+ /* just copy the value & length over and not rebind. */
+
+ if (phs->is_inout) { /* XXX */
+ if (SvREADONLY(phs->sv)) {
+ croak(no_modify);
+ }
+ /* phs->sv _is_ the real live variable, it may 'mutate' later */
+ /* pre-upgrade high to reduce risk of SvPVX realloc/move */
+ (void)SvUPGRADE(phs->sv, SVt_PVNV);
+ /* ensure room for result, 28 is magic number (see sv_2pv) */
+ SvGROW(phs->sv, (phs->maxlen < 28) ? 28 : phs->maxlen+1);
+ }
+ else {
+ /* phs->sv is copy of real variable, upgrade to at least string */
+ (void)SvUPGRADE(phs->sv, SVt_PV);
+ }
+
+ /* At this point phs->sv must be at least a PV with a valid buffer, */
+ /* even if it's undef (null) */
+ /* Here we set phs->progv, phs->indp, and value_len. */
+ if (SvOK(phs->sv)) {
+ phs->progv = SvPV(phs->sv, value_len);
+ phs->indp = 0;
+ }
+ else { /* it's null but point to buffer in case it's an out var */
+ phs->progv = SvPVX(phs->sv);
+ phs->indp = -1;
+ value_len = 0;
+ }
+ phs->sv_type = SvTYPE(phs->sv); /* part of mutation check */
+ phs->maxlen = SvLEN(phs->sv)-1; /* avail buffer space */
+ if (phs->maxlen < 0) { /* can happen with nulls */
+ phs->maxlen = 0;
+ }
+
+ phs->alen = value_len + phs->alen_incnull;
+
+ imp_sth->all_params_len += SvOK(phs->sv) ? phs->alen : 4; /* NULL */
+
+ if (dbis->debug >= 3) {
+ PerlIO_printf(DBILOGFP, " bind %s <== '%.*s' (size %ld/%ld, otype %d, indp %d)\n",
+ phs->name,
+ (int)(phs->alen>SvIV(DBIS->neatsvpvlen) ? SvIV(DBIS->neatsvpvlen) : phs->alen),
+ (phs->progv) ? phs->progv : "",
+ (long)phs->alen, (long)phs->maxlen, phs->ftype, phs->indp);
+ }
+
+ return 1;
+}
+
+
+void dereference(value)
+SV** value;
+{
+ AV* buf;
+ SV* val;
+ char *src;
+ int is_ref;
+ STRLEN len;
+
+ if (SvTYPE(SvRV(*value)) != SVt_PVAV)
+ croak("Not an array reference (%s)", neatsvpv(*value,0));
+
+ buf = (AV *) SvRV(*value);
+ sv_setpv(*value, "{");
+ while ( SvOK(val = av_shift(buf)) ) {
+ is_ref = SvROK(val);
+ if (is_ref)
+ dereference(&val);
+ else
+ sv_catpv(*value, "\"");
+ /* Quote */
+ src = SvPV(val, len);
+ while (len--) {
+ if (!is_ref && *src == '\"')
+ sv_catpv(*value, "\\");
+ sv_catpvn(*value, src++, 1);
+ }
+ /* End of quote */
+ if (!is_ref)
+ sv_catpv(*value, "\"");
+ if (av_len(buf) > -1)
+ sv_catpv(*value, array_delimiter);
+ }
+ sv_catpv(*value, "}");
+ av_clear(buf);
+}
+
+int
+dbd_bind_ph (sth, imp_sth, ph_namesv, newvalue, sql_type, attribs, is_inout, maxlen)
+ SV *sth;
+ imp_sth_t *imp_sth;
+ SV *ph_namesv;
+ SV *newvalue;
+ IV sql_type;
+ SV *attribs;
+ int is_inout;
+ IV maxlen;
+{
+ SV **phs_svp;
+ STRLEN name_len;
+ char *name;
+ char namebuf[30];
+ phs_t *phs;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_bind_ph\n"); }
+
+ /* check if placeholder was passed as a number */
+
+ if (SvGMAGICAL(ph_namesv)) { /* eg if from tainted expression */
+ mg_get(ph_namesv);
+ }
+ if (!SvNIOKp(ph_namesv)) {
+ name = SvPV(ph_namesv, name_len);
+ }
+ if (SvNIOKp(ph_namesv) || (name && isDIGIT(name[0]))) {
+ sprintf(namebuf, ":p%d", (int)SvIV(ph_namesv));
+ name = namebuf;
+ name_len = strlen(name);
+ }
+ assert(name != Nullch);
+
+ if (SvTYPE(newvalue) > SVt_PVLV) { /* hook for later array logic */
+ croak("Can't bind a non-scalar value (%s)", neatsvpv(newvalue,0));
+ }
+ if (SvROK(newvalue) && !IS_DBI_HANDLE(newvalue)) {
+ /* dbi handle allowed for cursor variables */
+ dereference(&newvalue);
+ }
+ if (SvTYPE(newvalue) == SVt_PVLV && is_inout) { /* may allow later */
+ croak("Can't bind ``lvalue'' mode scalar as inout parameter (currently)");
+ }
+
+ if (dbis->debug >= 2) {
+ PerlIO_printf(DBILOGFP, " bind %s <== %s (type %ld", name, neatsvpv(newvalue,0), (long)sql_type);
+ if (is_inout) {
+ PerlIO_printf(DBILOGFP, ", inout 0x%lx, maxlen %ld", (long)newvalue, (long)maxlen);
+ }
+ if (attribs) {
+ PerlIO_printf(DBILOGFP, ", attribs: %s", neatsvpv(attribs,0));
+ }
+ PerlIO_printf(DBILOGFP, ")\n");
+ }
+
+ phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0);
+ if (phs_svp == NULL) {
+ croak("Can't bind unknown placeholder '%s' (%s)", name, neatsvpv(ph_namesv,0));
+ }
+ phs = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder struct */
+
+ if (phs->sv == &sv_undef) { /* first bind for this placeholder */
+ phs->ftype = 1043; /* our default type VARCHAR */
+ phs->is_inout = is_inout;
+ if (is_inout) {
+ /* phs->sv assigned in the code below */
+ ++imp_sth->has_inout_params;
+ /* build array of phs's so we can deal with out vars fast */
+ if (!imp_sth->out_params_av) {
+ imp_sth->out_params_av = newAV();
+ }
+ av_push(imp_sth->out_params_av, SvREFCNT_inc(*phs_svp));
+ }
+
+ if (attribs) { /* only look for pg_type on first bind of var */
+ SV **svp;
+ /* Setup / Clear attributes as defined by attribs. */
+ /* XXX If attribs is EMPTY then reset attribs to default? */
+ if ( (svp = hv_fetch((HV*)SvRV(attribs), "pg_type", 7, 0)) != NULL) {
+ int pg_type = SvIV(*svp);
+ if (!pgtype_bind_ok(pg_type)) {
+ croak("Can't bind %s, pg_type %d not supported by DBD::Pg", phs->name, pg_type);
+ }
+ if (sql_type) {
+ croak("Can't specify both TYPE (%d) and pg_type (%d) for %s", sql_type, pg_type, phs->name);
+ }
+ phs->ftype = pg_type;
+ }
+ }
+ if (sql_type) {
+ /* SQL_BINARY (-2) is deprecated. */
+ if (sql_type == -2 && DBIc_WARN(imp_sth)) {
+ warn("Use of SQL type SQL_BINARY (%d) is deprecated. Use { pg_type => DBD::Pg::PG_BYTEA } instead.", sql_type);
+ }
+ phs->ftype = pg_sql_type(imp_sth, phs->name, sql_type);
+ }
+ } /* was first bind for this placeholder */
+
+ /* check later rebinds for any changes */
+ else if (is_inout || phs->is_inout) {
+ croak("Can't rebind or change param %s in/out mode after first bind (%d => %d)", phs->name, phs->is_inout , is_inout);
+ }
+ else if (sql_type && phs->ftype != pg_sql_type(imp_sth, phs->name, sql_type)) {
+ croak("Can't change TYPE of param %s to %d after initial bind", phs->name, sql_type);
+ }
+
+ phs->maxlen = maxlen; /* 0 if not inout */
+
+ if (!is_inout) { /* normal bind to take a (new) copy of current value */
+ if (phs->sv == &sv_undef) { /* (first time bind) */
+ phs->sv = newSV(0);
+ }
+ sv_setsv(phs->sv, newvalue);
+ } else if (newvalue != phs->sv) {
+ if (phs->sv) {
+ SvREFCNT_dec(phs->sv);
+ }
+ phs->sv = SvREFCNT_inc(newvalue); /* point to live var */
+ }
+
+ return dbd_rebind_ph(sth, imp_sth, phs);
+}
+
+
+int
+dbd_st_execute (sth, imp_sth) /* <= -2:error, >=0:ok row count, (-1=unknown count) */
+ SV *sth;
+ imp_sth_t *imp_sth;
+{
+ dTHR;
+
+ D_imp_dbh_from_sth;
+ ExecStatusType status = -1;
+ char *cmdStatus;
+ char *cmdTuples;
+ char *statement;
+ int ret = -2;
+ int num_fields;
+ int i;
+ STRLEN len;
+ bool in_literal = FALSE;
+ char in_comment = '\0';
+ char *src;
+ char *dest;
+ char *val;
+ char namebuf[30];
+ phs_t *phs;
+ SV **svp;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_execute\n"); }
+
+ /*
+ here we get the statement from the statement handle where
+ it has been stored when creating a blank sth during prepare
+ svp = hv_fetch((HV *)SvRV(sth), "Statement", 9, FALSE);
+ statement = SvPV(*svp, na);
+ */
+
+ if (NULL == imp_dbh->conn) {
+ pg_error(sth, -1, "execute on disconnected handle");
+ return -2;
+ }
+
+ statement = imp_sth->statement;
+ if (! statement) {
+ /* are we prepared ? */
+ pg_error(sth, -1, "statement not prepared\n");
+ return -2;
+ }
+
+ /* do we have input parameters ? */
+ if ((int)DBIc_NUM_PARAMS(imp_sth) > 0) {
+ /*
+ we have to allocate some additional memory for possible escaping
+ quotes and backslashes:
+ max_len = length of statement
+ + total length of all params allowing for worst case all
+ characters binary-escaped (\\xxx)
+ + null terminator
+ Note: parameters look like :p1 at this point, so there's no
+ need to explicitly allow for surrounding quotes because '' is
+ shorter than :p1
+ */
+ int max_len = strlen(imp_sth->statement) + imp_sth->all_params_len * 5 + 1;
+ statement = (char*)safemalloc( max_len );
+ dest = statement;
+ src = imp_sth->statement;
+ /* scan statement for ':p1' style placeholders */
+ while(*src) {
+
+ if (in_comment) {
+ /* SQL-style and C++-style */
+ if ((in_comment == '-' || in_comment == '/') && *src == '\n') {
+ in_comment = '\0';
+ }
+ /* C-style */
+ else if (in_comment == '*' && *src == '*' && *(src+1) == '/') {
+ *dest++ = *src++; /* avoids asterisk-slash-asterisk issues */
+ in_comment = '\0';
+ }
+ *dest++ = *src++;
+ continue;
+ }
+
+ if (in_literal) {
+ /* check if literal ends but keep quotes in literal */
+ if (*src == in_literal) {
+ int bs=0;
+ char *str;
+ str = src-1;
+ while (*(str-bs) == '\\')
+ bs++;
+ if (!(bs & 1))
+ in_literal = 0;
+ }
+ *dest++ = *src++;
+ continue;
+ }
+
+ /* Look for comments: SQL-style or C++-style or C-style */
+ if ((*src == '-' && *(src+1) == '-') ||
+ (*src == '/' && *(src+1) == '/') ||
+ (*src == '/' && *(src+1) == '*'))
+ {
+ in_comment = *(src+1);
+ /* We know *src & the next char are to be copied, so do */
+ /* it. In the case of C-style comments, it happens to */
+ /* help us avoid slash-asterisk-slash oddities. */
+ *dest++ = *src++;
+ *dest++ = *src++;
+ continue;
+ }
+
+ /* check if no placeholders */
+ if (*src != ':' && *src != '?') {
+ if (*src == '\'' || *src == '"') {
+ in_literal = *src;
+ }
+ *dest++ = *src++;
+ continue;
+ }
+
+ /* check for cast operator */
+ if (*src == ':' && (*(src-1) == ':' || *(src+1) == ':')) {
+ *dest++ = *src++;
+ continue;
+ }
+
+
+ i = 0;
+ namebuf[i++] = *src++; /* ':' */
+ namebuf[i++] = *src++; /* 'p' */
+
+ while (isDIGIT(*src) && i < (sizeof(namebuf)-1) ) {
+ namebuf[i++] = *src++;
+ }
+ if ( i == (sizeof(namebuf) - 1)) {
+ pg_error(sth, -1, "namebuf buffer overrun\n");
+ return -2;
+ }
+ namebuf[i] = '\0';
+ svp = hv_fetch(imp_sth->all_params_hv, namebuf, i, 0);
+ if (svp == NULL) {
+ pg_error(sth, -1, "parameter unknown\n");
+ return -2;
+ }
+ /* get attribute */
+ phs = (phs_t*)(void*)SvPVX(*svp);
+ /* replace undef with NULL */
+ if(!SvOK(phs->sv)) {
+ val = "NULL";
+ len = 4;
+ } else {
+ val = SvPV(phs->sv, len);
+ }
+ /* quote string attribute */
+ if(!SvNIOK(phs->sv) && SvOK(phs->sv) && pg_sql_needquote(phs->ftype)) { /* avoid quoting NULL, tpf: bind_param as numeric */
+ *dest++ = '\'';
+ }
+ while (len--) {
+ if (imp_dbh->pg_auto_escape) {
+ /* if the parameter was bound as PG_BYTEA, escape nonprintables */
+ if (phs->ftype == 17 && !isPRINT(*val)) { /* escape null character */
+ dest+=snprintf(dest, (statement + max_len) - dest, "\\\\%03o", *((unsigned char *)val));
+ if (dest > statement + max_len) {
+ pg_error(sth, -1, "statement buffer overrun\n");
+ return -2;
+ }
+ val++;
+ continue; /* do not copy the null */
+ }
+ /* escape quote */
+ if (*val == '\'') {
+ *dest++ = '\'';
+ }
+ /* escape backslash */
+ if (*val == '\\') {
+ if (phs->ftype == 17) { /* four backslashes. really. */
+ *dest++ = '\\';
+ *dest++ = '\\';
+ *dest++ = '\\';
+ } else {
+ *dest++ = '\\';
+ }
+ }
+ }
+ /* copy attribute to statement */
+ *dest++ = *val++;
+ }
+ /* quote string attribute */
+ if(!SvNIOK(phs->sv) && SvOK(phs->sv) && pg_sql_needquote(phs->ftype)) { /* avoid quoting NULL, tpf: bind_param as numeric */
+ *dest++ = '\'';
+ }
+ }
+ *dest = '\0';
+ }
+
+ if (dbis->debug >= 2) { PerlIO_printf(DBILOGFP, "dbd_st_execute: statement = >%s<\n", statement); }
+
+ /* clear old result (if any) */
+ if (imp_sth->result) {
+ PQclear(imp_sth->result);
+ }
+
+ /* execute statement */
+ imp_sth->result = PQexec(imp_dbh->conn, statement);
+
+ /* free statement string in case of input parameters */
+ if ((int)DBIc_NUM_PARAMS(imp_sth) > 0) {
+ Safefree(statement);
+ }
+
+ /* check status */
+ status = imp_sth->result ? PQresultStatus(imp_sth->result) : -1;
+ cmdStatus = imp_sth->result ? (char *)PQcmdStatus(imp_sth->result) : "";
+ cmdTuples = imp_sth->result ? (char *)PQcmdTuples(imp_sth->result) : "";
+
+ if (PGRES_TUPLES_OK == status) {
+ /* select statement */
+ num_fields = PQnfields(imp_sth->result);
+ imp_sth->cur_tuple = 0;
+ DBIc_NUM_FIELDS(imp_sth) = num_fields;
+ DBIc_ACTIVE_on(imp_sth);
+ ret = PQntuples(imp_sth->result);
+ } else if (PGRES_COMMAND_OK == status) {
+ /* non-select statement */
+ if (! strncmp(cmdStatus, "DELETE", 6) || ! strncmp(cmdStatus, "INSERT", 6) || ! strncmp(cmdStatus, "UPDATE", 6)) {
+ ret = atoi(cmdTuples);
+ } else {
+ ret = -1;
+ }
+ } else if (PGRES_COPY_OUT == status || PGRES_COPY_IN == status) {
+ /* Copy Out/In data transfer in progress */
+ ret = -1;
+ } else {
+ pg_error(sth, status, PQerrorMessage(imp_dbh->conn));
+ ret = -2;
+ }
+
+ /* store the number of affected rows */
+ imp_sth->rows = ret;
+
+ return ret;
+}
+
+
+int
+is_high_bit_set(val)
+ char *val;
+{
+ while (*val++)
+ if (*val & 0x80) return 1;
+ return 0;
+}
+
+AV *
+dbd_st_fetch (sth, imp_sth)
+ SV *sth;
+ imp_sth_t *imp_sth;
+{
+ D_imp_dbh_from_sth;
+ int num_fields;
+ int i;
+ AV *av;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_fetch\n"); }
+
+ /* Check that execute() was executed sucessfully */
+ if ( !DBIc_ACTIVE(imp_sth) ) {
+ pg_error(sth, 1, "no statement executing\n");
+
+ return Nullav;
+ }
+
+ if ( imp_sth->cur_tuple == PQntuples(imp_sth->result) ) {
+ imp_sth->cur_tuple = 0;
+ DBIc_ACTIVE_off(imp_sth);
+ return Nullav; /* we reached the last tuple */
+ }
+
+ av = DBIS->get_fbav(imp_sth);
+ num_fields = AvFILL(av)+1;
+
+ for(i = 0; i < num_fields; ++i) {
+
+ SV *sv = AvARRAY(av)[i];
+ if (PQgetisnull(imp_sth->result, imp_sth->cur_tuple, i)) {
+ sv_setsv(sv, &sv_undef);
+ } else {
+ char *val = (char*)PQgetvalue(imp_sth->result, imp_sth->cur_tuple, i);
+ int val_len = strlen(val);
+ int type = PQftype(imp_sth->result, i); /* hopefully these hard coded values will not change */
+ if (16 == type && ! imp_dbh->pg_bool_tf) {
+ *val = (*val == 'f') ? '0' : '1'; /* bool: translate postgres into perl */
+ }
+ if (17 == type) { /* decode \001 -> chr(1), etc, in-place */
+ char *p = val; /* points to next available pos */
+ char *s = val; /* points to current scanning pos */
+ int c1,c2,c3;
+ while (*s) {
+ if (*s == '\\') {
+ if (*(s+1) == '\\') { /* double backslash */
+ *p++ = '\\';
+ s += 2;
+ continue;
+ }
+ else if ( isdigit(c1=(*(s+1))) &&
+ isdigit(c2=(*(s+2))) &&
+ isdigit(c3=(*(s+3))) ) {
+ *p++ = (c1 - '0') * 64 + (c2 - '0') * 8 + (c3 - '0');
+ s += 4;
+ continue;
+ }
+ }
+ *p++ = *s++;
+ }
+ val_len = (p - val);
+ }
+ else if (1042 == type && DBIc_has(imp_sth,DBIcf_ChopBlanks)) {
+ char *str = val;
+ while((val_len > 0) && (str[val_len-1] == ' ')) {
+ val_len--;
+ }
+ val[val_len] = '\0';
+ }
+ sv_setpvn(sv, val, val_len);
+#ifdef SvUTF8_off
+ if (imp_dbh->pg_enable_utf8) {
+ SvUTF8_off(sv);
+ /* XXX Is this all the character data types? */
+ if (18 == type || 25 == type || 1042 ==type || 1043 == type) {
+ if (is_high_bit_set(val) && is_utf8_string(val, val_len))
+ SvUTF8_on(sv);
+ }
+ }
+#endif
+ }
+ }
+
+ imp_sth->cur_tuple += 1;
+
+ return av;
+}
+
+
+int
+dbd_st_blob_read (sth, imp_sth, lobjId, offset, len, destrv, destoffset)
+ SV *sth;
+ imp_sth_t *imp_sth;
+ int lobjId;
+ long offset;
+ long len;
+ SV *destrv;
+ long destoffset;
+{
+ D_imp_dbh_from_sth;
+ int ret, lobj_fd, nbytes, nread;
+ PGresult* result;
+ ExecStatusType status;
+ SV *bufsv;
+ char *tmp;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_blob_read\n"); }
+ /* safety check */
+ if (lobjId <= 0) {
+ pg_error(sth, -1, "dbd_st_blob_read: lobjId <= 0");
+ return 0;
+ }
+ if (offset < 0) {
+ pg_error(sth, -1, "dbd_st_blob_read: offset < 0");
+ return 0;
+ }
+ if (len < 0) {
+ pg_error(sth, -1, "dbd_st_blob_read: len < 0");
+ return 0;
+ }
+ if (! SvROK(destrv)) {
+ pg_error(sth, -1, "dbd_st_blob_read: destrv not a reference");
+ return 0;
+ }
+ if (destoffset < 0) {
+ pg_error(sth, -1, "dbd_st_blob_read: destoffset < 0");
+ return 0;
+ }
+
+ /* dereference destination and ensure it's writable string */
+ bufsv = SvRV(destrv);
+ if (! destoffset) {
+ sv_setpvn(bufsv, "", 0);
+ }
+
+ /* execute begin
+ result = PQexec(imp_dbh->conn, "begin");
+ status = result ? PQresultStatus(result) : -1;
+ PQclear(result);
+ if (status != PGRES_COMMAND_OK) {
+ pg_error(sth, status, PQerrorMessage(imp_dbh->conn));
+ return 0;
+ }
+ */
+
+ /* open large object */
+ lobj_fd = lo_open(imp_dbh->conn, lobjId, INV_READ);
+ if (lobj_fd < 0) {
+ pg_error(sth, -1, PQerrorMessage(imp_dbh->conn));
+ return 0;
+ }
+
+ /* seek on large object */
+ if (offset > 0) {
+ ret = lo_lseek(imp_dbh->conn, lobj_fd, offset, SEEK_SET);
+ if (ret < 0) {
+ pg_error(sth, -1, PQerrorMessage(imp_dbh->conn));
+ return 0;
+ }
+ }
+
+ /* read from large object */
+ nread = 0;
+ SvGROW(bufsv, destoffset + nread + BUFSIZ + 1);
+ tmp = (SvPVX(bufsv)) + destoffset + nread;
+ while ((nbytes = lo_read(imp_dbh->conn, lobj_fd, tmp, BUFSIZ)) > 0) {
+ nread += nbytes;
+ /* break if user wants only a specified chunk */
+ if (len > 0 && nread > len) {
+ nread = len;
+ break;
+ }
+ SvGROW(bufsv, destoffset + nread + BUFSIZ + 1);
+ tmp = (SvPVX(bufsv)) + destoffset + nread;
+ }
+
+ /* terminate string */
+ SvCUR_set(bufsv, destoffset + nread);
+ *SvEND(bufsv) = '\0';
+
+ /* close large object */
+ ret = lo_close(imp_dbh->conn, lobj_fd);
+ if (ret < 0) {
+ pg_error(sth, -1, PQerrorMessage(imp_dbh->conn));
+ return 0;
+ }
+
+ /* execute end
+ result = PQexec(imp_dbh->conn, "end");
+ status = result ? PQresultStatus(result) : -1;
+ PQclear(result);
+ if (status != PGRES_COMMAND_OK) {
+ pg_error(sth, status, PQerrorMessage(imp_dbh->conn));
+ return 0;
+ }
+ */
+
+ return nread;
+}
+
+
+int
+dbd_st_rows (sth, imp_sth)
+ SV *sth;
+ imp_sth_t *imp_sth;
+{
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_rows\n"); }
+
+ return imp_sth->rows;
+}
+
+
+int
+dbd_st_finish (sth, imp_sth)
+ SV *sth;
+ imp_sth_t *imp_sth;
+{
+ dTHR;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_finish\n"); }
+
+ if (DBIc_ACTIVE(imp_sth) && imp_sth->result) {
+ PQclear(imp_sth->result);
+ imp_sth->result = 0;
+ imp_sth->rows = 0;
+ }
+
+ DBIc_ACTIVE_off(imp_sth);
+ return 1;
+}
+
+
+void
+dbd_st_destroy (sth, imp_sth)
+ SV *sth;
+ imp_sth_t *imp_sth;
+{
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_destroy\n"); }
+
+ /* Free off contents of imp_sth */
+
+ Safefree(imp_sth->statement);
+ if (imp_sth->result) {
+ PQclear(imp_sth->result);
+ imp_sth->result = 0;
+ }
+
+ if (imp_sth->out_params_av)
+ sv_free((SV*)imp_sth->out_params_av);
+
+ if (imp_sth->all_params_hv) {
+ HV *hv = imp_sth->all_params_hv;
+ SV *sv;
+ char *key;
+ I32 retlen;
+ hv_iterinit(hv);
+ while( (sv = hv_iternextsv(hv, &key, &retlen)) != NULL ) {
+ if (sv != &sv_undef) {
+ phs_t *phs_tpl = (phs_t*)(void*)SvPVX(sv);
+ sv_free(phs_tpl->sv);
+ }
+ }
+ sv_free((SV*)imp_sth->all_params_hv);
+ }
+
+ DBIc_IMPSET_off(imp_sth); /* let DBI know we've done it */
+}
+
+
+int
+dbd_st_STORE_attrib (sth, imp_sth, keysv, valuesv)
+ SV *sth;
+ imp_sth_t *imp_sth;
+ SV *keysv;
+ SV *valuesv;
+{
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_STORE\n"); }
+
+ return FALSE;
+}
+
+
+SV *
+dbd_st_FETCH_attrib (sth, imp_sth, keysv)
+ SV *sth;
+ imp_sth_t *imp_sth;
+ SV *keysv;
+{
+ STRLEN kl;
+ char *key = SvPV(keysv,kl);
+ int i, sz;
+ SV *retsv = Nullsv;
+
+ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_FETCH\n"); }
+
+ if (! imp_sth->result) {
+ return Nullsv;
+ }
+
+ i = DBIc_NUM_FIELDS(imp_sth);
+
+ if (kl == 4 && strEQ(key, "NAME")) {
+ AV *av = newAV();
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0) {
+ av_store(av, i, newSVpv(PQfname(imp_sth->result, i),0));
+ }
+ } else if ( kl== 4 && strEQ(key, "TYPE")) {
+ /* Need to convert the Pg type to ANSI/SQL type. */
+ AV *av = newAV();
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0) {
+ av_store(av, i, newSViv(sql_pg_type( imp_sth,
+ PQfname(imp_sth->result, i),
+ PQftype(imp_sth->result, i))));
+ }
+ } else if (kl==9 && strEQ(key, "PRECISION")) {
+ AV *av = newAV();
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0) {
+ sz = PQfsize(imp_sth->result, i);
+ av_store(av, i, sz > 0 ? newSViv(sz) : &sv_undef);
+ }
+ } else if (kl==5 && strEQ(key, "SCALE")) {
+ AV *av = newAV();
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0) {
+ av_store(av, i, &sv_undef);
+ }
+ } else if (kl==8 && strEQ(key, "NULLABLE")) {
+ AV *av = newAV();
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0) {
+ av_store(av, i, newSViv(2));
+ }
+ } else if (kl==10 && strEQ(key, "CursorName")) {
+ retsv = &sv_undef;
+ } else if (kl==11 && strEQ(key, "RowsInCache")) {
+ retsv = &sv_undef;
+ } else if (kl==7 && strEQ(key, "pg_size")) {
+ AV *av = newAV();
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0) {
+ av_store(av, i, newSViv(PQfsize(imp_sth->result, i)));
+ }
+ } else if (kl==7 && strEQ(key, "pg_type")) {
+ AV *av = newAV();
+ char *type_nam;
+ retsv = newRV(sv_2mortal((SV*)av));
+ while(--i >= 0) {
+ switch (PQftype(imp_sth->result, i)) {
+ case 16:
+ type_nam = "bool";
+ break;
+ case 17:
+ type_nam = "bytea";
+ break;
+ case 18:
+ type_nam = "char";
+ break;
+ case 19:
+ type_nam = "name";
+ break;
+ case 20:
+ type_nam = "int8";
+ break;
+ case 21:
+ type_nam = "int2";
+ break;
+ case 22:
+ type_nam = "int28";
+ break;
+ case 23:
+ type_nam = "int4";
+ break;
+ case 24:
+ type_nam = "regproc";
+ break;
+ case 25:
+ type_nam = "text";
+ break;
+ case 26:
+ type_nam = "oid";
+ break;
+ case 27:
+ type_nam = "tid";
+ break;
+ case 28:
+ type_nam = "xid";
+ break;
+ case 29:
+ type_nam = "cid";
+ break;
+ case 30:
+ type_nam = "oid8";
+ break;
+ case 32:
+ type_nam = "SET";
+ break;
+ case 210:
+ type_nam = "smgr";
+ break;
+ case 600:
+ type_nam = "point";
+ break;
+ case 601:
+ type_nam = "lseg";
+ break;
+ case 602:
+ type_nam = "path";
+ break;
+ case 603:
+ type_nam = "box";
+ break;
+ case 604:
+ type_nam = "polygon";
+ break;
+ case 605:
+ type_nam = "filename";
+ break;
+ case 628:
+ type_nam = "line";
+ break;
+ case 629:
+ type_nam = "_line";
+ break;
+ case 700:
+ type_nam = "float4";
+ break;
+ case 701:
+ type_nam = "float8";
+ break;
+ case 702:
+ type_nam = "abstime";
+ break;
+ case 703:
+ type_nam = "reltime";
+ break;
+ case 704:
+ type_nam = "tinterval";
+ break;
+ case 705:
+ type_nam = "unknown";
+ break;
+ case 718:
+ type_nam = "circle";
+ break;
+ case 719:
+ type_nam = "_circle";
+ break;
+ case 790:
+ type_nam = "money";
+ break;
+ case 791:
+ type_nam = "_money";
+ break;
+ case 810:
+ type_nam = "oidint2";
+ break;
+ case 910:
+ type_nam = "oidint4";
+ break;
+ case 911:
+ type_nam = "oidname";
+ break;
+ case 1000:
+ type_nam = "_bool";
+ break;
+ case 1001:
+ type_nam = "_bytea";
+ break;
+ case 1002:
+ type_nam = "_char";
+ break;
+ case 1003:
+ type_nam = "_name";
+ break;
+ case 1005:
+ type_nam = "_int2";
+ break;
+ case 1006:
+ type_nam = "_int28";
+ break;
+ case 1007:
+ type_nam = "_int4";
+ break;
+ case 1008:
+ type_nam = "_regproc";
+ break;
+ case 1009:
+ type_nam = "_text";
+ break;
+ case 1028:
+ type_nam = "_oid";
+ break;
+ case 1010:
+ type_nam = "_tid";
+ break;
+ case 1011:
+ type_nam = "_xid";
+ break;
+ case 1012:
+ type_nam = "_cid";
+ break;
+ case 1013:
+ type_nam = "_oid8";
+ break;
+ case 1014:
+ type_nam = "_lock";
+ break;
+ case 1015:
+ type_nam = "_stub";
+ break;
+ case 1016:
+ type_nam = "_ref";
+ break;
+ case 1017:
+ type_nam = "_point";
+ break;
+ case 1018:
+ type_nam = "_lseg";
+ break;
+ case 1019:
+ type_nam = "_path";
+ break;
+ case 1020:
+ type_nam = "_box";
+ break;
+ case 1021:
+ type_nam = "_float4";
+ break;
+ case 1022:
+ type_nam = "_float8";
+ break;
+ case 1023:
+ type_nam = "_abstime";
+ break;
+ case 1024:
+ type_nam = "_reltime";
+ break;
+ case 1025:
+ type_nam = "_tinterval";
+ break;
+ case 1026:
+ type_nam = "_filename";
+ break;
+ case 1027:
+ type_nam = "_polygon";
+ break;
+ case 1033:
+ type_nam = "aclitem";
+ break;
+ case 1034:
+ type_nam = "_aclitem";
+ break;
+ case 1042:
+ type_nam = "bpchar";
+ break;
+ case 1043:
+ type_nam = "varchar";
+ break;
+ case 1082:
+ type_nam = "date";
+ break;
+ case 1083:
+ type_nam = "time";
+ break;
+ case 1182:
+ type_nam = "_date";
+ break;
+ case 1183:
+ type_nam = "_time";
+ break;
+ case 1184:
+ type_nam = "datetime";
+ break;
+ case 1185:
+ type_nam = "_datetime";
+ break;
+ case 1186:
+ type_nam = "timespan";
+ break;
+ case 1187:
+ type_nam = "_timespan";
+ break;
+ case 1231:
+ type_nam = "_numeric";
+ break;
+ case 1296:
+ type_nam = "timestamp";
+ break;
+ case 1700:
+ type_nam = "numeric";
+ break;
+
+ default:
+ type_nam = "unknown";
+
+ }
+ av_store(av, i, newSVpv(type_nam, 0));
+ }
+ } else if (kl==13 && strEQ(key, "pg_oid_status")) {
+ retsv = newSVpv((char *)PQoidStatus(imp_sth->result), 0);
+ } else if (kl==13 && strEQ(key, "pg_cmd_status")) {
+ retsv = newSVpv((char *)PQcmdStatus(imp_sth->result), 0);
+ } else {
+ return Nullsv;
+ }
+
+ return sv_2mortal(retsv);
+}
+
+
+/* end of dbdimp.c */
--- /dev/null
+/*
+ $Id: dbdimp.h,v 1.1.2.1 2004-04-29 09:40:07 ivan Exp $
+
+ Copyright (c) 1997,1998,1999,2000 Edmund Mergl
+ Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
+
+ You may distribute under the terms of either the GNU General Public
+ License or the Artistic License, as specified in the Perl README file.
+*/
+
+#ifdef WIN32
+#define snprintf _snprintf
+#endif
+
+/* Define drh implementor data structure */
+struct imp_drh_st {
+ dbih_drc_t com; /* MUST be first element in structure */
+};
+
+/* Define dbh implementor data structure */
+struct imp_dbh_st {
+ dbih_dbc_t com; /* MUST be first element in structure */
+
+ PGconn * conn; /* connection structure */
+ int init_commit; /* initialize AutoCommit */
+ int pg_auto_escape; /* initialize AutoEscape */
+ int pg_bool_tf; /* do bools return 't'/'f' */
+#ifdef SvUTF8_off
+ int pg_enable_utf8; /* should we attempt to make utf8 strings? */
+#endif
+};
+
+/* Define sth implementor data structure */
+struct imp_sth_st {
+ dbih_stc_t com; /* MUST be first element in structure */
+
+ PGresult* result; /* result structure */
+ int cur_tuple; /* current tuple */
+ int rows; /* number of affected rows */
+
+ /* Input Details */
+ char *statement; /* sql (see sth_scan) */
+ HV *all_params_hv; /* all params, keyed by name */
+ AV *out_params_av; /* quick access to inout params */
+ int pg_pad_empty; /* convert ""->" " when binding */
+ int all_params_len; /* length-sum of all params */
+
+ /* (In/)Out Parameter Details */
+ bool has_inout_params;
+};
+
+
+#define sword signed int
+#define sb2 signed short
+#define ub2 unsigned short
+
+typedef struct phs_st phs_t; /* scalar placeholder */
+
+struct phs_st { /* scalar placeholder EXPERIMENTAL */
+ sword ftype; /* external OCI field type */
+
+ SV *sv; /* the scalar holding the value */
+ int sv_type; /* original sv type at time of bind */
+ bool is_inout;
+
+ IV maxlen; /* max possible len (=allocated buffer) */
+
+ /* these will become an array */
+ sb2 indp; /* null indicator */
+ char *progv;
+ ub2 arcode;
+ IV alen; /* effective length ( <= maxlen ) */
+
+ int alen_incnull; /* 0 or 1 if alen should include null */
+ char name[1]; /* struct is malloc'd bigger as needed */
+};
+
+
+SV * dbd_db_pg_notifies (SV *dbh, imp_dbh_t *imp_dbh);
+
+/* end of dbdimp.h */
--- /dev/null
+#!/usr/local/bin/perl
+
+# $Id: ApacheDBI.pl,v 1.1.2.1 2004-04-29 09:40:07 ivan Exp $
+
+# don't forget to create in postgres the user who is running
+# the httpd, eg 'createuser nobody' !
+#
+# demo script, tested with:
+# - PostgreSQL-7.1.1
+# - apache_1.3.12
+# - mod_perl-1.23
+# - perl5.6.0
+# - DBI-1.14
+
+use CGI;
+use DBI;
+use strict;
+
+my $query = new CGI;
+
+print $query->header,
+ $query->start_html(-title=>'A Simple Example'),
+ $query->startform,
+ "<CENTER><H3>Testing Module DBI</H3></CENTER>",
+ "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>",
+ "<TR><TD>Enter the data source: </TD>",
+ "<TD>", $query->textfield(-name=>'data_source', -size=>40, -default=>'dbi:Pg:dbname=template1'), "</TD>",
+ "</TR>",
+ "<TR><TD>Enter the user name: </TD>",
+ "<TD>", $query->textfield(-name=>'username'), "</TD>",
+ "</TR>",
+ "<TR><TD>Enter the password: </TD>",
+ "<TD>", $query->textfield(-name=>'auth'), "</TD>",
+ "</TR>",
+ "<TR><TD>Enter the select command: </TD>",
+ "<TD>", $query->textfield(-name=>'cmd', -size=>40), "</TD>",
+ "</TR>",
+ "</TABLE></CENTER><P>",
+ "<CENTER>", $query->submit(-value=>'Submit'), "</CENTER>",
+ $query->endform;
+
+if ($query->param) {
+
+ my $data_source = $query->param('data_source');
+ my $username = $query->param('username');
+ my $auth = $query->param('auth');
+ my $cmd = $query->param('cmd');
+ my $dbh = DBI->connect($data_source, $username, $auth);
+ if ($dbh) {
+ my $sth = $dbh->prepare($cmd);
+ my $ret = $sth->execute;
+ if ($ret) {
+ my($i, $ary_ref);
+ print "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>\n";
+ while ($ary_ref = $sth->fetchrow_arrayref) {
+ print "<TR><TD>", join("</TD><TD>", @$ary_ref), "</TD></TR>\n";
+ }
+ print "</TABLE></CENTER><P>\n";
+ $sth->finish;
+ } else {
+ print "<CENTER><H2>", $DBI::errstr, "</H2></CENTER>\n";
+ }
+ $dbh->disconnect;
+ } else {
+ print "<CENTER><H2>", $DBI::errstr, "</H2></CENTER>\n";
+ }
+}
+
+print $query->end_html;
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+
+use DBI;
+use DBD::Pg;
+
+my $dsn = "dbname=p1";
+my $dbh = DBI->connect('dbi:Pg:dbname=p1', undef, undef, { AutoCommit => 1 });
+
+my $buf = 'abcdefghijklmnopqrstuvwxyz' x 400;
+
+my $id = write_blob($dbh, undef, $buf);
+
+my $dat = read_blob($dbh, $id);
+
+print "Done\n";
+
+sub write_blob {
+ my ($dbh, $lobj_id, $data) = @_;
+
+ # begin transaction
+ $dbh->{AutoCommit} = 0;
+
+ # Create a new lo if we are not passed an lo object ID.
+ unless ($lobj_id) {
+ # Create the object.
+ $lobj_id = $dbh->func($dbh->{'pg_INV_WRITE'}, 'lo_creat');
+ }
+
+ # Open it to get a file descriptor.
+ my $lobj_fd = $dbh->func($lobj_id, $dbh->{'pg_INV_WRITE'}, 'lo_open');
+
+ $dbh->func($lobj_fd, 0, 0, 'lo_lseek');
+
+ # Write some data to it.
+ my $len = $dbh->func($lobj_fd, $data, length($data), 'lo_write');
+
+ die "Errors writing lo\n" if $len != length($data);
+
+ # Close 'er up.
+ $dbh->func($lobj_fd, 'lo_close') or die "Problems closing lo object\n";
+
+ # end transaction
+ $dbh->{AutoCommit} = 1;
+
+ return $lobj_id;
+}
+
+sub read_blob {
+ my ($dbh, $lobj_id) = @_;
+ my $data = '';
+ my $read_len = 256;
+ my $chunk = '';
+
+ # begin transaction
+ $dbh->{AutoCommit} = 0;
+
+ my $lobj_fd = $dbh->func($lobj_id, $dbh->{'pg_INV_READ'}, 'lo_open');
+
+ $dbh->func($lobj_fd, 0, 0, 'lo_lseek');
+
+ # Pull out all the data.
+ while ($dbh->func($lobj_fd, $chunk, $read_len, 'lo_read')) {
+ $data .= $chunk;
+ }
+
+ $dbh->func($lobj_fd, 'lo_close') or die "Problems closing lo object\n";
+
+ # end transaction
+ $dbh->{AutoCommit} = 1;
+
+ return $data;
+}
--- /dev/null
+diff -r --unified DBD-Pg-1.00/test.pl DBD-Pg-1.00.alex/test.pl
+--- DBD-Pg-1.00/test.pl Sun May 27 10:10:13 2001
++++ DBD-Pg-1.00.alex/test.pl Sun Jun 10 15:38:09 2001
+@@ -40,7 +40,7 @@
+ my $dsn_main = "dbi:Pg:dbname=$dbmain";
+ my $dsn_test = "dbi:Pg:dbname=$dbtest";
+
+-my ($dbh0, $dbh, $sth);
++my ($dbh0, $dbh, $dbh1, $sth);
+
+ #DBI->trace(3); # make your choice
+
+@@ -445,16 +445,56 @@
+ # end transaction
+ $dbh->{AutoCommit} = 1;
+
++# compare large objects
++
+ ( $dbh->func($lobjId, 'lo_unlink') )
+ and print "\$dbh->func(lo_unlink) ...... ok\n"
+ or print "\$dbh->func(lo_unlink) ...... not ok\n";
+
+-# compare large objects
+-
+ ( $pgin cmp $buf and $pgin cmp $blob )
+ and print "compare blobs .............. not ok\n"
+ or print "compare blobs .............. ok\n";
+
++my $fd;
++( $fd=$dbh->func( 'getfd') )
++ and print "\$dbh->func(getfd) .......... ok\n"
++ or print "\$dbh->func(getfd) .......... not ok\n";
++
++( $dbh->do( 'LISTEN test ') )
++ and print "\$dbh->do('LISTEN test') .... ok\n"
++ or print "\$dbh->do('LISTEN test') .... not ok\n";
++
++( $dbh1 = DBI->connect("$dsn_test", '', '', { AutoCommit => 1 }) )
++ and print "DBI->connect (for notify)... ok\n"
++ or die "DBI->connect (for notify)... not ok: ", $DBI::errstr;
++
++# there should be no data for read on $fd , until we send a notify
++
++ my $rout;
++ my $rin = '';
++ vec($rin,$fd,1) = 1;
++ my $nfound = select( $rout=$rin, undef, undef, 0);
++
++( $nfound==0 )
++ and print "select(\$fd) returns no data. ok\n"
++ or die "select(\$fd) returns no data. not ok\n";
++
++( $dbh1->do( 'NOTIFY test ') )
++ and print "\$dbh1->do('NOTIFY test') ... ok\n"
++ or print "\$dbh1->do('NOTIFY test') ... not ok\n";
++
++ my $nfound = select( $rout=$rin, undef, undef, 1);
++
++( $nfound==1 )
++ and print "select(\$fd) returns data.... ok\n"
++ or die "select(\$fd) returns data.... not ok\n";
++
++my $notify_r;
++
++( $notify_r = $dbh->func('notifies') )
++ and print "\$dbh->func('notifies')...... ok\n"
++ or die "\$dbh->func('notifies')...... not ok\n";
++
+ ######################### disconnect and drop test database
+
+ # disconnect
+@@ -462,6 +502,10 @@
+ ( $dbh->disconnect )
+ and print "\$dbh->disconnect ........... ok\n"
+ or die "\$dbh->disconnect ........... not ok: ", $DBI::errstr;
++
++( $dbh1->disconnect )
++ and print "\$dbh1->disconnect .......... ok\n"
++ or die "\$dbh1->disconnect .......... not ok: ", $DBI::errstr;
+
+ $dbh0->do("DROP DATABASE $dbtest");
+ $dbh0->disconnect;
--- /dev/null
+print "1..1\n";
+
+use DBI;
+use DBD::Pg;
+
+if ($DBD::Pg::VERSION) {
+ print "ok 1\n";
+} else {
+ print "not ok 1\n";
+}
--- /dev/null
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 2;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 0}
+ );
+
+ok((defined $dbh and $dbh->disconnect()),
+ 'connect with transaction'
+ );
+
+undef $dbh;
+$dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 1});
+
+ok((defined $dbh and $dbh->disconnect()),
+ 'connect without transaction'
+ );
+
--- /dev/null
+use strict;
+use Test::More tests => 20;
+
+use DBD::Pg qw(:pg_types);
+
+ok(PG_BOOL == 16, 'PG_BOOL');
+ok(PG_BYTEA == 17, 'PG_BYTEA');
+ok(PG_CHAR == 18, 'PG_CHAR');
+ok(PG_INT8 == 20, 'PG_INT8');
+ok(PG_INT2 == 21, 'PG_INT2');
+ok(PG_INT4 == 23, 'PG_INT4');
+ok(PG_TEXT == 25, 'PG_TEXT');
+ok(PG_OID == 26, 'PG_OID');
+ok(PG_FLOAT4 == 700, 'PG_FLOAT4');
+ok(PG_FLOAT8 == 701, 'PG_FLOAT8');
+ok(PG_ABSTIME == 702, 'PG_ABSTIME');
+ok(PG_RELTIME == 703, 'PG_RELTIME');
+ok(PG_TINTERVAL == 704, 'PG_TINTERVAL');
+ok(PG_BPCHAR == 1042, 'PG_BPCHAR');
+ok(PG_VARCHAR == 1043, 'PG_VARCHAR');
+ok(PG_DATE == 1082, 'PG_DATE');
+ok(PG_TIME == 1083, 'PG_TIME');
+ok(PG_DATETIME == 1184, 'PG_DATETIME');
+ok(PG_TIMESPAN == 1186, 'PG_TIMESPAN');
+ok(PG_TIMESTAMP == 1296, 'PG_TIMESTAMP');
--- /dev/null
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 3;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 1});
+ok(defined $dbh,'connect without transaction');
+{
+ local $dbh->{PrintError} = 0;
+ local $dbh->{RaiseError} = 0;
+ $dbh->do(q{DROP TABLE test});
+}
+
+my $sql = <<SQL;
+CREATE TABLE test (
+ id int,
+ name text,
+ val text,
+ score float,
+ date timestamp default 'now()',
+ array text[][]
+)
+SQL
+
+ok($dbh->do($sql),
+ 'create table'
+ );
+
+ok($dbh->disconnect(),
+ 'disconnect'
+ );
+
--- /dev/null
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 8;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 0}
+ );
+ok(defined $dbh,
+ 'connect with transaction'
+ );
+
+my $sql = <<SQL;
+ SELECT *
+ FROM test
+SQL
+
+ok($dbh->prepare($sql),
+ "prepare: $sql"
+ );
+
+$sql = <<SQL;
+ SELECT id
+ FROM test
+SQL
+
+ok($dbh->prepare($sql),
+ "prepare: $sql"
+ );
+
+$sql = <<SQL;
+ SELECT id
+ , name
+ FROM test
+SQL
+
+ok($dbh->prepare($sql),
+ "prepare: $sql"
+ );
+
+$sql = <<SQL;
+ SELECT id
+ , name
+ FROM test
+ WHERE id = 1
+SQL
+
+ok($dbh->prepare($sql),
+ "prepare: $sql"
+ );
+
+$sql = <<SQL;
+ SELECT id
+ , name
+ FROM test
+ WHERE id = ?
+SQL
+
+ok($dbh->prepare($sql),
+ "prepare: $sql"
+ );
+
+$sql = <<SQL;
+ SELECT *
+ FROM test
+ WHERE id = ?
+ AND name = ?
+ AND value = ?
+ AND score = ?
+ and data = ?
+SQL
+
+ok($dbh->prepare($sql),
+ "prepare: $sql"
+ );
+
+ok($dbh->disconnect(),
+ 'disconnect'
+ );
--- /dev/null
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 11;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 0}
+ );
+ok(defined $dbh,
+ 'connect with transaction'
+ );
+
+my $sql = <<SQL;
+ SELECT id
+ , name
+ FROM test
+ WHERE id = ?
+SQL
+my $sth = $dbh->prepare($sql);
+ok(defined $sth,
+ "prepare: $sql"
+ );
+
+ok($sth->bind_param(1, 'foo'),
+ 'bind int column with string'
+ );
+
+ok($sth->bind_param(1, 1),
+ 'rebind int column with int'
+ );
+
+$sql = <<SQL;
+ SELECT id
+ , name
+ FROM test
+ WHERE id = ?
+ AND name = ?
+SQL
+$sth = $dbh->prepare($sql);
+ok(defined $sth,
+ "prepare: $sql"
+ );
+
+ok($sth->bind_param(1, 'foo'),
+ 'bind int column with string',
+ );
+ok($sth->bind_param(2, 'bar'),
+ 'bind string column with text'
+ );
+ok($sth->bind_param(2, 'baz'),
+ 'rebind string column with text'
+ );
+
+ok($sth->finish(),
+ 'finish'
+ );
+
+# Make sure that we get warnings when we try to use SQL_BINARY.
+{
+ local $SIG{__WARN__} =
+ sub { ok($_[0] =~ /^Use of SQL type SQL_BINARY/,
+ 'warning with SQL_BINARY'
+ );
+ };
+
+ $sql = <<SQL;
+ SELECT id
+ , name
+ FROM test
+ WHERE id = ?
+ AND name = ?
+SQL
+ $sth = $dbh->prepare($sql);
+
+ $sth->bind_param(1, 'foo', DBI::SQL_BINARY);
+}
+
+ok($dbh->disconnect(),
+ 'disconnect'
+ );
--- /dev/null
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 13;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 0}
+ );
+ok(defined $dbh,
+ 'connect with transaction'
+ );
+
+my $sql = <<SQL;
+ SELECT id
+ , name
+ FROM test
+ WHERE id = ?
+SQL
+my $sth = $dbh->prepare($sql);
+ok(defined $sth,
+ "prepare: $sql"
+ );
+
+$sth->bind_param(1, 1);
+ok($sth->execute(),
+ 'exectute with one bind param'
+ );
+
+$sth->bind_param(1, 2);
+ok($sth->execute(),
+ 'exectute with rebinding one param'
+ );
+
+$sql = <<SQL;
+ SELECT id
+ , name
+ FROM test
+ WHERE id = ?
+ AND name = ?
+SQL
+$sth = $dbh->prepare($sql);
+ok(defined $sth,
+ "prepare: $sql"
+ );
+
+$sth->bind_param(1, 2);
+$sth->bind_param(2, 'foo');
+ok($sth->execute(),
+ 'exectute with two bind params'
+ );
+
+eval {
+ local $dbh->{PrintError} = 0;
+ $sth = $dbh->prepare($sql);
+ $sth->bind_param(1, 2);
+ $sth->execute();
+};
+ok(!$@,
+ 'execute with only first of two params bound'
+ );
+
+eval {
+ local $dbh->{PrintError} = 0;
+ $sth = $dbh->prepare($sql);
+ $sth->bind_param(2, 'foo');
+ $sth->execute();
+};
+ok(!$@,
+ 'execute with only second of two params bound'
+ );
+
+eval {
+ local $dbh->{PrintError} = 0;
+ $sth = $dbh->prepare($sql);
+ $sth->execute();
+};
+ok(!$@,
+ 'execute with neither of two params bound'
+ );
+
+$sth = $dbh->prepare($sql);
+ok($sth->execute(1, 'foo'),
+ 'execute with both params bound in execute'
+ );
+
+eval {
+ local $dbh->{PrintError} = 0;
+ $sth = $dbh->prepare(q{
+ SELECT id
+ , name
+ FROM test
+ WHERE id = ?
+ AND name = ?
+ });
+ $sth->execute(1);
+};
+ok($@,
+ 'execute with only one of two params bound in execute'
+ );
+
+
+ok($sth->finish(),
+ 'finish'
+ );
+
+ok($dbh->disconnect(),
+ 'disconnect'
+ );
--- /dev/null
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 10;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 0}
+ );
+ok(defined $dbh,
+ 'connect with transaction'
+ );
+
+$dbh->do(q{INSERT INTO test (id, name, val) VALUES (1, 'foo', 'horse')});
+$dbh->do(q{INSERT INTO test (id, name, val) VALUES (2, 'bar', 'chicken')});
+$dbh->do(q{INSERT INTO test (id, name, val) VALUES (3, 'baz', 'pig')});
+ok($dbh->commit(),
+ 'commit'
+ );
+
+my $sql = <<SQL;
+ SELECT id
+ , name
+ FROM test
+SQL
+my $sth = $dbh->prepare($sql);
+$sth->execute();
+
+my $rows = 0;
+while (my ($id, $name) = $sth->fetchrow_array()) {
+ if (defined($id) && defined($name)) {
+ $rows++;
+ }
+}
+$sth->finish();
+ok($rows == 3,
+ 'fetch three rows'
+ );
+
+$sql = <<SQL;
+ SELECT id
+ , name
+ FROM test
+ WHERE 1 = 0
+SQL
+$sth = $dbh->prepare($sql);
+$sth->execute();
+
+$rows = 0;
+while (my ($id, $name) = $sth->fetchrow_array()) {
+ $rows++;
+}
+$sth->finish();
+
+ok($rows == 0,
+ 'fetch zero rows'
+ );
+
+$sql = <<SQL;
+ SELECT id
+ , name
+ FROM test
+ WHERE id = ?
+SQL
+$sth = $dbh->prepare($sql);
+$sth->execute(1);
+
+$rows = 0;
+while (my ($id, $name) = $sth->fetchrow_array()) {
+ if (defined($id) && defined($name)) {
+ $rows++;
+ }
+}
+$sth->finish();
+
+ok($rows == 1,
+ 'fetch one row on id'
+ );
+
+# Attempt to test whether or not we can get unicode out of the database
+# correctly. Reuse the previous sth.
+SKIP: {
+ eval "use Encode";
+ skip "need Encode module for unicode tests", 3 if $@;
+ local $dbh->{pg_enable_utf8} = 1;
+ $dbh->do("INSERT INTO test (id, name, val) VALUES (4, '\001\000dam', 'cow')");
+ $sth->execute(4);
+ my ($id, $name) = $sth->fetchrow_array();
+ ok(Encode::is_utf8($name),
+ 'returned data has utf8 bit set'
+ );
+ is(length($name), 4,
+ 'returned utf8 data is not corrupted'
+ );
+ $sth->finish();
+ $sth->execute(1);
+ my ($id2, $name2) = $sth->fetchrow_array();
+ ok(! Encode::is_utf8($name2),
+ 'returned ASCII data has not got utf8 bit set'
+ );
+ $sth->finish();
+}
+
+$sql = <<SQL;
+ SELECT id
+ , name
+ FROM test
+ WHERE name = ?
+SQL
+$sth = $dbh->prepare($sql);
+$sth->execute('foo');
+
+$rows = 0;
+while (my ($id, $name) = $sth->fetchrow_array()) {
+ if (defined($id) && defined($name)) {
+ $rows++;
+ }
+}
+$sth->finish();
+
+ok($rows == 1,
+ 'fetch one row on name'
+ );
+
+ok($dbh->disconnect(),
+ 'disconnect'
+ );
--- /dev/null
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 3;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 0}
+ );
+ok(defined $dbh,
+ 'connect with transaction'
+ );
+
+ok($dbh->disconnect(),
+ 'disconnect'
+ );
+
+$dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 0}
+ );
+
+$dbh->disconnect();
+$dbh->disconnect();
+$dbh->disconnect();
+ok($dbh->disconnect(),
+ 'disconnect on already disconnected dbh'
+ );
--- /dev/null
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 3;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, PrintError => 0, AutoCommit => 0}
+ );
+ok(defined $dbh,
+ 'connect with transaction'
+ );
+
+my $sth = $dbh->prepare(q{SELECT * FROM test});
+ok($dbh->disconnect(),
+ 'disconnect with un-finished statement'
+ );
+
+eval {
+ $sth->execute();
+};
+ok($@,
+ 'execute on disconnected statement'
+ );
--- /dev/null
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 18;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh1 = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 0}
+ );
+ok(defined $dbh1,
+ 'connect first dbh'
+ );
+
+my $dbh2 = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 0}
+ );
+ok(defined $dbh2,
+ 'connect second dbh'
+ );
+
+$dbh1->do(q{DELETE FROM test});
+ok($dbh1->commit(),
+ 'delete'
+ );
+
+my $rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 0,
+ 'fetch on empty table from dbh1'
+ );
+
+$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 0,
+ 'fetch on empty table from dbh2'
+ );
+
+$dbh1->do(q{INSERT INTO test (id, name, val) VALUES (1, 'foo', 'horse')});
+$dbh1->do(q{INSERT INTO test (id, name, val) VALUES (2, 'bar', 'chicken')});
+$dbh1->do(q{INSERT INTO test (id, name, val) VALUES (3, 'baz', 'pig')});
+
+$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 3,
+ 'fetch three rows on dbh1'
+ );
+
+$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 0,
+ 'fetch on dbh2 before commit'
+ );
+
+ok($dbh1->commit(),
+ 'commit work'
+ );
+
+$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 3,
+ 'fetch on dbh1 after commit'
+ );
+
+$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 3,
+ 'fetch on dbh2 after commit'
+ );
+
+ok($dbh1->do(q{DELETE FROM test}),
+ 'delete'
+ );
+
+$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 0,
+ 'fetch on empty table from dbh1'
+ );
+
+$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 3,
+ 'fetch on from dbh2 without commit'
+ );
+
+ok($dbh1->rollback(),
+ 'rollback'
+ );
+
+$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 3,
+ 'fetch on from dbh1 after rollback'
+ );
+
+$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 3,
+ 'fetch on from dbh2 after rollback'
+ );
+
+ok($dbh1->disconnect(),
+ 'disconnect on dbh1'
+);
+
+ok($dbh2->disconnect(),
+ 'disconnect on dbh2'
+);
--- /dev/null
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 12;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh1 = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 1}
+ );
+ok(defined $dbh1,
+ 'connect first dbh'
+ );
+
+my $dbh2 = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 1}
+ );
+ok(defined $dbh2,
+ 'connect second dbh'
+ );
+
+ok($dbh1->do(q{DELETE FROM test}),
+ 'delete'
+ );
+
+my $rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 0,
+ 'fetch on empty table from dbh1'
+ );
+
+$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 0,
+ 'fetch on empty table from dbh2'
+ );
+
+ok($dbh1->do(q{INSERT INTO test (id, name, val) VALUES (1, 'foo', 'horse')}),
+ 'insert'
+ );
+
+$rows = ($dbh1->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 1,
+ 'fetch one row from dbh1'
+ );
+
+$rows = ($dbh2->selectrow_array(q{SELECT COUNT(*) FROM test}))[0];
+ok($rows == 1,
+ 'fetch one row from dbh1'
+ );
+
+local $SIG{__WARN__} = sub {};
+ok(!$dbh1->commit(),
+ 'commit'
+ );
+
+ok(!$dbh1->rollback(),
+ 'rollback'
+ );
+
+ok($dbh1->disconnect(),
+ 'disconnect on dbh1'
+);
+
+ok($dbh2->disconnect(),
+ 'disconnect on dbh2'
+);
--- /dev/null
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 8;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 0}
+ );
+ok(defined $dbh,
+ 'connect with transaction'
+ );
+
+my %tests = (
+ one=>["'", "'\\" . sprintf("%03o", ord("'")) . "'"],
+ two=>["''", "'" . ("\\" . sprintf("%03o", ord("'")))x2 . "'"],
+ three=>["\\", "'\\" . sprintf("%03o", ord("\\")) . "'"],
+ four=>["\\'", sprintf("'\\%03o\\%03o'", ord("\\"), ord("'"))],
+ five=>["\\'?:", sprintf("'\\%03o\\%03o?:'", ord("\\"), ord("'"))],
+ );
+
+foreach my $test (keys %tests) {
+ my ($unq, $quo, $ref);
+
+ $unq = $tests{$test}->[0];
+ $ref = $tests{$test}->[1];
+ $quo = $dbh->quote($unq);
+
+ ok($quo eq $ref,
+ "$test: $unq -> expected $quo got $ref"
+ );
+}
+
+# Make sure that SQL_BINARY doesn't work.
+# eval { $dbh->quote('foo', { TYPE => DBI::SQL_BINARY })};
+eval {
+ local $dbh->{PrintError} = 0;
+ $dbh->quote('foo', DBI::SQL_BINARY);
+};
+ok($@ && $@ =~ /Use of SQL_BINARY invalid in quote/,
+ 'SQL_BINARY'
+);
+
+ok($dbh->disconnect(),
+ 'disconnect'
+ );
--- /dev/null
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 9;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 0}
+ );
+ok(defined $dbh,
+ 'connect with transaction'
+ );
+
+my $quo = $dbh->quote("\\'?:");
+my $sth = $dbh->prepare(qq{
+ INSERT INTO test (name) VALUES ($quo)
+ });
+$sth->execute();
+
+my $sql = <<SQL;
+ SELECT name
+ FROM test
+ WHERE name = $quo;
+SQL
+$sth = $dbh->prepare($sql);
+$sth->execute();
+
+my ($retr) = $sth->fetchrow_array();
+ok((defined($retr) && $retr eq "\\'?:"),
+ 'fetch'
+ );
+
+eval {
+ local $dbh->{PrintError} = 0;
+ $sth->execute('foo');
+};
+ok($@,
+ 'execute with one bind param where none expected'
+ );
+
+$sql = <<SQL;
+ SELECT name
+ FROM test
+ WHERE name = ?
+SQL
+$sth = $dbh->prepare($sql);
+
+$sth->execute("\\'?:");
+
+($retr) = $sth->fetchrow_array();
+ok((defined($retr) && $retr eq "\\'?:"),
+ 'execute with ? placeholder'
+ );
+
+$sql = <<SQL;
+ SELECT name
+ FROM test
+ WHERE name = :1
+SQL
+$sth = $dbh->prepare($sql);
+
+$sth->execute("\\'?:");
+
+($retr) = $sth->fetchrow_array();
+ok((defined($retr) && $retr eq "\\'?:"),
+ 'execute with :1 placeholder'
+ );
+
+$sql = <<SQL;
+ SELECT name
+ FROM test
+ WHERE name = '?'
+SQL
+$sth = $dbh->prepare($sql);
+
+eval {
+ local $dbh->{PrintError} = 0;
+ $sth->execute('foo');
+};
+ok($@,
+ 'execute with quoted ?'
+ );
+
+$sql = <<SQL;
+ SELECT name
+ FROM test
+ WHERE name = ':1'
+SQL
+$sth = $dbh->prepare($sql);
+
+eval {
+ local $dbh->{PrintError} = 0;
+ $sth->execute('foo');
+};
+ok($@,
+ 'execute with quoted :1'
+ );
+
+$sql = <<SQL;
+ SELECT name
+ FROM test
+ WHERE name = '\\\\'
+ AND name = '?'
+SQL
+$sth = $dbh->prepare($sql);
+
+eval {
+ local $dbh->{PrintError} = 0;
+ local $sth->{PrintError} = 0;
+ $sth->execute('foo');
+};
+ok($@,
+ 'execute with quoted ?'
+ );
+
+$sth->finish();
+$dbh->rollback();
+
+ok($dbh->disconnect(),
+ 'disconnect'
+ );
--- /dev/null
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 3;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 0}
+ );
+ok(defined $dbh,
+ 'connect with transaction'
+ );
+
+eval {
+ local $dbh->{PrintError} = 0;
+ $dbh->do(q{DROP TABLE tt});
+ $dbh->commit();
+};
+$dbh->rollback();
+
+$dbh->do(q{CREATE TABLE tt (blah numeric(5,2), foo text)});
+my $sth = $dbh->prepare(qq{
+ SELECT * FROM tt WHERE FALSE
+ });
+$sth->execute();
+
+my @types = @{$sth->{pg_type}};
+
+ok($types[0] eq 'numeric',
+ 'type numeric'
+ );
+
+ok($types[1] eq 'text',
+ 'type text'
+ );
+
+$sth->finish();
+$dbh->rollback();
+$dbh->disconnect();
--- /dev/null
+#!/usr/bin/perl -w -I./t
+$| = 1;
+
+# vim:ts=2:sw=2:ai:aw:nu:
+use DBI qw(:sql_types);
+use Data::Dumper;
+use strict;
+use Test::More;
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 59;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 0}
+ );
+ok(defined $dbh,
+ 'connect with transaction'
+ );
+
+#
+# Test the different methods, so are expected to fail.
+#
+
+my $sth;
+
+# foreach (@{ $DBI::EXPORT_TAGS{sql_types} }) {
+# no strict 'refs';
+# printf "%s=%d\n", $_, &{"DBI::$_"};
+# }
+
+my $get_info = {
+ SQL_DBMS_NAME => 17
+ , SQL_DBMS_VER => 18
+ , SQL_IDENTIFIER_QUOTE_CHAR => 29
+ , SQL_CATALOG_NAME_SEPARATOR => 41
+ , SQL_CATALOG_LOCATION => 114
+};
+
+# Ping
+ eval {
+ ok( $dbh->ping(), "Testing Ping" );
+ };
+ok ( !$@, "Ping Tested" );
+
+# Get Info
+ eval {
+ $sth = $dbh->get_info();
+ };
+ok ($@, "Call to get_info with 0 arguements, error expected: $@" );
+$sth = undef;
+
+# Table Info
+ eval {
+ $sth = $dbh->table_info();
+ };
+ok ((!$@ and defined $sth), "table_info tested" );
+$sth = undef;
+
+# Column Info
+ eval {
+ $sth = $dbh->column_info();
+ };
+ok ((!$@ and defined $sth), "column_info tested" );
+#ok ($@, "Call to column_info with 0 arguements, error expected: $@" );
+$sth = undef;
+
+
+# Tables
+ eval {
+ $sth = $dbh->tables();
+ };
+ok ((!$@ and defined $sth), "tables tested" );
+$sth = undef;
+
+# Type Info All
+ eval {
+ $sth = $dbh->type_info_all();
+ };
+ok ((!$@ and defined $sth), "type_info_all tested" );
+$sth = undef;
+
+# Type Info
+ eval {
+ my @types = $dbh->type_info();
+ die unless @types;
+ };
+ok (!$@, "type_info(undef)");
+$sth = undef;
+
+# Quote
+ eval {
+ my $val = $dbh->quote();
+ die unless $val;
+ };
+ok ($@, "quote error expected: $@");
+
+$sth = undef;
+# Tests for quote:
+my @qt_vals = (1, 2, undef, 'NULL', "ThisIsAString", "This is Another String");
+my @expt_vals = (q{'1'}, q{'2'}, "NULL", q{'NULL'}, q{'ThisIsAString'}, q{'This is Another String'});
+for (my $x = 0; $x <= $#qt_vals; $x++) {
+ local $^W = 0;
+ my $val = $dbh->quote( $qt_vals[$x] );
+ is( $val, $expt_vals[$x], "$x: quote on $qt_vals[$x] returned $val" );
+}
+
+is( $dbh->quote( 1, SQL_INTEGER() ), 1, "quote(1, SQL_INTEGER)" );
+
+
+# Quote Identifier
+ eval {
+ my $val = $dbh->quote_identifier();
+ die unless $val;
+ };
+
+ok ($@, "quote_identifier error expected: $@");
+$sth = undef;
+
+SKIP: {
+ skip("get_info() not yet implemented", 1);
+ # , SQL_IDENTIFIER_QUOTE_CHAR => 29
+ # , SQL_CATALOG_NAME_SEPARATOR => 41
+ my $qt = $dbh->get_info( $get_info->{SQL_IDENTIFIER_QUOTE_CHAR} );
+ my $sep = $dbh->get_info( $get_info->{SQL_CATALOG_NAME_SEPARATOR} );
+
+ # Uncomment this line and remove the next line when get_info() is implemented.
+# my $cmp_str = qq{${qt}link${qt}${sep}${qt}schema${qt}${sep}${qt}table${qt}};
+ my $cmp_str = '';
+ is( $dbh->quote_identifier( "link", "schema", "table" )
+ , $cmp_str
+ , q{quote_identifier( "link", "schema", "table" )}
+ );
+}
+
+# Test ping
+
+ok ($dbh->ping, "Ping the current connection ..." );
+
+# Test Get Info.
+
+# SQL_KEYWORDS
+# SQL_CATALOG_TERM
+# SQL_DATA_SOURCE_NAME
+# SQL_DBMS_NAME
+# SQL_DBMS_VERSION
+# SQL_DRIVER_NAME
+# SQL_DRIVER_VER
+# SQL_PROCEDURE_TERM
+# SQL_SCHEMA_TERM
+# SQL_TABLE_TERM
+# SQL_USER_NAME
+
+SKIP: {
+ skip("get_info() not yet implemented", 5);
+ foreach my $info (sort keys %$get_info) {
+ my $type = $dbh->get_info($get_info->{$info});
+ ok( defined $type, "get_info($info) ($get_info->{$info}) " .
+ ($type || '') );
+ }
+}
+
+# Test Table Info
+$sth = $dbh->table_info( undef, undef, undef );
+ok( defined $sth, "table_info(undef, undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->table_info( undef, undef, undef, "VIEW" );
+ok( defined $sth, "table_info(undef, undef, undef, \"VIEW\") tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+# Test Table Info Rule 19a
+$sth = $dbh->table_info( '%', '', '');
+ok( defined $sth, "table_info('%', '', '',) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+# Test Table Info Rule 19b
+$sth = $dbh->table_info( '', '%', '');
+ok( defined $sth, "table_info('', '%', '',) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+# Test Table Info Rule 19c
+$sth = $dbh->table_info( '', '', '', '%');
+ok( defined $sth, "table_info('', '', '', '%',) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+# Test to see if this database contains any of the defined table types.
+$sth = $dbh->table_info( '', '', '', '%');
+ok( defined $sth, "table_info('', '', '', '%',) tested" );
+if ($sth) {
+ my $ref = $sth->fetchall_hashref( 'TABLE_TYPE' );
+ foreach my $type ( sort keys %$ref ) {
+ my $tsth = $dbh->table_info( undef, undef, undef, $type );
+ ok( defined $tsth, "table_info(undef, undef, undef, $type) tested" );
+ DBI::dump_results($tsth) if defined $tsth;
+ $tsth->finish;
+ }
+ $sth->finish;
+}
+$sth = undef;
+
+# Test Column Info
+$sth = $dbh->column_info( undef, undef, undef, undef );
+ok( defined $sth, "column_info(undef, undef, undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser'", undef, undef );
+ok( defined $sth, "column_info(undef, 'auser', undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'ause%'", undef, undef );
+ok( defined $sth, "column_info(undef, 'ause%', undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser','replicator'", undef, undef );
+ok( defined $sth, "column_info(undef, 'auser','replicator', undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser','repl%'", undef, undef );
+ok( defined $sth, "column_info(undef, 'auser','repl%', undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'fred','repl%'", undef, undef );
+ok( defined $sth, "column_info(undef, 'fred','repl%', undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'fred','jim'", undef, undef );
+ok( defined $sth, "column_info(undef, 'fred','jim', undef, undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser'", "'pga_schema'", undef );
+ok( defined $sth, "column_info(undef, 'auser', 'pga_schema', undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser'", "'pga_%'", undef );
+ok( defined $sth, "column_info(undef, 'auser', 'pga_%', undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'ause%'", "'pga_%'", undef );
+ok( defined $sth, "column_info(undef, 'ause%', 'pga_%', undef) tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser'", "'pga_schema'", "'schemaname'" );
+ok( defined $sth, "column_info(undef, 'auser', 'pga_schema', 'schemaname') tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser'", "'pga_schema'", "'schema%'" );
+ok( defined $sth, "column_info(undef, 'auser', 'pga_schema', 'schema%') tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'auser'", "'pga_%'", "'schema%'" );
+ok( defined $sth, "column_info(undef, 'auser', 'pga_%', 'schema%') tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+$sth = $dbh->column_info( undef, "'ause%'", "'pga_%'", "'schema%'" );
+ok( defined $sth, "column_info(undef, 'ause%', 'pga_%', 'schema%') tested" );
+DBI::dump_results($sth) if defined $sth;
+$sth = undef;
+
+# Test call to primary_key_info
+local ($dbh->{Warn}, $dbh->{PrintError});
+$dbh->{PrintError} = $dbh->{Warn} = 0;
+
+# Primary Key Info
+eval {
+ $sth = $dbh->primary_key_info();
+ die unless $sth;
+};
+ok ($@, "Call to primary_key_info with 0 arguements, error expected: $@" );
+$sth = undef;
+
+# Primary Key
+eval {
+ $sth = $dbh->primary_key();
+ die unless $sth;
+};
+ok ($@, "Call to primary_key with 0 arguements, error expected: $@" );
+$sth = undef;
+
+$sth = $dbh->primary_key_info(undef, undef, undef );
+
+ok( defined $sth, "Statement handle defined for primary_key_info()" );
+
+if ( defined $sth ) {
+ while( my $row = $sth->fetchrow_arrayref ) {
+ local $^W = 0;
+ # print join( ", ", @$row, "\n" );
+ }
+
+ undef $sth;
+
+}
+
+$sth = $dbh->primary_key_info(undef, undef, undef );
+ok( defined $sth, "Statement handle defined for primary_key_info()" );
+
+my ( %catalogs, %schemas, %tables);
+
+my $cnt = 0;
+while( my ($catalog, $schema, $table) = $sth->fetchrow_array ) {
+ local $^W = 0;
+ $catalogs{$catalog}++ if $catalog;
+ $schemas{$schema}++ if $schema;
+ $tables{$table}++ if $table;
+ $cnt++;
+}
+ok( $cnt > 0, "At least one table has a primary key." );
+
+$sth = $dbh->primary_key_info(undef, qq{'$ENV{DBI_USER}'}, undef );
+ok(
+ defined $sth
+ , "Getting primary keys for tables owned by $ENV{DBI_USER}");
+DBI::dump_results($sth) if defined $sth;
+
+undef $sth;
+
+SKIP: {
+ # foreign_key_info
+ local ($dbh->{Warn}, $dbh->{PrintError});
+ $dbh->{PrintError} = $dbh->{Warn} = 0;
+ eval {
+ $sth = $dbh->foreign_key_info();
+ die unless $sth;
+ };
+ skip "foreign_key_info not supported by driver", 1 if $@;
+ ok( defined $sth, "Statement handle defined for foreign_key_info()" );
+ DBI::dump_results($sth) if defined $sth;
+ $sth = undef;
+}
+
+ok( $dbh->disconnect, "Disconnect from database" );
+
+exit(0);
+
--- /dev/null
+use strict;
+use DBI;
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 3;
+} else {
+ plan skip_all => 'cannot test without DB info';
+}
+
+my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
+ {RaiseError => 1, AutoCommit => 0}
+ );
+ok(defined $dbh,
+ 'connect with transaction'
+ );
+
+ok($dbh->do(q{DROP TABLE test}),
+ 'drop'
+ );
+
+ok($dbh->disconnect(),
+ 'disconnect'
+ );
--- /dev/null
+package App::Info;
+
+# $Id: Info.pm,v 1.1.2.1 2004-04-29 09:40:08 ivan Exp $
+
+=head1 NAME
+
+App::Info - Information about software packages on a system
+
+=head1 SYNOPSIS
+
+ use App::Info::Category::FooApp;
+
+ my $app = App::Info::Category::FooApp->new;
+
+ if ($app->installed) {
+ print "App name: ", $app->name, "\n";
+ print "Version: ", $app->version, "\n";
+ print "Bin dir: ", $app->bin_dir, "\n";
+ } else {
+ print "App not installed on your system. :-(\n";
+ }
+
+=head1 DESCRIPTION
+
+App::Info is an abstract base class designed to provide a generalized
+interface for subclasses that provide metadata about software packages
+installed on a system. The idea is that these classes can be used in Perl
+application installers in order to determine whether software dependencies
+have been fulfilled, and to get necessary metadata about those software
+packages.
+
+App::Info provides an event model for handling events triggered by App::Info
+subclasses. The events are classified as "info", "error", "unknown", and
+"confirm" events, and multiple handlers may be specified to handle any or all
+of these event types. This allows App::Info clients to flexibly handle events
+in any way they deem necessary. Implementing new event handlers is
+straight-forward, and use the triggering of events by App::Info subclasses is
+likewise kept easy-to-use.
+
+A few L<sample subclasses|"SEE ALSO"> are provided with the distribution, but
+others are invited to write their own subclasses and contribute them to the
+CPAN. Contributors are welcome to extend their subclasses to provide more
+information relevant to the application for which data is to be provided (see
+L<App::Info::HTTPD::Apache|App::Info::HTTPD::Apache> for an example), but are
+encouraged to, at a minimum, implement the abstract methods defined here and
+in the category abstract base classes (e.g.,
+L<App::Info::HTTPD|App::Info::HTTPD> and L<App::Info::Lib|App::Info::Lib>).
+See L<Subclassing|"SUBCLASSING"> for more information on implementing new
+subclasses.
+
+=cut
+
+use strict;
+use Carp ();
+use App::Info::Handler;
+use App::Info::Request;
+use vars qw($VERSION);
+
+$VERSION = '0.23';
+
+##############################################################################
+##############################################################################
+# This code ref is used by the abstract methods to throw an exception when
+# they're called directly.
+my $croak = sub {
+ my ($caller, $meth) = @_;
+ $caller = ref $caller || $caller;
+ if ($caller eq __PACKAGE__) {
+ $meth = __PACKAGE__ . '::' . $meth;
+ Carp::croak(__PACKAGE__ . " is an abstract base class. Attempt to " .
+ " call non-existent method $meth");
+ } else {
+ Carp::croak("Class $caller inherited from the abstract base class " .
+ __PACKAGE__ . ", but failed to redefine the $meth() " .
+ "method. Attempt to call non-existent method " .
+ "${caller}::$meth");
+ }
+};
+
+##############################################################################
+# This code reference is used by new() and the on_* error handler methods to
+# set the error handlers.
+my $set_handlers = sub {
+ my $on_key = shift;
+ # Default is to do nothing.
+ return [] unless $on_key;
+ my $ref = ref $on_key;
+ if ($ref) {
+ $on_key = [$on_key] unless $ref eq 'ARRAY';
+ # Make sure they're all handlers.
+ foreach my $h (@$on_key) {
+ if (my $r = ref $h) {
+ Carp::croak("$r object is not an App::Info::Handler")
+ unless UNIVERSAL::isa($h, 'App::Info::Handler');
+ } else {
+ # Look up the handler.
+ $h = App::Info::Handler->new( key => $h);
+ }
+ }
+ # Return 'em!
+ return $on_key;
+ } else {
+ # Look up the handler.
+ return [ App::Info::Handler->new( key => $on_key) ];
+ }
+};
+
+##############################################################################
+##############################################################################
+
+=head1 INTERFACE
+
+This section documents the public interface of App::Info.
+
+=head2 Constructor
+
+=head3 new
+
+ my $app = App::Info::Category::FooApp->new(@params);
+
+Constructs an App::Info object and returns it. The @params arguments define
+how the App::Info object will respond to certain events, and correspond to
+their like-named methods. See the L<"Event Handler Object Methods"> section
+for more information on App::Info events and how to handle them. The
+parameters to C<new()> for the different types of App::Info events are:
+
+=over 4
+
+=item on_info
+
+=item on_error
+
+=item on_unknown
+
+=item on_confirm
+
+=back
+
+When passing event handlers to C<new()>, the list of handlers for each type
+should be an anonymous array, for example:
+
+ my $app = App::Info::Category::FooApp->new( on_info => \@handlers );
+
+=cut
+
+sub new {
+ my ($pkg, %p) = @_;
+ my $class = ref $pkg || $pkg;
+ # Fail if the method isn't overridden.
+ $croak->($pkg, 'new') if $class eq __PACKAGE__;
+
+ # Set up handlers.
+ for (qw(on_error on_unknown on_info on_confirm)) {
+ $p{$_} = $set_handlers->($p{$_});
+ }
+
+ # Do it!
+ return bless \%p, $class;
+}
+
+##############################################################################
+##############################################################################
+
+=head2 Metadata Object Methods
+
+These are abstract methods in App::Info and must be provided by its
+subclasses. They provide the essential metadata of the software package
+supported by the App::Info subclass.
+
+=head3 key_name
+
+ my $key_name = $app->key_name;
+
+Returns a string that uniquely identifies the software for which the App::Info
+subclass provides data. This value should be unique across all App::Info
+classes. Typically, it's simply the name of the software.
+
+=cut
+
+sub key_name { $croak->(shift, 'key_name') }
+
+=head3 installed
+
+ if ($app->installed) {
+ print "App is installed.\n"
+ } else {
+ print "App is not installed.\n"
+ }
+
+Returns a true value if the application is installed, and a false value if it
+is not.
+
+=cut
+
+sub installed { $croak->(shift, 'installed') }
+
+##############################################################################
+
+=head3 name
+
+ my $name = $app->name;
+
+Returns the name of the application.
+
+=cut
+
+sub name { $croak->(shift, 'name') }
+
+##############################################################################
+
+=head3 version
+
+ my $version = $app->version;
+
+Returns the full version number of the application.
+
+=cut
+
+##############################################################################
+
+sub version { $croak->(shift, 'version') }
+
+=head3 major_version
+
+ my $major_version = $app->major_version;
+
+Returns the major version number of the application. For example, if
+C<version()> returns "7.1.2", then this method returns "7".
+
+=cut
+
+sub major_version { $croak->(shift, 'major_version') }
+
+##############################################################################
+
+=head3 minor_version
+
+ my $minor_version = $app->minor_version;
+
+Returns the minor version number of the application. For example, if
+C<version()> returns "7.1.2", then this method returns "1".
+
+=cut
+
+sub minor_version { $croak->(shift, 'minor_version') }
+
+##############################################################################
+
+=head3 patch_version
+
+ my $patch_version = $app->patch_version;
+
+Returns the patch version number of the application. For example, if
+C<version()> returns "7.1.2", then this method returns "2".
+
+=cut
+
+sub patch_version { $croak->(shift, 'patch_version') }
+
+##############################################################################
+
+=head3 bin_dir
+
+ my $bin_dir = $app->bin_dir;
+
+Returns the full path the application's bin directory, if it exists.
+
+=cut
+
+sub bin_dir { $croak->(shift, 'bin_dir') }
+
+##############################################################################
+
+=head3 inc_dir
+
+ my $inc_dir = $app->inc_dir;
+
+Returns the full path the application's include directory, if it exists.
+
+=cut
+
+sub inc_dir { $croak->(shift, 'inc_dir') }
+
+##############################################################################
+
+=head3 lib_dir
+
+ my $lib_dir = $app->lib_dir;
+
+Returns the full path the application's lib directory, if it exists.
+
+=cut
+
+sub lib_dir { $croak->(shift, 'lib_dir') }
+
+##############################################################################
+
+=head3 so_lib_dir
+
+ my $so_lib_dir = $app->so_lib_dir;
+
+Returns the full path the application's shared library directory, if it
+exists.
+
+=cut
+
+sub so_lib_dir { $croak->(shift, 'so_lib_dir') }
+
+##############################################################################
+
+=head3 home_url
+
+ my $home_url = $app->home_url;
+
+The URL for the software's home page.
+
+=cut
+
+sub home_url { $croak->(shift, 'home_url') }
+
+##############################################################################
+
+=head3 download_url
+
+ my $download_url = $app->download_url;
+
+The URL for the software's download page.
+
+=cut
+
+sub download_url { $croak->(shift, 'download_url') }
+
+##############################################################################
+##############################################################################
+
+=head2 Event Handler Object Methods
+
+These methods provide control over App::Info event handling. Events can be
+handled by one or more objects of subclasses of App::Info::Handler. The first
+to return a true value will be the last to execute. This approach allows
+handlers to be stacked, and makes it relatively easy to create new handlers.
+L<App::Info::Handler|App::Info::Handler> for information on writing event
+handlers.
+
+Each of the event handler methods takes a list of event handlers as its
+arguments. If none are passed, the existing list of handlers for the relevant
+event type will be returned. If new handlers are passed in, they will be
+returned.
+
+The event handlers may be specified as one or more objects of the
+App::Info::Handler class or subclasses, as one or more strings that tell
+App::Info construct such handlers itself, or a combination of the two. The
+strings can only be used if the relevant App::Info::Handler subclasses have
+registered strings with App::Info. For example, the App::Info::Handler::Print
+class included in the App::Info distribution registers the strings "stderr"
+and "stdout" when it starts up. These strings may then be used to tell
+App::Info to construct App::Info::Handler::Print objects that print to STDERR
+or to STDOUT, respectively. See the App::Info::Handler subclasses for what
+strings they register with App::Info.
+
+=head3 on_info
+
+ my @handlers = $app->on_info;
+ $app->on_info(@handlers);
+
+Info events are triggered when the App::Info subclass wants to send an
+informational status message. By default, these events are ignored, but a
+common need is for such messages to simply print to STDOUT. Use the
+L<App::Info::Handler::Print|App::Info::Handler::Print> class included with the
+App::Info distribution to have info messages print to STDOUT:
+
+ use App::Info::Handler::Print;
+ $app->on_info('stdout');
+ # Or:
+ my $stdout_handler = App::Info::Handler::Print->new('stdout');
+ $app->on_info($stdout_handler);
+
+=cut
+
+sub on_info {
+ my $self = shift;
+ $self->{on_info} = $set_handlers->(\@_) if @_;
+ return @{ $self->{on_info} };
+}
+
+=head3 on_error
+
+ my @handlers = $app->on_error;
+ $app->on_error(@handlers);
+
+Error events are triggered when the App::Info subclass runs into an unexpected
+but not fatal problem. (Note that fatal problems will likely throw an
+exception.) By default, these events are ignored. A common way of handling
+these events is to print them to STDERR, once again using the
+L<App::Info::Handler::Print|App::Info::Handler::Print> class included with the
+App::Info distribution:
+
+ use App::Info::Handler::Print;
+ my $app->on_error('stderr');
+ # Or:
+ my $stderr_handler = App::Info::Handler::Print->new('stderr');
+ $app->on_error($stderr_handler);
+
+Another approach might be to turn such events into fatal exceptions. Use the
+included L<App::Info::Handler::Carp|App::Info::Handler::Carp> class for this
+purpose:
+
+ use App::Info::Handler::Carp;
+ my $app->on_error('croak');
+ # Or:
+ my $croaker = App::Info::Handler::Carp->new('croak');
+ $app->on_error($croaker);
+
+=cut
+
+sub on_error {
+ my $self = shift;
+ $self->{on_error} = $set_handlers->(\@_) if @_;
+ return @{ $self->{on_error} };
+}
+
+=head3 on_unknown
+
+ my @handlers = $app->on_unknown;
+ $app->on_uknown(@handlers);
+
+Unknown events are trigged when the App::Info subclass cannot find the value
+to be returned by a method call. By default, these events are ignored. A
+common way of handling them is to have the application prompt the user for the
+relevant data. The App::Info::Handler::Prompt class included with the
+App::Info distribution can do just that:
+
+ use App::Info::Handler::Prompt;
+ my $app->on_unknown('prompt');
+ # Or:
+ my $prompter = App::Info::Handler::Prompt;
+ $app->on_unknown($prompter);
+
+See L<App::Info::Handler::Prompt|App::Info::Handler::Prompt> for information
+on how it works.
+
+=cut
+
+sub on_unknown {
+ my $self = shift;
+ $self->{on_unknown} = $set_handlers->(\@_) if @_;
+ return @{ $self->{on_unknown} };
+}
+
+=head3 on_confirm
+
+ my @handlers = $app->on_confirm;
+ $app->on_confirm(@handlers);
+
+Confirm events are triggered when the App::Info subclass has found an
+important piece of information (such as the location of the executable it'll
+use to collect information for the rest of its methods) and wants to confirm
+that the information is correct. These events will most often be triggered
+during the App::Info subclass object construction. Here, too, the
+App::Info::Handler::Prompt class included with the App::Info distribution can
+help out:
+
+ use App::Info::Handler::Prompt;
+ my $app->on_confirm('prompt');
+ # Or:
+ my $prompter = App::Info::Handler::Prompt;
+ $app->on_confirm($prompter);
+
+=cut
+
+sub on_confirm {
+ my $self = shift;
+ $self->{on_confirm} = $set_handlers->(\@_) if @_;
+ return @{ $self->{on_confirm} };
+}
+
+##############################################################################
+##############################################################################
+
+=head1 SUBCLASSING
+
+As an abstract base class, App::Info is not intended to be used directly.
+Instead, you'll use concrete subclasses that implement the interface it
+defines. These subclasses each provide the metadata necessary for a given
+software package, via the interface outlined above (plus any additional
+methods the class author deems sensible for a given application).
+
+This section describes the facilities App::Info provides for subclassing. The
+goal of the App::Info design has been to make subclassing straight-forward, so
+that developers can focus on gathering the data they need for their
+application and minimize the work necessary to handle unknown values or to
+confirm values. As a result, there are essentially three concepts that
+developers need to understand when subclassing App::Info: organization,
+utility methods, and events.
+
+=head2 Organization
+
+The organizational idea behind App::Info is to name subclasses by broad
+software categories. This approach allows the categories themselves to
+function as abstract base classes that extend App::Info, so that they can
+specify more methods for all of their base classes to implement. For example,
+App::Info::HTTPD has specified the C<httpd_root()> abstract method that its
+subclasses must implement. So as you get ready to implement your own subclass,
+think about what category of software you're gathering information about.
+New categories can be added as necessary.
+
+=head2 Utility Methods
+
+Once you've decided on the proper category, you can start implementing your
+App::Info concrete subclass. As you do so, take advantage of App::Info::Util,
+wherein I've tried to encapsulate common functionality to make subclassing
+easier. I found that most of what I was doing repetitively was looking for
+files and directories, and searching through files. Thus, App::Info::Util
+subclasses L<File::Spec|File::Spec> in order to offer easy access to
+commonly-used methods from that class, e.g., C<path()>. Plus, it has several
+of its own methods to assist you in finding files and directories in lists of
+files and directories, as well as methods for searching through files and
+returning the values found in those files. See
+L<App::Info::Util|App::Info::Util> for more information, and the App::Info
+subclasses in this distribution for usage examples.
+
+I recommend the use of a package-scoped lexical App::Info::Util object. That
+way it's nice and handy when you need to carry out common tasks. If you find
+you're doing something over and over that's not already addressed by an
+App::Info::Util method, consider submitting a patch to App::Info::Util to add
+the functionality you need.
+
+=head2 Events
+
+Use the methods described below to trigger events. Events are designed to
+provide a simple way for App::Info subclass developers to send status messages
+and errors, to confirm data values, and to request a value when the class
+caonnot determine a value itself. Events may optionally be handled by module
+users who assign App::Info::Handler subclass objects to your App::Info
+subclass object using the event handling methods described in the L<"Event
+Handler Object Methods"> section.
+
+=cut
+
+##############################################################################
+# This code reference is used by the event methods to manage the stack of
+# event handlers that may be available to handle each of the events.
+my $handler = sub {
+ my ($self, $meth, $params) = @_;
+
+ # Sanity check. We really want to keep control over this.
+ Carp::croak("Cannot call protected method $meth()")
+ unless UNIVERSAL::isa($self, scalar caller(1));
+
+ # Create the request object.
+ $params->{type} ||= $meth;
+ my $req = App::Info::Request->new(%$params);
+
+ # Do the deed. The ultimate handling handler may die.
+ foreach my $eh (@{$self->{"on_$meth"}}) {
+ last if $eh->handler($req);
+ }
+
+ # Return the requst.
+ return $req;
+};
+
+##############################################################################
+
+=head3 info
+
+ $self->info(@message);
+
+Use this method to display status messages for the user. You may wish to use
+it to inform users that you're searching for a particular file, or attempting
+to parse a file or some other resource for the data you need. For example, a
+common use might be in the object constructor: generally, when an App::Info
+object is created, some important initial piece of information is being
+sought, such as an executable file. That file may be in one of many locations,
+so it makes sense to let the user know that you're looking for it:
+
+ $self->info("Searching for executable");
+
+Note that, due to the nature of App::Info event handlers, your informational
+message may be used or displayed any number of ways, or indeed not at all (as
+is the default behavior).
+
+The C<@message> will be joined into a single string and stored in the
+C<message> attribute of the App::Info::Request object passed to info event
+handlers.
+
+=cut
+
+sub info {
+ my $self = shift;
+ # Execute the handler sequence.
+ my $req = $handler->($self, 'info', { message => join '', @_ });
+}
+
+##############################################################################
+
+=head3 error
+
+ $self->error(@error);
+
+Use this method to inform the user that something unexpected has happened. An
+example might be when you invoke another program to parse its output, but it's
+output isn't what you expected:
+
+ $self->error("Unable to parse version from `/bin/myapp -c`");
+
+As with all events, keep in mind that error events may be handled in any
+number of ways, or not at all.
+
+The C<@erorr> will be joined into a single string and stored in the C<message>
+attribute of the App::Info::Request object passed to error event handlers. If
+that seems confusing, think of it as an "error message" rather than an "error
+error." :-)
+
+=cut
+
+sub error {
+ my $self = shift;
+ # Execute the handler sequence.
+ my $req = $handler->($self, 'error', { message => join '', @_ });
+}
+
+##############################################################################
+
+=head3 unknown
+
+ my $val = $self->unknown(@params);
+
+Use this method when a value is unknown. This will give the user the option --
+assuming the appropriate handler handles the event -- to provide the needed
+data. The value entered will be returned by C<unknown()>. The parameters are
+as follows:
+
+=over 4
+
+=item key
+
+The C<key> parameter uniquely identifies the data point in your class, and is
+used by App::Info to ensure that an unknown event is handled only once, no
+matter how many times the method is called. The same value will be returned by
+subsequent calls to C<unknown()> as was returned by the first call, and no
+handlers will be activated. Typical values are "version" and "lib_dir".
+
+=item prompt
+
+The C<prompt> parameter is the prompt to be displayed should an event handler
+decide to prompt for the appropriate value. Such a prompt might be something
+like "Path to your httpd executable?". If this parameter is not provided,
+App::Info will construct one for you using your class' C<key_name()> method
+and the C<key> parameter. The result would be something like "Enter a valid
+FooApp version". The C<prompt> parameter value will be stored in the
+C<message> attribute of the App::Info::Request object passed to event
+handlers.
+
+=item callback
+
+Assuming a handler has collected a value for your unknown data point, it might
+make sense to validate the value. For example, if you prompt the user for a
+directory location, and the user enters one, it makes sense to ensure that the
+directory actually exists. The C<callback> parameter allows you to do this. It
+is a code reference that takes the new value or values as its arguments, and
+returns true if the value is valid, and false if it is not. For the sake of
+convenience, the first argument to the callback code reference is also stored
+in C<$_> .This makes it easy to validate using functions or operators that,
+er, operate on C<$_> by default, but still allows you to get more information
+from C<@_> if necessary. For the directory example, a good callback might be
+C<sub { -d }>. The C<callback> parameter code reference will be stored in the
+C<callback> attribute of the App::Info::Request object passed to event
+handlers.
+
+=item error
+
+The error parameter is the error message to display in the event that the
+C<callback> code reference returns false. This message may then be used by the
+event handler to let the user know what went wrong with the data she entered.
+For example, if the unknown value was a directory, and the user entered a
+value that the C<callback> identified as invalid, a message to display might
+be something like "Invalid directory path". Note that if the C<error>
+parameter is not provided, App::Info will supply the generic error message
+"Invalid value". This value will be stored in the C<error> attribute of the
+App::Info::Request object passed to event handlers.
+
+=back
+
+This may be the event method you use most, as it should be called in every
+metadata method if you cannot provide the data needed by that method. It will
+typically be the last part of the method. Here's an example demonstrating each
+of the above arguments:
+
+ my $dir = $self->unknown( key => 'lib_dir',
+ prompt => "Enter lib directory path",
+ callback => sub { -d },
+ error => "Not a directory");
+
+=cut
+
+sub unknown {
+ my ($self, %params) = @_;
+ my $key = delete $params{key}
+ or Carp::croak("No key parameter passed to unknown()");
+ # Just return the value if we've already handled this value. Ideally this
+ # shouldn't happen.
+ return $self->{__unknown__}{$key} if exists $self->{__unknown__}{$key};
+
+ # Create a prompt and error message, if necessary.
+ $params{message} = delete $params{prompt} ||
+ "Enter a valid " . $self->key_name . " $key";
+ $params{error} ||= 'Invalid value';
+
+ # Execute the handler sequence.
+ my $req = $handler->($self, "unknown", \%params);
+
+ # Mark that we've provided this value and then return it.
+ $self->{__unknown__}{$key} = $req->value;
+ return $self->{__unknown__}{$key};
+}
+
+##############################################################################
+
+=head3 confirm
+
+ my $val = $self->confirm(@params);
+
+This method is very similar to C<unknown()>, but serves a different purpose.
+Use this method for significant data points where you've found an appropriate
+value, but want to ensure it's really the correct value. A "significant data
+point" is usually a value essential for your class to collect metadata values.
+For example, you might need to locate an executable that you can then call to
+collect other data. In general, this will only happen once for an object --
+during object construction -- but there may be cases in which it is needed
+more than that. But hopefully, once you've confirmed in the constructor that
+you've found what you need, you can use that information to collect the data
+needed by all of the metadata methods and can assume that they'll be right
+because that first, significant data point has been confirmed.
+
+Other than where and how often to call C<confirm()>, its use is quite similar
+to that of C<unknown()>. Its parameters are as follows:
+
+=over
+
+=item key
+
+Same as for C<unknown()>, a string that uniquely identifies the data point in
+your class, and ensures that the event is handled only once for a given key.
+The same value will be returned by subsequent calls to C<confirm()> as was
+returned by the first call for a given key.
+
+=item prompt
+
+Same as for C<unknown()>. Although C<confirm()> is called to confirm a value,
+typically the prompt should request the relevant value, just as for
+C<unknown()>. The difference is that the handler I<should> use the C<value>
+parameter as the default should the user not provide a value. The C<prompt>
+parameter will be stored in the C<message> attribute of the App::Info::Request
+object passed to event handlers.
+
+=item value
+
+The value to be confirmed. This is the value you've found, and it will be
+provided to the user as the default option when they're prompted for a new
+value. This value will be stored in the C<value> attribute of the
+App::Info::Request object passed to event handlers.
+
+=item callback
+
+Same as for C<unknown()>. Because the user can enter data to replace the
+default value provided via the C<value> parameter, you might want to validate
+it. Use this code reference to do so. The callback will be stored in the
+C<callback> attribute of the App::Info::Request object passed to event
+handlers.
+
+=item error
+
+Same as for C<unknown()>: an error message to display in the event that a
+value entered by the user isn't validated by the C<callback> code reference.
+This value will be stored in the C<error> attribute of the App::Info::Request
+object passed to event handlers.
+
+=back
+
+Here's an example usage demonstrating all of the above arguments:
+
+ my $exe = $self->confirm( key => 'shell',
+ prompt => 'Path to your shell?',
+ value => '/bin/sh',
+ callback => sub { -x },
+ error => 'Not an executable');
+
+
+=cut
+
+sub confirm {
+ my ($self, %params) = @_;
+ my $key = delete $params{key}
+ or Carp::croak("No key parameter passed to confirm()");
+ return $self->{__confirm__}{$key} if exists $self->{__confirm__}{$key};
+
+ # Create a prompt and error message, if necessary.
+ $params{message} = delete $params{prompt} ||
+ "Enter a valid " . $self->key_name . " $key";
+ $params{error} ||= 'Invalid value';
+
+ # Execute the handler sequence.
+ my $req = $handler->($self, "confirm", \%params);
+
+ # Mark that we've confirmed this value.
+ $self->{__confirm__}{$key} = $req->value;
+
+ return $self->{__confirm__}{$key}
+}
+
+1;
+__END__
+
+=head2 Event Examples
+
+Below I provide some examples demonstrating the use of the event methods.
+These are meant to emphasize the contexts in which it's appropriate to use
+them.
+
+Let's start with the simplest, first. Let's say that to find the version
+number for an application, you need to search a file for the relevant data.
+Your App::Info concrete subclass might have a private method that handles this
+work, and this method is the appropriate place to use the C<info()> and, if
+necessary, C<error()> methods.
+
+ sub _find_version {
+ my $self = shift;
+
+ # Try to find the revelant file. We cover this method below.
+ # Just return if we cant' find it.
+ my $file = $self->_find_file('version.conf') or return;
+
+ # Send a status message.
+ $self->info("Searching '$file' file for version");
+
+ # Search the file. $util is an App::Info::Util object.
+ my $ver = $util->search_file($file, qr/^Version\s+(.*)$/);
+
+ # Trigger an error message, if necessary. We really think we'll have the
+ # value, but we have to cover our butts in the unlikely event that we're
+ # wrong.
+ $self->error("Unable to find version in file '$file'") unless $ver;
+
+ # Return the version number.
+ return $ver;
+ }
+
+Here we've used the C<info()> method to display a status message to let the
+user know what we're doing. Then we used the C<error()> method when something
+unexpected happened, which in this case was that we weren't able to find the
+version number in the file.
+
+Note the C<_find_file()> method we've thrown in. This might be a method that
+we call whenever we need to find a file that might be in one of a list of
+directories. This method, too, will be an appropriate place for an C<info()>
+method call. But rather than call the C<error()> method when the file can't be
+found, you might want to give an event handler a chance to supply that value
+for you. Use the C<unknown()> method for a case such as this:
+
+ sub _find_file {
+ my ($self, $file) = @_;
+
+ # Send a status message.
+ $self->info("Searching for '$file' file");
+
+ # Look for the file. See App::Info:Utility for its interface.
+ my @paths = qw(/usr/conf /etc/conf /foo/conf);
+ my $found = $util->first_cat_path($file, @paths);
+
+ # If we didn't find it, trigger an unknown event to
+ # give a handler a chance to get the value.
+ $found ||= $self->unknown( key => "file_$file",
+ prompt => "Location of '$file' file?",
+ callback => sub { -f },
+ error => "Not a file");
+
+ # Now return the file name, regardless of whether we found it or not.
+ return $found;
+ }
+
+Note how in this method, we've tried to locate the file ourselves, but if we
+can't find it, we trigger an unknown event. This allows clients of our
+App::Info subclass to try to establish the value themselves by having an
+App::Info::Handler subclass handle the event. If a value is found by an
+App::Info::Handler subclass, it will be returned by C<unknown()> and we can
+continue. But we can't assume that the unknown event will even be handled, and
+thus must expect that an unknown value may remain unknown. This is why the
+C<_find_version()> method above simply returns if C<_find_file()> doesn't
+return a file name; there's no point in searching through a file that doesn't
+exist.
+
+Attentive readers may be left to wonder how to decide when to use C<error()>
+and when to use C<unknown()>. To a large extent, this decision must be based
+on one's own understanding of what's most appropriate. Nevertheless, I offer
+the following simple guidelines: Use C<error()> when you expect something to
+work and then it just doesn't (as when a file exists and should contain the
+information you seek, but then doesn't). Use C<unknown()> when you're less
+sure of your processes for finding the value, and also for any of the values
+that should be returned by any of the L<metadata object methods|"Metadata
+Object Methods">. And of course, C<error()> would be more appropriate when you
+encounter an unexpected condition and don't think that it could be handled in
+any other way.
+
+Now, more than likely, a method such C<_find_version()> would be called by the
+C<version()> method, which is a metadata method mandated by the App::Info
+abstract base class. This is an appropriate place to handle an unknown version
+value. Indeed, every one of your metadata methods should make use of the
+C<unknown()> method. The C<version()> method then should look something like
+this:
+
+ sub version {
+ my $self = shift;
+
+ unless (exists $self->{version}) {
+ # Try to find the version number.
+ $self->{version} = $self->_find_version ||
+ $self->unknown( key => 'version',
+ prompt => "Enter the version number");
+ }
+
+ # Now return the version number.
+ return $self->{version};
+ }
+
+Note how this method only tries to find the version number once. Any
+subsequent calls to C<version()> will return the same value that was returned
+the first time it was called. Of course, thanks to the C<key> parameter in the
+call to C<unknown()>, we could have have tried to enumerate the version number
+every time, as C<unknown()> will return the same value every time it is called
+(as, indeed, should C<_find_version()>. But by checking for the C<version> key
+in C<$self> ourselves, we save some of the overhead.
+
+But as I said before, every metadata method should make use of the
+C<unknown()> method. Thus, the C<major()> method might looks something like
+this:
+
+ sub major {
+ my $self = shift;
+
+ unless (exists $self->{major}) {
+ # Try to get the major version from the full version number.
+ ($self->{major}) = $self->version =~ /^(\d+)\./;
+ # Handle an unknown value.
+ $self->{major} = $self->unknown( key => 'major',
+ prompt => "Enter major version",
+ callback => sub { /^\d+$/ },
+ error => "Not a number")
+ unless defined $self->{major};
+ }
+
+ return $self->{version};
+ }
+
+Finally, the C<confirm()> method should be used to verify core pieces of data
+that significant numbers of other methods rely on. Typically such data are
+executables or configuration files from which will be drawn other metadata.
+Most often, such major data points will be sought in the object constructor.
+Here's an example:
+
+ sub new {
+ # Construct the object so that handlers will work properly.
+ my $self = shift->SUPER::new(@_);
+
+ # Try to find the executable.
+ $self->info("Searching for executable");
+ if (my $exe = $util->first_exe('/bin/myapp', '/usr/bin/myapp')) {
+ # Confirm it.
+ $self->{exe} =
+ $self->confirm( key => 'binary',
+ prompt => 'Path to your executable?',
+ value => $exe,
+ callback => sub { -x },
+ error => 'Not an executable');
+ } else {
+ # Handle an unknown value.
+ $self->{exe} =
+ $self->unknown( key => 'binary',
+ prompt => 'Path to your executable?',
+ callback => sub { -x },
+ error => 'Not an executable');
+ }
+
+ # We're done.
+ return $self;
+ }
+
+By now, most of what's going on here should be quite familiar. The use of the
+C<confirm()> method is quite similar to that of C<unknown()>. Really the only
+difference is that the value is known, but we need verification or a new value
+supplied if the value we found isn't correct. Such may be the case when
+multiple copies of the executable have been installed on the system, we found
+F</bin/myapp>, but the user may really be interested in F</usr/bin/myapp>.
+Thus the C<confirm()> event gives the user the chance to change the value if
+the confirm event is handled.
+
+The final thing to note about this constructor is the first line:
+
+ my $self = shift->SUPER::new(@_);
+
+The first thing an App::Info subclass should do is execute this line to allow
+the super class to construct the object first. Doing so allows any event
+handling arguments to set up the event handlers, so that when we call
+C<confirm()> or C<unknown()> the event will be handled as the client expects.
+
+If we needed our subclass constructor to take its own parameter argumente, the
+approach is to specify the same C<key => $arg> syntax as is used by
+App::Info's C<new()> method. Say we wanted to allow clients of our App::Info
+subclass to pass in a list of alternate executable locations for us to search.
+Such an argument would most make sense as an array reference. So we specify
+that the key be C<alt_paths> and allow the user to construct an object like
+this:
+
+ my $app = App::Info::Category::FooApp->new( alt_paths => \@paths );
+
+This approach allows the super class constructor arguments to pass unmolested
+(as long as we use unique keys!):
+
+ my $app = App::Info::Category::FooApp->new( on_error => \@handlers,
+ alt_paths => \@paths );
+
+Then, to retrieve these paths inside our C<new()> constructor, all we need do
+is access them directly from the object:
+
+ my $self = shift->SUPER::new(@_);
+ my $alt_paths = $self->{alt_paths};
+
+=head2 Subclassing Guidelines
+
+To summarize, here are some guidelines for subclassing App::Info.
+
+=over 4
+
+=item *
+
+Always subclass an App::Info category subclass. This will help to keep the
+App::Info namespace well-organized. New categories can be added as needed.
+
+=item *
+
+When you create the C<new()> constructor, always call C<SUPER::new(@_)>. This
+ensures that the event handling methods methods defined by the App::Info base
+classes (e.g., C<error()>) will work properly.
+
+=item *
+
+Use a package-scoped lexical App::Info::Util object to carry out common tasks.
+If you find you're doing something over and over that's not already addressed
+by an App::Info::Util method, and you think that others might find your
+solution useful, consider submitting a patch to App::Info::Util to add the
+functionality you need. See L<App::Info::Util|App::Info::Util> for complete
+documentation of its interface.
+
+=item *
+
+Use the C<info()> event triggering method to send messages to users of your
+subclass.
+
+=item *
+
+Use the C<error()> event triggering method to alert users of unexpected
+conditions. Fatal errors should still be fatal; use C<Carp::croak()> to throw
+exceptions for fatal errors.
+
+=item *
+
+Use the C<unknown()> event triggering method when a metadata or other
+important value is unknown and you want to give any event handlers the chance
+to provide the data.
+
+=item *
+
+Use the C<confirm()> event triggering method when a core piece of data is
+known (such as the location of an executable in the C<new()> constructor) and
+you need to make sure that you have the I<correct> information.
+
+=item *
+
+Be sure to implement B<all> of the abstract methods defined by App::Info and
+by your category abstract base class -- even if they don't do anything. Doing
+so ensures that all App::Info subclasses share a common interface, and can, if
+necessary, be used without regard to subclass. Any method not implemented but
+called on an object will generate a fatal exception.
+
+=back
+
+Otherwise, have fun! There are a lot of software packages for which relevant
+information might be collected and aggregated into an App::Info concrete
+subclass (witness all of the Automake macros in the world!), and folks who are
+knowledgeable about particular software packages or categories of software are
+warmly invited to contribute. As more subclasses are implemented, it will make
+sense, I think, to create separate distributions based on category -- or even,
+when necessary, on a single software package. Broader categories can then be
+aggregated in Bundle distributions.
+
+But I get ahead of myself...
+
+=head1 BUGS
+
+Report all bugs via the CPAN Request Tracker at
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.
+
+=head1 AUTHOR
+
+David Wheeler <L<david@wheeler.net|"david@wheeler.net">>
+
+=head1 SEE ALSO
+
+The following classes define a few software package categories in which
+App::Info subclasses can be placed. Check them out for ideas on how to
+create new category subclasses.
+
+=over 4
+
+=item L<App::Info::HTTP|App::Info::HTTPD>
+
+=item L<App::Info::RDBMS|App::Info::RDBMS>
+
+=item L<App::Info::Lib|App::Info::Lib>
+
+=back
+
+The following classes implement the App::Info interface for various software
+packages. Check them out for examples of how to implement new App::Info
+concrete subclasses.
+
+=over
+
+=item L<App::Info::HTTPD::Apache|App::Info::HTTPD::Apache>
+
+=item L<App::Info::RDBMS::PostgreSQL|App::Info::RDBMS::PostgreSQL>
+
+=item L<App::Info::Lib::Expat|App::Info::Lib::Expat>
+
+=item L<App::Info::Lib::Iconv|App::Info::Lib::Iconv>
+
+=back
+
+L<App::Info::Util|App::Info::Util> provides utility methods for App::Info
+subclasses.
+
+L<App::Info::Handler|App::Info::Handler> defines an interface for event
+handlers to subclass. Consult its documentation for information on creating
+custom event handlers.
+
+The following classes implement the App::Info::Handler interface to offer some
+simple event handling. Check them out for examples of how to implement new
+App::Info::Handler subclasses.
+
+=over 4
+
+=item L<App::Info::Handler::Print|App::Info::Handler::Print>
+
+=item L<App::Info::Handler::Carp|App::Info::Handler::Carp>
+
+=item L<App::Info::Handler::Prompt|App::Info::Handler::Prompt>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2002, David Wheeler. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
--- /dev/null
+package App::Info::Handler;
+
+# $Id: Handler.pm,v 1.1.2.1 2004-04-29 09:40:08 ivan Exp $
+
+=head1 NAME
+
+App::Info::Handler - App::Info event handler base class
+
+=head1 SYNOPSIS
+
+ use App::Info::Category::FooApp;
+ use App::Info::Handler;
+
+ my $app = App::Info::Category::FooApp->new( on_info => ['default'] );
+
+=head1 DESCRIPTION
+
+This class defines the interface for subclasses that wish to handle events
+triggered by App::Info concrete subclasses. The different types of events
+triggered by App::Info can all be handled by App::Info::Handler (indeed, by
+default they're all handled by a single App::Info::Handler object), and
+App::Info::Handler subclasses may be designed to handle whatever events they
+wish.
+
+If you're interested in I<using> an App::Info event handler, this is probably
+not the class you should look at, since all it does is define a simple handler
+that does nothing with an event. Look to the L<App::Info::Handler
+subclasses|"SEE ALSO"> included in this distribution to do more interesting
+things with App::Info events.
+
+If, on the other hand, you're interested in implementing your own event
+handlers, read on!
+
+=cut
+
+use strict;
+use vars qw($VERSION);
+$VERSION = '0.22';
+
+my %handlers;
+
+=head1 INTERFACE
+
+This section documents the public interface of App::Info::Handler.
+
+=head2 Class Method
+
+=head3 register_handler
+
+ App::Info::Handler->register_handler( $key => $code_ref );
+
+This class method may be used by App::Info::Handler subclasses to register
+themselves with App::Info::Handler. Multiple registrations are supported. The
+idea is that a subclass can define different functionality by specifying
+different strings that represent different modes of constructing an
+App::Info::Handler subclass object. The keys are case-sensitve, and should be
+unique across App::Info::Handler subclasses so that many subclasses can be
+loaded and used separately. If the C<$key> is already registered,
+C<register_handler()> will throw an exception. The values are code references
+that, when executed, return the appropriate App::Info::Handler subclass
+object.
+
+=cut
+
+sub register_handler {
+ my ($pkg, $key, $code) = @_;
+ Carp::croak("Handler '$key' already exists")
+ if $handlers{$key};
+ $handlers{$key} = $code;
+}
+
+# Register ourself.
+__PACKAGE__->register_handler('default', sub { __PACKAGE__->new } );
+
+##############################################################################
+
+=head2 Constructor
+
+=head3 new
+
+ my $handler = App::Info::Handler->new;
+ $handler = App::Info::Handler->new( key => $key);
+
+Constructs an App::Info::Handler object and returns it. If the key parameter
+is provided and has been registered by an App::Info::Handler subclass via the
+C<register_handler()> class method, then the relevant code reference will be
+executed and the resulting App::Info::Handler subclass object returned. This
+approach provides a handy shortcut for having C<new()> behave as an abstract
+factory method, returning an object of the subclass appropriate to the key
+parameter.
+
+=cut
+
+sub new {
+ my ($pkg, %p) = @_;
+ my $class = ref $pkg || $pkg;
+ $p{key} ||= 'default';
+ if ($class eq __PACKAGE__ && $p{key} ne 'default') {
+ # We were called directly! Handle it.
+ Carp::croak("No such handler '$p{key}'") unless $handlers{$p{key}};
+ return $handlers{$p{key}}->();
+ } else {
+ # A subclass called us -- just instantiate and return.
+ return bless \%p, $class;
+ }
+}
+
+=head2 Instance Method
+
+=head3 handler
+
+ $handler->handler($req);
+
+App::Info::Handler defines a single instance method that must be defined by
+its subclasses, C<handler()>. This is the method that will be executed by an
+event triggered by an App::Info concrete subclass. It takes as its single
+argument an App::Info::Request object, and returns a true value if it has
+handled the event request. Returning a false value declines the request, and
+App::Info will then move on to the next handler in the chain.
+
+The C<handler()> method implemented in App::Info::Handler itself does nothing
+more than return a true value. It thus acts as a very simple default event
+handler. See the App::Info::Handler subclasses for more interesting handling
+of events, or create your own!
+
+=cut
+
+sub handler { 1 }
+
+1;
+__END__
+
+=head1 SUBCLASSING
+
+I hatched the idea of the App::Info event model with its subclassable handlers
+as a way of separating the aggregation of application metadata from writing a
+user interface for handling certain conditions. I felt it a better idea to
+allow people to create their own user interfaces, and instead to provide only
+a few examples. The App::Info::Handler class defines the API interface for
+handling these conditions, which App::Info refers to as "events".
+
+There are various types of events defined by App::Info ("info", "error",
+"unknown", and "confirm"), but the App::Info::Handler interface is designed to
+be flexible enough to handle any and all of them. If you're interested in
+creating your own App::Info event handler, this is the place to learn how.
+
+=head2 The Interface
+
+To create an App::Info event handler, all one need do is subclass
+App::Info::Handler and then implement the C<new()> constructor and the
+C<handler()> method. The C<new()> constructor can do anything you like, and
+take any arguments you like. However, I do recommend that the first thing
+you do in your implementation is to call the super constructor:
+
+ sub new {
+ my $pkg = shift;
+ my $self = $pkg->SUPER::new(@_);
+ # ... other stuff.
+ return $self;
+ }
+
+Although the default C<new()> constructor currently doesn't do much, that may
+change in the future, so this call will keep you covered. What it does do is
+take the parameterized arguments and assign them to the App::Info::Handler
+object. Thus if you've specified a "mode" argument, where clients can
+construct objects of you class like this:
+
+ my $handler = FooHandler->new( mode => 'foo' );
+
+You can access the mode parameter directly from the object, like so:
+
+ sub new {
+ my $pkg = shift;
+ my $self = $pkg->SUPER::new(@_);
+ if ($self->{mode} eq 'foo') {
+ # ...
+ }
+ return $self;
+ }
+
+Just be sure not to use a parameter key name required by App::Info::Handler
+itself. At the moment, the only parameter accepted by App::Info::Handler is
+"key", so in general you'll be pretty safe.
+
+Next, I recommend that you take advantage of the C<register_handler()> method
+to create some shortcuts for creating handlers of your class. For example, say
+we're creating a handler subclass FooHandler. It has two modes, a default
+"foo" mode and an advanced "bar" mode. To allow both to be constructed by
+stringified shortcuts, the FooHandler class implementation might start like
+this:
+
+ package FooHandler;
+
+ use strict;
+ use App::Info::Handler;
+ use vars qw(@ISA);
+ @ISA = qw(App::Info::Handler);
+
+ foreach my $c (qw(foo bar)) {
+ App::Info::Handler->register_handler
+ ( $c => sub { __PACKAGE__->new( mode => $c) } );
+ }
+
+The strings "foo" and "bar" can then be used by clients as shortcuts to have
+App::Info objects automatically create and use handlers for certain events.
+For example, if a client wanted to use a "bar" event handler for its info
+events, it might do this:
+
+ use App::Info::Category::FooApp;
+ use FooHandler;
+
+ my $app = App::Info::Category::FooApp->new(on_info => ['bar']);
+
+Take a look at App::Info::Handler::Print and App::Info::Handler::Carp to see
+concrete examples of C<register_handler()> usage.
+
+The final step in creating a new App::Info event handler is to implement the
+C<handler()> method itself. This method takes a single argument, an
+App::Info::Request object, and is expected to return true if it handled the
+request, and false if it did not. The App::Info::Request object contains all
+the metadata relevant to a request, including the type of event that triggered
+it; see L<App::Info::Request|App::Info::Request> for its documentation.
+
+Use the App::Info::Request object however you like to handle the request
+however you like. You are, however, expected to abide by a a few guidelines:
+
+=over 4
+
+=item *
+
+For error and info events, you are expected (but not required) to somehow
+display the info or error message for the user. How your handler chooses to do
+so is up to you and the handler.
+
+=item *
+
+For unknown and confirm events, you are expected to prompt the user for a
+value. If it's a confirm event, offer the known value (found in
+C<$req-E<gt>value>) as a default.
+
+=item *
+
+For unknown and confirm events, you are expected to call C<$req-E<gt>callback>
+and pass in the new value. If C<$req-E<gt>callback> returns a false value, you
+are expected to display the error message in C<$req-E<gt>error> and prompt the
+user again. Note that C<$req-E<gt>value> calls C<$req-E<gt>callback>
+internally, and thus assigns the value and returns true if
+C<$req-E<gt>callback> returns true, and does not assign the value and returns
+false if C<$req-E<gt>callback> returns false.
+
+=item *
+
+For unknown and confirm events, if you've collected a new value and
+C<$req-E<gt>callback> returns true for that value, you are expected to assign
+the value by passing it to C<$req-E<gt>value>. This allows App::Info to give
+the value back to the calling App::Info concrete subclass.
+
+=back
+
+Probably the easiest way to get started creating new App::Info event handlers
+is to check out the simple handlers provided with the distribution and follow
+their logical examples. Consult the App::Info documentation of the L<event
+methods|App::Info/"Events"> for details on how App::Info constructs the
+App::Info::Request object for each event type.
+
+=head1 BUGS
+
+Report all bugs via the CPAN Request Tracker at
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.
+
+=head1 AUTHOR
+
+David Wheeler <L<david@wheeler.net|"david@wheeler.net">>
+
+=head1 SEE ALSO
+
+L<App::Info|App::Info> thoroughly documents the client interface for setting
+event handlers, as well as the event triggering interface for App::Info
+concrete subclasses.
+
+L<App::Info::Request|App::Info::Request> documents the interface for the
+request objects passed to App::Info::Handler C<handler()> methods.
+
+The following App::Info::Handler subclasses offer examples for event handler
+authors, and, of course, provide actual event handling functionality for
+App::Info clients.
+
+=over 4
+
+=item L<App::Info::Handler::Carp|App::Info::Handler::Carp>
+
+=item L<App::Info::Handler::Print|App::Info::Handler::Print>
+
+=item L<App::Info::Handler::Prompt|App::Info::Handler::Prompt>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2002, David Wheeler. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut
--- /dev/null
+package App::Info::Handler::Prompt;
+
+# $Id: Prompt.pm,v 1.1.2.1 2004-04-29 09:40:08 ivan Exp $
+
+=head1 NAME
+
+App::Info::Handler::Prompt - Prompting App::Info event handler
+
+=head1 SYNOPSIS
+
+ use App::Info::Category::FooApp;
+ use App::Info::Handler::Print;
+
+ my $prompter = App::Info::Handler::Print->new;
+ my $app = App::Info::Category::FooApp->new( on_unknown => $prompter );
+
+ # Or...
+ my $app = App::Info::Category::FooApp->new( on_confirm => 'prompt' );
+
+=head1 DESCRIPTION
+
+App::Info::Handler::Prompt objects handle App::Info events by printing their
+messages to C<STDOUT> and then accepting a new value from C<STDIN>. The new
+value is validated by any callback supplied by the App::Info concrete subclass
+that triggered the event. If the value is valid, App::Info::Handler::Prompt
+assigns the new value to the event request. If it isn't it prints the error
+message associated with the event request, and then prompts for the data
+again.
+
+Although designed with unknown and confirm events in mind,
+App::Info::Handler::Prompt handles info and error events as well. It will
+simply print info event messages to C<STDOUT> and print error event messages
+to C<STDERR>. For more interesting info and error event handling, see
+L<App::Info::Handler::Print|App::Info::Handler::Print> and
+L<App::Info::Handler::Carp|App::Info::Handler::Carp>.
+
+Upon loading, App::Info::Handler::Print registers itself with
+App::Info::Handler, setting up a single string, "prompt", that can be passed
+to an App::Info concrete subclass constructor. This string is a shortcut that
+tells App::Info how to create an App::Info::Handler::Print object for handling
+events.
+
+=cut
+
+use strict;
+use App::Info::Handler;
+use vars qw($VERSION @ISA);
+$VERSION = '0.22';
+@ISA = qw(App::Info::Handler);
+
+# Register ourselves.
+App::Info::Handler->register_handler
+ ('prompt' => sub { __PACKAGE__->new('prompt') } );
+
+=head1 INTERFACE
+
+=head2 Constructor
+
+=head3 new
+
+ my $prompter = App::Info::Handler::Prompt->new;
+
+Constructs a new App::Info::Handler::Prompt object and returns it. No special
+arguments are required.
+
+=cut
+
+sub new {
+ my $pkg = shift;
+ my $self = $pkg->SUPER::new(@_);
+ $self->{tty} = -t STDIN && ( -t STDOUT || !( -f STDOUT || -c STDOUT ) );
+ # We're done!
+ return $self;
+}
+
+my $get_ans = sub {
+ my ($prompt, $tty, $def) = @_;
+ # Print the message.
+ local $| = 1;
+ local $\;
+ print $prompt;
+
+ # Collect the answer.
+ my $ans;
+ if ($tty) {
+ $ans = <STDIN>;
+ if (defined $ans ) {
+ chomp $ans;
+ } else { # user hit ctrl-D
+ print "\n";
+ }
+ } else {
+ print "$def\n" if defined $def;
+ }
+ return $ans;
+};
+
+sub handler {
+ my ($self, $req) = @_;
+ my $ans;
+ my $type = $req->type;
+ if ($type eq 'unknown' || $type eq 'confirm') {
+ # We'll want to prompt for a new value.
+ my $val = $req->value;
+ my ($def, $dispdef) = defined $val ? ($val, " [$val] ") : ('', ' ');
+ my $msg = $req->message or Carp::croak("No message in request");
+ $msg .= $dispdef;
+
+ # Get the answer.
+ $ans = $get_ans->($msg, $self->{tty}, $def);
+ # Just return if they entered an empty string or we couldnt' get an
+ # answer.
+ return 1 unless defined $ans && $ans ne '';
+
+ # Validate the answer.
+ my $err = $req->error;
+ while (!$req->value($ans)) {
+ print "$err: '$ans'\n";
+ $ans = $get_ans->($msg, $self->{tty}, $def);
+ return 1 unless defined $ans && $ans ne '';
+ }
+
+ } elsif ($type eq 'info') {
+ # Just print the message.
+ print STDOUT $req->message, "\n";
+ } elsif ($type eq 'error') {
+ # Just print the message.
+ print STDERR $req->message, "\n";
+ } else {
+ # This shouldn't happen.
+ Carp::croak("Invalid request type '$type'");
+ }
+
+ # Return true to indicate that we've handled the request.
+ return 1;
+}
+
+1;
+__END__
+
+=head1 BUGS
+
+Report all bugs via the CPAN Request Tracker at
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.
+
+=head1 AUTHOR
+
+David Wheeler <L<david@wheeler.net|"david@wheeler.net">>
+
+=head1 SEE ALSO
+
+L<App::Info|App::Info> documents the event handling interface.
+
+L<App::Info::Handler::Carp|App::Info::Handler::Carp> handles events by
+passing their messages Carp module functions.
+
+L<App::Info::Handler::Print|App::Info::Handler::Print> handles events by
+printing their messages to a file handle.
+
+L<App::Info::Handler|App::Info::Handler> describes how to implement custom
+App::Info event handlers.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2002, David Wheeler. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut
--- /dev/null
+package App::Info::RDBMS;
+
+# $Id: RDBMS.pm,v 1.1.2.1 2004-04-29 09:40:08 ivan Exp $
+
+use strict;
+use App::Info;
+use vars qw(@ISA $VERSION);
+@ISA = qw(App::Info);
+$VERSION = '0.22';
+
+1;
+__END__
+
+=head1 NAME
+
+App::Info::RDBMS - Information about databases on a system
+
+=head1 DESCRIPTION
+
+This class is an abstract base class for App::Info subclasses that provide
+information about relational databases. Its subclasses are required to
+implement its interface. See L<App::Info|App::Info> for a complete description
+and L<App::Info::RDBMS::PostgreSQL|App::Info::RDBMS::PostgreSQL> for an example
+implementation.
+
+=head1 INTERFACE
+
+Currently, App::Info::RDBMS adds no more methods than those from its parent
+class, App::Info.
+
+=head1 BUGS
+
+Report all bugs via the CPAN Request Tracker at
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.
+
+=head1 AUTHOR
+
+David Wheeler <L<david@wheeler.net|"david@wheeler.net">>
+
+=head1 SEE ALSO
+
+L<App::Info|App::Info>,
+L<App::Info::RDBMS::PostgreSQL|App::Info::RDBMS::PostgreSQL>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2002, David Wheeler. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut
+
+
+
--- /dev/null
+package App::Info::RDBMS::PostgreSQL;
+
+# $Id: PostgreSQL.pm,v 1.1.2.1 2004-04-29 09:40:08 ivan Exp $
+
+=head1 NAME
+
+App::Info::RDBMS::PostgreSQL - Information about PostgreSQL
+
+=head1 SYNOPSIS
+
+ use App::Info::RDBMS::PostgreSQL;
+
+ my $pg = App::Info::RDBMS::PostgreSQL->new;
+
+ if ($pg->installed) {
+ print "App name: ", $pg->name, "\n";
+ print "Version: ", $pg->version, "\n";
+ print "Bin dir: ", $pg->bin_dir, "\n";
+ } else {
+ print "PostgreSQL is not installed. :-(\n";
+ }
+
+=head1 DESCRIPTION
+
+App::Info::RDBMS::PostgreSQL supplies information about the PostgreSQL
+database server installed on the local system. It implements all of the
+methods defined by App::Info::RDBMS. Methods that trigger events will trigger
+them only the first time they're called (See L<App::Info|App::Info> for
+documentation on handling events). To start over (after, say, someone has
+installed PostgreSQL) construct a new App::Info::RDBMS::PostgreSQL object to
+aggregate new metadata.
+
+Some of the methods trigger the same events. This is due to cross-calling of
+shared subroutines. However, any one event should be triggered no more than
+once. For example, although the info event "Executing `pg_config --version`"
+is documented for the methods C<name()>, C<version()>, C<major_version()>,
+C<minor_version()>, and C<patch_version()>, rest assured that it will only be
+triggered once, by whichever of those four methods is called first.
+
+=cut
+
+use strict;
+use App::Info::RDBMS;
+use App::Info::Util;
+use vars qw(@ISA $VERSION);
+@ISA = qw(App::Info::RDBMS);
+$VERSION = '0.22';
+
+my $u = App::Info::Util->new;
+
+=head1 INTERFACE
+
+=head2 Constructor
+
+=head3 new
+
+ my $pg = App::Info::RDBMS::PostgreSQL->new(@params);
+
+Returns an App::Info::RDBMS::PostgreSQL object. See L<App::Info|App::Info> for
+a complete description of argument parameters.
+
+When it called, C<new()> searches the file system for the F<pg_config>
+application. If found, F<pg_config> will be called by the object methods below
+to gather the data necessary for each. If F<pg_config> cannot be found, then
+PostgreSQL is assumed not to be installed, and each of the object methods will
+return C<undef>.
+
+App::Info::RDBMS::PostgreSQL searches for F<pg_config> along your path, as
+defined by C<File::Spec-E<gt>path>. Failing that, it searches the following
+directories:
+
+=over 4
+
+=item /usr/local/pgsql/bin
+
+=item /usr/local/postgres/bin
+
+=item /opt/pgsql/bin
+
+=item /usr/local/bin
+
+=item /usr/local/sbin
+
+=item /usr/bin
+
+=item /usr/sbin
+
+=item /bin
+
+=back
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Looking for pg_config
+
+=item confirm
+
+Path to pg_config?
+
+=item unknown
+
+Path to pg_config?
+
+=back
+
+=cut
+
+sub new {
+ # Construct the object.
+ my $self = shift->SUPER::new(@_);
+
+ # Find pg_config.
+ $self->info("Looking for pg_config");
+ my @paths = ($u->path,
+ qw(/usr/local/pgsql/bin
+ /usr/local/postgres/bin
+ /opt/pgsql/bin
+ /usr/local/bin
+ /usr/local/sbin
+ /usr/bin
+ /usr/sbin
+ /bin));
+
+ if (my $cfg = $u->first_cat_exe('pg_config', @paths)) {
+ # We found it. Confirm.
+ $self->{pg_config} = $self->confirm( key => 'pg_config',
+ prompt => 'Path to pg_config?',
+ value => $cfg,
+ callback => sub { -x },
+ error => 'Not an executable');
+ } else {
+ # Handle an unknown value.
+ $self->{pg_config} = $self->unknown( key => 'pg_config',
+ prompt => 'Path to pg_config?',
+ callback => sub { -x },
+ error => 'Not an executable');
+ }
+
+ return $self;
+}
+
+# We'll use this code reference as a common way of collecting data.
+my $get_data = sub {
+ return unless $_[0]->{pg_config};
+ $_[0]->info("Executing `$_[0]->{pg_config} $_[1]`");
+ my $info = `$_[0]->{pg_config} $_[1]`;
+ chomp $info;
+ return $info;
+};
+
+##############################################################################
+
+=head2 Class Method
+
+=head3 key_name
+
+ my $key_name = App::Info::RDBMS::PostgreSQL->key_name;
+
+Returns the unique key name that describes this class. The value returned is
+the string "PostgreSQL".
+
+=cut
+
+sub key_name { 'PostgreSQL' }
+
+##############################################################################
+
+=head2 Object Methods
+
+=head3 installed
+
+ print "PostgreSQL is ", ($pg->installed ? '' : 'not '), "installed.\n";
+
+Returns true if PostgreSQL is installed, and false if it is not.
+App::Info::RDBMS::PostgreSQL determines whether PostgreSQL is installed based
+on the presence or absence of the F<pg_config> application on the file system
+as found when C<new()> constructed the object. If PostgreSQL does not appear
+to be installed, then all of the other object methods will return empty
+values.
+
+=cut
+
+sub installed { return $_[0]->{pg_config} ? 1 : undef }
+
+##############################################################################
+
+=head3 name
+
+ my $name = $pg->name;
+
+Returns the name of the application. App::Info::RDBMS::PostgreSQL parses the
+name from the system call C<`pg_config --version`>.
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --version`
+
+=item error
+
+Failed to find PostgreSQL version with `pg_config --version`
+
+Unable to parse name from string
+
+Unable to parse version from string
+
+Failed to parse PostgreSQL version parts from string
+
+=item unknown
+
+Enter a valid PostgreSQL name
+
+=back
+
+=cut
+
+# This code reference is used by name(), version(), major_version(),
+# minor_version(), and patch_version() to aggregate the data they need.
+my $get_version = sub {
+ my $self = shift;
+ $self->{'--version'} = 1;
+ my $data = $get_data->($self, '--version');
+ unless ($data) {
+ $self->error("Failed to find PostgreSQL version with ".
+ "`$self->{pg_config} --version");
+ return;
+ }
+
+ chomp $data;
+ my ($name, $version) = split /\s+/, $data, 2;
+
+ # Check for and assign the name.
+ $name ?
+ $self->{name} = $name :
+ $self->error("Unable to parse name from string '$data'");
+
+ # Parse the version number.
+ if ($version) {
+ my ($x, $y, $z) = $version =~ /(\d+)\.(\d+).(\d+)/;
+ if (defined $x and defined $y and defined $z) {
+ @{$self}{qw(version major minor patch)} =
+ ($version, $x, $y, $z);
+ } else {
+ $self->error("Failed to parse PostgreSQL version parts from " .
+ "string '$version'");
+ }
+ } else {
+ $self->error("Unable to parse version from string '$data'");
+ }
+};
+
+sub name {
+ my $self = shift;
+ return unless $self->{pg_config};
+
+ # Load data.
+ $get_version->($self) unless $self->{'--version'};
+
+ # Handle an unknown name.
+ $self->{name} ||= $self->unknown( key => 'name' );
+
+ # Return the name.
+ return $self->{name};
+}
+
+##############################################################################
+
+=head3 version
+
+ my $version = $pg->version;
+
+Returns the PostgreSQL version number. App::Info::RDBMS::PostgreSQL parses the
+version number from the system call C<`pg_config --version`>.
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --version`
+
+=item error
+
+Failed to find PostgreSQL version with `pg_config --version`
+
+Unable to parse name from string
+
+Unable to parse version from string
+
+Failed to parse PostgreSQL version parts from string
+
+=item unknown
+
+Enter a valid PostgreSQL version number
+
+=back
+
+=cut
+
+sub version {
+ my $self = shift;
+ return unless $self->{pg_config};
+
+ # Load data.
+ $get_version->($self) unless $self->{'--version'};
+
+ # Handle an unknown value.
+ unless ($self->{version}) {
+ # Create a validation code reference.
+ my $chk_version = sub {
+ # Try to get the version number parts.
+ my ($x, $y, $z) = /^(\d+)\.(\d+).(\d+)$/;
+ # Return false if we didn't get all three.
+ return unless $x and defined $y and defined $z;
+ # Save all three parts.
+ @{$self}{qw(major minor patch)} = ($x, $y, $z);
+ # Return true.
+ return 1;
+ };
+ $self->{version} = $self->unknown( key => 'version number',
+ callback => $chk_version);
+ }
+
+ return $self->{version};
+}
+
+##############################################################################
+
+=head3 major version
+
+ my $major_version = $pg->major_version;
+
+Returns the PostgreSQL major version number. App::Info::RDBMS::PostgreSQL
+parses the major version number from the system call C<`pg_config --version`>.
+For example, C<version()> returns "7.1.2", then this method returns "7".
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --version`
+
+=item error
+
+Failed to find PostgreSQL version with `pg_config --version`
+
+Unable to parse name from string
+
+Unable to parse version from string
+
+Failed to parse PostgreSQL version parts from string
+
+=item unknown
+
+Enter a valid PostgreSQL major version number
+
+=back
+
+=cut
+
+# This code reference is used by major_version(), minor_version(), and
+# patch_version() to validate a version number entered by a user.
+my $is_int = sub { /^\d+$/ };
+
+sub major_version {
+ my $self = shift;
+ return unless $self->{pg_config};
+ # Load data.
+ $get_version->($self) unless exists $self->{'--version'};
+ # Handle an unknown value.
+ $self->{major} = $self->unknown( key => 'major version number',
+ callback => $is_int)
+ unless $self->{major};
+ return $self->{major};
+}
+
+##############################################################################
+
+=head3 minor version
+
+ my $minor_version = $pg->minor_version;
+
+Returns the PostgreSQL minor version number. App::Info::RDBMS::PostgreSQL
+parses the minor version number from the system call C<`pg_config --version`>.
+For example, if C<version()> returns "7.1.2", then this method returns "2".
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --version`
+
+=item error
+
+Failed to find PostgreSQL version with `pg_config --version`
+
+Unable to parse name from string
+
+Unable to parse version from string
+
+Failed to parse PostgreSQL version parts from string
+
+=item unknown
+
+Enter a valid PostgreSQL minor version number
+
+=back
+
+=cut
+
+sub minor_version {
+ my $self = shift;
+ return unless $self->{pg_config};
+ # Load data.
+ $get_version->($self) unless exists $self->{'--version'};
+ # Handle an unknown value.
+ $self->{minor} = $self->unknown( key => 'minor version number',
+ callback => $is_int)
+ unless defined $self->{minor};
+ return $self->{minor};
+}
+
+##############################################################################
+
+=head3 patch version
+
+ my $patch_version = $pg->patch_version;
+
+Returns the PostgreSQL patch version number. App::Info::RDBMS::PostgreSQL
+parses the patch version number from the system call C<`pg_config --version`>.
+For example, if C<version()> returns "7.1.2", then this method returns "1".
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --version`
+
+=item error
+
+Failed to find PostgreSQL version with `pg_config --version`
+
+Unable to parse name from string
+
+Unable to parse version from string
+
+Failed to parse PostgreSQL version parts from string
+
+=item unknown
+
+Enter a valid PostgreSQL minor version number
+
+=back
+
+=cut
+
+sub patch_version {
+ my $self = shift;
+ return unless $self->{pg_config};
+ # Load data.
+ $get_version->($self) unless exists $self->{'--version'};
+ # Handle an unknown value.
+ $self->{patch} = $self->unknown( key => 'patch version number',
+ callback => $is_int)
+ unless defined $self->{patch};
+ return $self->{patch};
+}
+
+##############################################################################
+
+=head3 bin_dir
+
+ my $bin_dir = $pg->bin_dir;
+
+Returns the PostgreSQL binary directory path. App::Info::RDBMS::PostgreSQL
+gathers the path from the system call C<`pg_config --bindir`>.
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --bindir`
+
+=item error
+
+Cannot find bin directory
+
+=item unknown
+
+Enter a valid PostgreSQL bin directory
+
+=back
+
+=cut
+
+# This code reference is used by bin_dir(), lib_dir(), and so_lib_dir() to
+# validate a directory entered by the user.
+my $is_dir = sub { -d };
+
+sub bin_dir {
+ my $self = shift;
+ return unless $self->{pg_config};
+ unless (exists $self->{bin_dir} ) {
+ if (my $dir = $get_data->($self, '--bindir')) {
+ $self->{bin_dir} = $dir;
+ } else {
+ # Handle an unknown value.
+ $self->error("Cannot find bin directory");
+ $self->{bin_dir} = $self->unknown( key => 'bin directory',
+ callback => $is_dir)
+ }
+ }
+
+ return $self->{bin_dir};
+}
+
+##############################################################################
+
+=head3 inc_dir
+
+ my $inc_dir = $pg->inc_dir;
+
+Returns the PostgreSQL include directory path. App::Info::RDBMS::PostgreSQL
+gathers the path from the system call C<`pg_config --includedir`>.
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --includedir`
+
+=item error
+
+Cannot find include directory
+
+=item unknown
+
+Enter a valid PostgreSQL include directory
+
+=back
+
+=cut
+
+sub inc_dir {
+ my $self = shift;
+ return unless $self->{pg_config};
+ unless (exists $self->{inc_dir} ) {
+ if (my $dir = $get_data->($self, '--includedir')) {
+ $self->{inc_dir} = $dir;
+ } else {
+ # Handle an unknown value.
+ $self->error("Cannot find include directory");
+ $self->{inc_dir} = $self->unknown( key => 'include directory',
+ callback => $is_dir)
+ }
+ }
+
+ return $self->{inc_dir};
+}
+
+##############################################################################
+
+=head3 lib_dir
+
+ my $lib_dir = $pg->lib_dir;
+
+Returns the PostgreSQL library directory path. App::Info::RDBMS::PostgreSQL
+gathers the path from the system call C<`pg_config --libdir`>.
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --libdir`
+
+=item error
+
+Cannot find library directory
+
+=item unknown
+
+Enter a valid PostgreSQL library directory
+
+=back
+
+=cut
+
+sub lib_dir {
+ my $self = shift;
+ return unless $self->{pg_config};
+ unless (exists $self->{lib_dir} ) {
+ if (my $dir = $get_data->($self, '--libdir')) {
+ $self->{lib_dir} = $dir;
+ } else {
+ # Handle an unknown value.
+ $self->error("Cannot find library directory");
+ $self->{lib_dir} = $self->unknown( key => 'library directory',
+ callback => $is_dir)
+ }
+ }
+
+ return $self->{lib_dir};
+}
+
+##############################################################################
+
+=head3 so_lib_dir
+
+ my $so_lib_dir = $pg->so_lib_dir;
+
+Returns the PostgreSQL shared object library directory path.
+App::Info::RDBMS::PostgreSQL gathers the path from the system call
+C<`pg_config --pkglibdir`>.
+
+B<Events:>
+
+=over 4
+
+=item info
+
+Executing `pg_config --pkglibdir`
+
+=item error
+
+Cannot find shared object library directory
+
+=item unknown
+
+Enter a valid PostgreSQL shared object library directory
+
+=back
+
+=cut
+
+# Location of dynamically loadable modules.
+sub so_lib_dir {
+ my $self = shift;
+ return unless $self->{pg_config};
+ unless (exists $self->{so_lib_dir} ) {
+ if (my $dir = $get_data->($self, '--pkglibdir')) {
+ $self->{so_lib_dir} = $dir;
+ } else {
+ # Handle an unknown value.
+ $self->error("Cannot find shared object library directory");
+ $self->{so_lib_dir} =
+ $self->unknown( key => 'shared object library directory',
+ callback => $is_dir)
+ }
+ }
+
+ return $self->{so_lib_dir};
+}
+
+##############################################################################
+
+=head3 home_url
+
+ my $home_url = $pg->home_url;
+
+Returns the PostgreSQL home page URL.
+
+=cut
+
+sub home_url { "http://www.postgresql.org/" }
+
+##############################################################################
+
+=head3 download_url
+
+ my $download_url = $pg->download_url;
+
+Returns the PostgreSQL download URL.
+
+=cut
+
+sub download_url { "http://www.ca.postgresql.org/sitess.html" }
+
+1;
+__END__
+
+=head1 BUGS
+
+Report all bugs via the CPAN Request Tracker at
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.
+
+=head1 AUTHOR
+
+David Wheeler <L<david@wheeler.net|"david@wheeler.net">> based on code by Sam
+Tregar <L<sam@tregar.com|"sam@tregar.com">>.
+
+=head1 SEE ALSO
+
+L<App::Info|App::Info> documents the event handling interface.
+
+L<App::Info::RDBMS|App::Info::RDBMS> is the App::Info::RDBMS::PostgreSQL
+parent class.
+
+L<DBD::Pg|DBD::Pg> is the L<DBI|DBI> driver for connecting to PostgreSQL
+databases.
+
+L<http://www.postgresql.org/> is the PostgreSQL home page.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2002, David Wheeler. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut
--- /dev/null
+package App::Info::Request;
+
+# $Id: Request.pm,v 1.1.2.1 2004-04-29 09:40:08 ivan Exp $
+
+=head1 NAME
+
+App::Info::Request - App::Info event handler request object
+
+=head1 SYNOPSIS
+
+ # In an App::Info::Handler subclass:
+ sub handler {
+ my ($self, $req) = @_;
+ print "Event Type: ", $req->type;
+ print "Message: ", $req->message;
+ print "Error: ", $req->error;
+ print "Value: ", $req->value;
+ }
+
+=head1 DESCRIPTION
+
+Objects of this class are passed to the C<handler()> method of App::Info event
+handlers. Generally, this class will be of most interest to App::Info::Handler
+subclass implementers.
+
+The L<event triggering methods|App::Info/"Events"> in App::Info each construct
+a new App::Info::Request object and initialize it with their arguments. The
+App::Info::Request object is then the sole argument passed to the C<handler()>
+method of any and all App::Info::Handler objects in the event handling chain.
+Thus, if you'd like to create your own App::Info event handler, this is the
+object you need to be familiar with. Consult the
+L<App::Info::Handler|App::Info::Handler> documentation for details on creating
+custom event handlers.
+
+Each of the App::Info event triggering methods constructs an
+App::Info::Request object with different attribute values. Be sure to consult
+the documentation for the L<event triggering methods|App::Info/"Events"> in
+App::Info, where the values assigned to the App::Info::Request object are
+documented. Then, in your event handler subclass, check the value returned by
+the C<type()> method to determine what type of event request you're handling
+to handle the request appropriately.
+
+=cut
+
+use strict;
+use vars qw($VERSION);
+$VERSION = '0.23';
+
+##############################################################################
+
+=head1 INTERFACE
+
+The following sections document the App::Info::Request interface.
+
+=head2 Constructor
+
+=head3 new
+
+ my $req = App::Info::Request->new(%params);
+
+This method is used internally by App::Info to construct new
+App::Info::Request objects to pass to event handler objects. Generally, you
+won't need to use it, other than perhaps for testing custom App::Info::Handler
+classes.
+
+The parameters to C<new()> are passed as a hash of named parameters that
+correspond to their like-named methods. The supported parameters are:
+
+=over 4
+
+=item type
+
+=item message
+
+=item error
+
+=item value
+
+=item callback
+
+=back
+
+See the object methods documentation below for details on these object
+attributes.
+
+=cut
+
+sub new {
+ my $pkg = shift;
+
+ # Make sure we've got a hash of arguments.
+ Carp::croak("Odd number of parameters in call to " . __PACKAGE__ .
+ "->new() when named parameters expected" ) if @_ % 2;
+ my %params = @_;
+
+ # Validate the callback.
+ if ($params{callback}) {
+ Carp::croak("Callback parameter '$params{callback}' is not a code ",
+ "reference")
+ unless UNIVERSAL::isa($params{callback}, 'CODE');
+ } else {
+ # Otherwise just assign a default approve callback.
+ $params{callback} = sub { 1 };
+ }
+
+ # Validate type parameter.
+ if (my $t = $params{type}) {
+ Carp::croak("Invalid handler type '$t'")
+ unless $t eq 'error' or $t eq 'info' or $t eq 'unknown'
+ or $t eq 'confirm';
+ } else {
+ $params{type} = 'info';
+ }
+
+ # Return the request object.
+ bless \%params, ref $pkg || $pkg;
+}
+
+##############################################################################
+
+=head2 Object Methods
+
+=head3 message
+
+ my $message = $req->message;
+
+Returns the message stored in the App::Info::Request object. The message is
+typically informational, or an error message, or a prompt message.
+
+=cut
+
+sub message { $_[0]->{message} }
+
+##############################################################################
+
+=head3 error
+
+ my $error = $req->error;
+
+Returns any error message associated with the App::Info::Request object. The
+error message is typically there to display for users when C<callback()>
+returns false.
+
+=cut
+
+sub error { $_[0]->{error} }
+
+##############################################################################
+
+=head3 type
+
+ my $type = $req->type;
+
+Returns a string representing the type of event that triggered this request.
+The types are the same as the event triggering methods defined in App::Info.
+As of this writing, the supported types are:
+
+=over
+
+=item info
+
+=item error
+
+=item unknown
+
+=item confirm
+
+=back
+
+Be sure to consult the App::Info documentation for more details on the event
+types.
+
+=cut
+
+sub type { $_[0]->{type} }
+
+##############################################################################
+
+=head3 callback
+
+ if ($req->callback($value)) {
+ print "Value '$value' is valid.\n";
+ } else {
+ print "Value '$value' is not valid.\n";
+ }
+
+Executes the callback anonymous subroutine supplied by the App::Info concrete
+base class that triggered the event. If the callback returns false, then
+C<$value> is invalid. If the callback returns true, then C<$value> is valid
+and can be assigned via the C<value()> method.
+
+Note that the C<value()> method itself calls C<callback()> if it was passed a
+value to assign. See its documentation below for more information.
+
+=cut
+
+sub callback {
+ my $self = shift;
+ my $code = $self->{callback};
+ local $_ = $_[0];
+ $code->(@_);
+}
+
+##############################################################################
+
+=head3 value
+
+ my $value = $req->value;
+ if ($req->value($value)) {
+ print "Value '$value' successfully assigned.\n";
+ } else {
+ print "Value '$value' not successfully assigned.\n";
+ }
+
+When called without an argument, C<value()> simply returns the value currently
+stored by the App::Info::Request object. Typically, the value is the default
+value for a confirm event, or a value assigned to an unknown event.
+
+When passed an argument, C<value()> attempts to store the the argument as a
+new value. However, C<value()> calls C<callback()> on the new value, and if
+C<callback()> returns false, then C<value()> returns false and does not store
+the new value. If C<callback()> returns true, on the other hand, then
+C<value()> goes ahead and stores the new value and returns true.
+
+=cut
+
+sub value {
+ my $self = shift;
+ if ($#_ >= 0) {
+ # grab the value.
+ my $value = shift;
+ # Validate the value.
+ if ($self->callback($value)) {
+ # The value is good. Assign it and return true.
+ $self->{value} = $value;
+ return 1;
+ } else {
+ # Invalid value. Return false.
+ return;
+ }
+ }
+ # Just return the value.
+ return $self->{value};
+}
+
+1;
+__END__
+
+=head1 BUGS
+
+Report all bugs via the CPAN Request Tracker at
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.
+
+=head1 AUTHOR
+
+David Wheeler <L<david@wheeler.net|"david@wheeler.net">>
+
+=head1 SEE ALSO
+
+L<App::Info|App::Info> documents the event triggering methods and how they
+construct App::Info::Request objects to pass to event handlers.
+
+L<App::Info::Handler:|App::Info::Handler> documents how to create custom event
+handlers, which must make use of the App::Info::Request object passed to their
+C<handler()> object methods.
+
+The following classes subclass App::Info::Handler, and thus offer good
+exemplars for using App::Info::Request objects when handling events.
+
+=over 4
+
+=item L<App::Info::Handler::Carp|App::Info::Handler::Carp>
+
+=item L<App::Info::Handler::Print|App::Info::Handler::Print>
+
+=item L<App::Info::Handler::Prompt|App::Info::Handler::Prompt>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2002, David Wheeler. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut
--- /dev/null
+package App::Info::Util;
+
+# $Id: Util.pm,v 1.1.2.1 2004-04-29 09:40:08 ivan Exp $
+
+=head1 NAME
+
+App::Info::Util - Utility class for App::Info subclasses
+
+=head1 SYNOPSIS
+
+ use App::Info::Util;
+
+ my $util = App::Info::Util->new;
+
+ # Subclasses File::Spec.
+ my @paths = $util->paths;
+
+ # First directory that exists in a list.
+ my $dir = $util->first_dir(@paths);
+
+ # First directory that exists in a path.
+ $dir = $util->first_path($ENV{PATH});
+
+ # First file that exists in a list.
+ my $file = $util->first_file('this.txt', '/that.txt', 'C:\\foo.txt');
+
+ # First file found among file base names and directories.
+ my $files = ['this.txt', 'that.txt'];
+ $file = $util->first_cat_file($files, @paths);
+
+=head1 DESCRIPTION
+
+This class subclasses L<File::Spec|File::Spec> and adds its own methods in
+order to offer utility methods to L<App::Info|App::Info> classes. Although
+intended to be used by App::Info subclasses, in truth App::Info::Util's
+utility may be considered more general, so feel free to use it elsewhere.
+
+The methods added in addition to the usual File::Spec suspects are designed to
+facilitate locating files and directories on the file system, as well as
+searching those files. The assumption is that, in order to provide useful
+metadata about a given software package, an App::Info subclass must find
+relevant files and directories and parse them with regular expressions. This
+class offers methods that simplify those tasks.
+
+=cut
+
+use strict;
+use File::Spec ();
+use vars qw(@ISA $VERSION);
+@ISA = qw(File::Spec);
+$VERSION = '0.22';
+
+my %path_dems = (MacOS => qr',',
+ MSWin32 => qr';',
+ os2 => qr';',
+ VMS => undef,
+ epoc => undef);
+
+my $path_dem = exists $path_dems{$^O} ? $path_dems{$^O} : qr':';
+
+=head1 CONSTRUCTOR
+
+=head2 new
+
+ my $util = App::Info::Util->new;
+
+This is a very simple constructor that merely returns an App::Info::Util
+object. Since, like its File::Spec super class, App::Info::Util manages no
+internal data itself, all methods may be used as class methods, if one prefers
+to. The constructor here is provided merely as a convenience.
+
+=cut
+
+sub new { bless {}, ref $_[0] || $_[0] }
+
+=head1 OBJECT METHODS
+
+In addition to all of the methods offered by its super class,
+L<File::Spec|File::Spec>, App::Info::Util offers the following methods.
+
+=head2 first_dir
+
+ my @paths = $util->paths;
+ my $dir = $util->first_dir(@dirs);
+
+Returns the first file system directory in @paths that exists on the local
+file system. Only the first item in @paths that exists as a directory will be
+returned; any other paths leading to non-directories will be ignored.
+
+=cut
+
+sub first_dir {
+ shift;
+ foreach (@_) { return $_ if -d }
+ return;
+}
+
+=head2 first_path
+
+ my $path = $ENV{PATH};
+ $dir = $util->first_path($path);
+
+Takes the $path string and splits it into a list of directory paths, based on
+the path demarcator on the local file system. Then calls C<first_dir()> to
+return the first directoy in the path list that exists on the local file
+system. The path demarcator is specified for the following file systems:
+
+=over 4
+
+=item MacOS: ","
+
+=item MSWin32: ";"
+
+=item os2: ";"
+
+=item VMS: undef
+
+This method always returns undef on VMS. Patches welcome.
+
+=item epoc: undef
+
+This method always returns undef on epoch. Patches welcome.
+
+=item Unix: ":"
+
+All other operating systems are assumed to be Unix-based.
+
+=back
+
+=cut
+
+sub first_path {
+ return unless $path_dem;
+ shift->first_dir(split /$path_dem/, shift)
+}
+
+=head2 first_file
+
+ my $file = $util->first_file(@filelist);
+
+Examines each of the files in @filelist and returns the first one that exists
+on the file system. The file must be a regular file -- directories will be
+ignored.
+
+=cut
+
+sub first_file {
+ shift;
+ foreach (@_) { return $_ if -f }
+ return;
+}
+
+=head2 first_exe
+
+ my $exe = $util->first_exe(@exelist);
+
+Examines each of the files in @exelist and returns the first one that exists
+on the file system as an executable file. Directories will be ignored.
+
+=cut
+
+sub first_exe {
+ shift;
+ foreach (@_) { return $_ if -f && -x }
+ return;
+}
+
+=head2 first_cat_path
+
+ my $file = $util->first_cat_path('ick.txt', @paths);
+ $file = $util->first_cat_path(['this.txt', 'that.txt'], @paths);
+
+The first argument to this method may be either a file or directory base name
+(that is, a file or directory name without a full path specification), or a
+reference to an array of file or directory base names. The remaining arguments
+constitute a list of directory paths. C<first_cat_path()> processes each of
+these directory paths, concatenates (by the method native to the local
+operating system) each of the file or directory base names, and returns the
+first one that exists on the file system.
+
+For example, let us say that we were looking for a file called either F<httpd>
+or F<apache>, and it could be in any of the following paths:
+F</usr/local/bin>, F</usr/bin/>, F</bin>. The method call looks like this:
+
+ my $httpd = $util->first_cat_path(['httpd', 'apache'], '/usr/local/bin',
+ '/usr/bin/', '/bin');
+
+If the OS is a Unix variant, C<first_cat_path()> will then look for the first
+file that exists in this order:
+
+=over 4
+
+=item /usr/local/bin/httpd
+
+=item /usr/local/bin/apache
+
+=item /usr/bin/httpd
+
+=item /usr/bin/apache
+
+=item /bin/httpd
+
+=item /bin/apache
+
+=back
+
+The first of these complete paths to be found will be returned. If none are
+found, then undef will be returned.
+
+=cut
+
+sub first_cat_path {
+ my $self = shift;
+ my $files = ref $_[0] ? shift() : [shift()];
+ foreach my $p (@_) {
+ foreach my $f (@$files) {
+ my $path = $self->catfile($p, $f);
+ return $path if -e $path;
+ }
+ }
+ return;
+}
+
+=head2 first_cat_dir
+
+ my $dir = $util->first_cat_dir('ick.txt', @paths);
+ $dir = $util->first_cat_dir(['this.txt', 'that.txt'], @paths);
+
+Funtionally identical to C<first_cat_path()>, except that it returns the
+directory path in which the first file was found, rather than the full
+concatenated path. Thus, in the above example, if the file found was
+F</usr/bin/httpd>, while C<first_cat_path()> would return that value,
+C<first_cat_dir()> would return F</usr/bin> instead.
+
+=cut
+
+sub first_cat_dir {
+ my $self = shift;
+ my $files = ref $_[0] ? shift() : [shift()];
+ foreach my $p (@_) {
+ foreach my $f (@$files) {
+ my $path = $self->catfile($p, $f);
+ return $p if -e $path;
+ }
+ }
+ return;
+}
+
+=head2 first_cat_exe
+
+ my $exe = $util->first_cat_exe('ick.txt', @paths);
+ $exe = $util->first_cat_exe(['this.txt', 'that.txt'], @paths);
+
+Funtionally identical to C<first_cat_path()>, except that it returns the full
+path to the first executable file found, rather than simply the first file
+found.
+
+=cut
+
+sub first_cat_exe {
+ my $self = shift;
+ my $files = ref $_[0] ? shift() : [shift()];
+ foreach my $p (@_) {
+ foreach my $f (@$files) {
+ my $path = $self->catfile($p, $f);
+ return $path if -f $path && -x $path;
+ }
+ }
+ return;
+}
+
+=head2 search_file
+
+ my $file = 'foo.txt';
+ my $regex = qr/(text\s+to\s+find)/;
+ my $value = $util->search_file($file, $regex);
+
+Opens C<$file> and executes the C<$regex> regular expression against each line
+in the file. Once the line matches and one or more values is returned by the
+match, the file is closed and the value or values returned.
+
+For example, say F<foo.txt> contains the line "Version 6.5, patch level 8",
+and you need to grab each of the three version parts. All three parts can
+be grabbed like this:
+
+ my $regex = qr/Version\s+(\d+)\.(\d+),[^\d]*(\d+)/;
+ my @nums = $util->search_file($file, $regex);
+
+Now C<@nums> will contain the values C<(6, 5, 8)>. Note that in a scalar
+context, the above search would yeild an array reference:
+
+ my $regex = qr/Version\s+(\d+)\.(\d+),[^\d]*(\d+)/;
+ my $nums = $util->search_file($file, $regex);
+
+So now C<$nums> contains C<[6, 5, 8]>. The same does not hold true if the
+match returns only one value, however. Say F<foo.txt> contains the line
+"king of the who?", and you wish to know who the king is king of. Either
+of the following two calls would get you the data you need:
+
+ my $minions = $util->search_file($file, qr/King\s+of\s+(.*)/);
+ my @minions = $util->search_file($file, qr/King\s+of\s+(.*)/);
+
+In the first case, because the regular expression contains only one set of
+parentheses, C<search_file()> will simply return that value: C<$minions>
+contains the string "the who?". In the latter case, C<@minions> of course
+contains a single element: C<("the who?")>.
+
+Note that a regular expression without parentheses -- that is, one that
+doesn't grab values and put them into $1, $2, etc., will never successfully
+match a line in this method. You must include something to parentetically
+match. If you just want to know the value of what was matched, parenthesize
+the whole thing and if the value returns, you have a match. Also, if you need
+to match patterns across lines, try using multiple regular expressions with
+C<multi_search_file()>, instead.
+
+=cut
+
+sub search_file {
+ my ($self, $file, $regex) = @_;
+ return unless $file && $regex;
+ open F, "<$file" or Carp::croak "Cannot open $file: $!\n";
+ my @ret;
+ while (<F>) {
+ # If we find a match, we're done.
+ (@ret) = /$regex/ and last;
+ }
+ close F;
+ # If the match returned an more than one value, always return the full
+ # array. Otherwise, return just the first value in a scalar context.
+ return unless @ret;
+ return wantarray ? @ret : $#ret <= 0 ? $ret[0] : \@ret;
+}
+
+=head2 multi_search_file
+
+ my @regexen = (qr/(one)/, qr/(two)\s+(three)/);
+ my @matches = $util->multi_search_file($file, @regexen);
+
+Like C<search_file()>, this mehod opens C<$file> and parses it for regular
+expresion matches. This method, however, can take a list of regular
+expressions to look for, and will return the values found for all of them.
+Regular expressions that match and return multiple values will be returned as
+array referernces, while those that match and return a single value will
+return just that single value.
+
+For example, say you are parsing a file with lines like the following:
+
+ #define XML_MAJOR_VERSION 1
+ #define XML_MINOR_VERSION 95
+ #define XML_MICRO_VERSION 2
+
+You need to get each of these numbers, but calling C<search_file()> for each
+of them would be wasteful, as each call to C<search_file()> opens the file and
+parses it. With C<multi_search_file()>, on the other hand, the file will be
+opened only once, and, once all of the regular expressions have returned
+matches, the file will be closed and the matches returned.
+
+Thus the above values can be collected like this:
+
+ my @regexen = ( qr/XML_MAJOR_VERSION\s+(\d+)$/,
+ qr/XML_MINOR_VERSION\s+(\d+)$/,
+ qr/XML_MICRO_VERSION\s+(\d+)$/ );
+
+ my @nums = $file->multi_search_file($file, @regexen);
+
+The result will be that C<@nums> contains C<(1, 95, 2)>. Note that
+C<multi_file_search()> tries to do the right thing by only parsing the file
+until all of the regular expressions have been matched. Thus, a large file
+with the values you need near the top can be parsed very quickly.
+
+As with C<search_file()>, C<multi_search_file()> can take regular expressions
+that match multiple values. These will be returned as array references. For
+example, say the file you're parsing has files like this:
+
+ FooApp Version 4
+ Subversion 2, Microversion 6
+
+To get all of the version numbers, you can either use three regular
+expressions, as in the previous example:
+
+ my @regexen = ( qr/FooApp\s+Version\s+(\d+)$/,
+ qr/Subversion\s+(\d+),/,
+ qr/Microversion\s+(\d$)$/ );
+
+ my @nums = $file->multi_search_file($file, @regexen);
+
+In which case C<@nums> will contain C<(4, 2, 6)>. Or, you can use just two
+regular expressions:
+
+ my @regexen = ( qr/FooApp\s+Version\s+(\d+)$/,
+ qr/Subversion\s+(\d+),\s+Microversion\s+(\d$)$/ );
+
+ my @nums = $file->multi_search_file($file, @regexen);
+
+In which case C<@nums> will contain C<(4, [2, 6])>. Note that the two
+parentheses that return values in the second regular expression cause the
+matches to be returned as an array reference.
+
+=cut
+
+sub multi_search_file {
+ my ($self, $file, @regexen) = @_;
+ return unless $file && @regexen;
+ my @each = @regexen;
+ open F, "<$file" or Carp::croak "Cannot open $file: $!\n";
+ my %ret;
+ while (my $line = <F>) {
+ my @splice;
+ # Process each of the regular expresssions.
+ for (my $i = 0; $i < @each; $i++) {
+ if ((my @ret) = $line =~ /$each[$i]/) {
+ # We have a match! If there's one match returned, just grab
+ # it. If there's more than one, keep it as an array ref.
+ $ret{$each[$i]} = $#ret > 0 ? \@ret : $ret[0];
+ # We got values for this regex, so not its place in the @each
+ # array.
+ push @splice, $i;
+ }
+ }
+ # Remove any regexen that have already found a match.
+ for (@splice) { splice @each, $_, 1 }
+ # If there are no more regexes, we're done -- no need to keep
+ # processing lines in the file!
+ last unless @each;
+ }
+ close F;
+ return unless %ret;
+ return wantarray ? @ret{@regexen} : \@ret{@regexen};
+}
+
+1;
+__END__
+
+=head1 BUGS
+
+Report all bugs via the CPAN Request Tracker at
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.
+
+=head1 AUTHOR
+
+David Wheeler <L<david@wheeler.net|"david@wheeler.net">>
+
+=head1 SEE ALSO
+
+L<App::Info|App::Info>, L<File::Spec|File::Spec>,
+L<App::Info::HTTPD::Apache|App::Info::HTTPD::Apache>
+L<App::Info::RDBMS::PostgreSQL|App::Info::RDBMS::PostgreSQL>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2002, David Wheeler. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut
--- /dev/null
+Revision history for Perl extension DBIx::DBSchema.
+
+0.23 Mon Feb 16 17:35:54 PST 2004
+ - Update Pg dependancy to 1.32
+ - Update the simple load test so it skips DBIx::DBSchema::DBD::Pg if
+ DBD::Pg 1.32 is not installed.
+
+0.22 Thu Oct 23 15:18:21 PDT 2003
+ - Pg reverse-engineering fix: varchar with no limit
+ - Pg needs (unreleased) DBD::Pg 1.30 (or deb 1.22-2... interesting)
+
+0.21 Thu Sep 19 05:04:18 PDT 2002
+ - Pg reverse-engineering fix: now sets default
+
+0.20 Mon Mar 4 04:58:34 2002
+ - documentation updates
+ - fix Column->new when using named params
+ - fix Pg driver reverse-engineering length of numeric columns:
+ translate 655362 to 10,2, etc.
+ - fix Pg driver reverse-engineering of text columns (don't have a
+ length)
+
+0.19 Tue Oct 23 08:49:12 2001
+ - documentation for %typemap
+ - preliminary Sybase driver from Charles Shapiro
+ <charles.shapiro@numethods.com> and Mitchell J. Friedman
+ <mitchell.friedman@numethods.com>.
+ - Fix Column::line to return a scalar as documented, not a list.
+ - Should finally eliminate the Use of uninitialized value at
+ ... DBIx/DBSchema/Column.pm line 251
+
+0.18 Fri Aug 10 17:07:28 2001
+ - Added Table::delcolumn
+ - patch from Charles Shapiro <cshapiro@numethods.com> to add
+ `ORDER BY a.attnum' to the SQL in DBIx::DBSchema::DBD::Pg::columns
+
+0.17 Sat Jul 7 17:55:33 2001
+ - Rework Table->new interface for named params
+ - Fixes for Pg blobs, yay!
+ - MySQL doesn't need non-standard index syntax anymore (since 3.22).
+ - patch from Mark Ethan Trostler <mark@zzo.com> for generating
+ tables without indices.
+
+0.16 Fri Jan 5 15:55:50 2001
+ - Don't overflow index names.
+
+0.15 Fri Nov 24 23:39:16 2000
+ - MySQL handling of BOOL type (change to TINYINT)
+
+0.14 Tue Oct 24 14:43:16 2000
+ - MySQL handling of SERIAL type (change to INTEGER AUTO_INCREMENT)
+
+0.13 Wed Oct 11 10:47:13 2000
+ - fixed up type mapping foo, added default values, added named
+ parameters to Column->new, fixed quoting of default values
+
+0.11 Sun Sep 28 02:16:25 2000
+ - oops, original verison got 0.10, so this one will get 0.11
+
+0.01 Sun Sep 17 07:57:35 2000
+ - original version; created by h2xs 1.19
+
--- /dev/null
+package DBIx::DBSchema;
+
+use strict;
+use vars qw(@ISA $VERSION);
+#use Exporter;
+use Carp qw(confess);
+use DBI;
+use FreezeThaw qw(freeze thaw cmpStr);
+use DBIx::DBSchema::Table;
+use DBIx::DBSchema::Column;
+use DBIx::DBSchema::ColGroup::Unique;
+use DBIx::DBSchema::ColGroup::Index;
+
+#@ISA = qw(Exporter);
+@ISA = ();
+
+$VERSION = "0.23";
+
+=head1 NAME
+
+DBIx::DBSchema - Database-independent schema objects
+
+=head1 SYNOPSIS
+
+ use DBIx::DBSchema;
+
+ $schema = new DBIx::DBSchema @dbix_dbschema_table_objects;
+ $schema = new_odbc DBIx::DBSchema $dbh;
+ $schema = new_odbc DBIx::DBSchema $dsn, $user, $pass;
+ $schema = new_native DBIx::DBSchema $dbh;
+ $schema = new_native DBIx::DBSchema $dsn, $user, $pass;
+
+ $schema->save("filename");
+ $schema = load DBIx::DBSchema "filename";
+
+ $schema->addtable($dbix_dbschema_table_object);
+
+ @table_names = $schema->tables;
+
+ $DBIx_DBSchema_table_object = $schema->table("table_name");
+
+ @sql = $schema->sql($dbh);
+ @sql = $schema->sql($dsn, $username, $password);
+ @sql = $schema->sql($dsn); #doesn't connect to database - less reliable
+
+ $perl_code = $schema->pretty_print;
+ %hash = eval $perl_code;
+ use DBI qw(:sql_types); $schema = pretty_read DBIx::DBSchema \%hash;
+
+=head1 DESCRIPTION
+
+DBIx::DBSchema objects are collections of DBIx::DBSchema::Table objects and
+represent a database schema.
+
+This module implements an OO-interface to database schemas. Using this module,
+you can create a database schema with an OO Perl interface. You can read the
+schema from an existing database. You can save the schema to disk and restore
+it a different process. Most importantly, DBIx::DBSchema can write SQL
+CREATE statements statements for different databases from a single source.
+
+Currently supported databases are MySQL and PostgreSQL. Sybase support is
+partially implemented. DBIx::DBSchema will attempt to use generic SQL syntax
+for other databases. Assistance adding support for other databases is
+welcomed. See L<DBIx::DBSchema::DBD>, "Driver Writer's Guide and Base Class".
+
+=head1 METHODS
+
+=over 4
+
+=item new TABLE_OBJECT, TABLE_OBJECT, ...
+
+Creates a new DBIx::DBSchema object.
+
+=cut
+
+sub new {
+ my($proto, @tables) = @_;
+ my %tables = map { $_->name, $_ } @tables; #check for duplicates?
+
+ my $class = ref($proto) || $proto;
+ my $self = {
+ 'tables' => \%tables,
+ };
+
+ bless ($self, $class);
+
+}
+
+=item new_odbc DATABASE_HANDLE | DATA_SOURCE USERNAME PASSWORD [ ATTR ]
+
+Creates a new DBIx::DBSchema object from an existing data source, which can be
+specified by passing an open DBI database handle, or by passing the DBI data
+source name, username, and password. This uses the experimental DBI type_info
+method to create a schema with standard (ODBC) SQL column types that most
+closely correspond to any non-portable column types. Use this to import a
+schema that you wish to use with many different database engines. Although
+primary key and (unique) index information will only be read from databases
+with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
+column names and attributes *should* work for any database. Note that this
+method only uses "ODBC" column types; it does not require or use an ODBC
+driver.
+
+=cut
+
+sub new_odbc {
+ my($proto, $dbh) = (shift, shift);
+ $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr unless ref($dbh);
+ $proto->new(
+ map { new_odbc DBIx::DBSchema::Table $dbh, $_ } _tables_from_dbh($dbh)
+ );
+}
+
+=item new_native DATABASE_HANDLE | DATA_SOURCE USERNAME PASSWORD [ ATTR ]
+
+Creates a new DBIx::DBSchema object from an existing data source, which can be
+specified by passing an open DBI database handle, or by passing the DBI data
+source name, username and password. This uses database-native methods to read
+the schema, and will preserve any non-portable column types. The method is
+only available if there is a DBIx::DBSchema::DBD for the corresponding database engine (currently, MySQL and PostgreSQL).
+
+=cut
+
+sub new_native {
+ my($proto, $dbh) = (shift, shift);
+ $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr unless ref($dbh);
+ $proto->new(
+ map { new_native DBIx::DBSchema::Table ( $dbh, $_ ) } _tables_from_dbh($dbh)
+ );
+}
+
+=item load FILENAME
+
+Loads a DBIx::DBSchema object from a file.
+
+=cut
+
+sub load {
+ my($proto,$file)=@_; #use $proto ?
+ open(FILE,"<$file") or die "Can't open $file: $!";
+ my($string)=join('',<FILE>); #can $string have newlines? pry not?
+ close FILE or die "Can't close $file: $!";
+ my($self)=thaw $string;
+ #no bless needed?
+ $self;
+}
+
+=item save FILENAME
+
+Saves a DBIx::DBSchema object to a file.
+
+=cut
+
+sub save {
+ my($self,$file)=@_;
+ my($string)=freeze $self;
+ open(FILE,">$file") or die "Can't open $file: $!";
+ print FILE $string;
+ close FILE or die "Can't close file: $!";
+ my($check_self)=thaw $string;
+ die "Verify error: Can't freeze and thaw dbdef $self"
+ if (cmpStr($self,$check_self));
+}
+
+=item addtable TABLE_OBJECT
+
+Adds the given DBIx::DBSchema::Table object to this DBIx::DBSchema.
+
+=cut
+
+sub addtable {
+ my($self,$table)=@_;
+ $self->{'tables'}->{$table->name} = $table; #check for dupliates?
+}
+
+=item tables
+
+Returns a list of the names of all tables.
+
+=cut
+
+sub tables {
+ my($self)=@_;
+ keys %{$self->{'tables'}};
+}
+
+=item table TABLENAME
+
+Returns the specified DBIx::DBSchema::Table object.
+
+=cut
+
+sub table {
+ my($self,$table)=@_;
+ $self->{'tables'}->{$table};
+}
+
+=item sql [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+
+Returns a list of SQL `CREATE' statements for this schema.
+
+The data source can be specified by passing an open DBI database handle, or by
+passing the DBI data source name, username and password.
+
+Although the username and password are optional, it is best to call this method
+with a database handle or data source including a valid username and password -
+a DBI connection will be opened and the quoting and type mapping will be more
+reliable.
+
+If passed a DBI data source (or handle) such as `DBI:mysql:database' or
+`DBI:Pg:dbname=database', will use syntax specific to that database engine.
+Currently supported databases are MySQL and PostgreSQL.
+
+If not passed a data source (or handle), or if there is no driver for the
+specified database, will attempt to use generic SQL syntax.
+
+=cut
+
+sub sql {
+ my($self, $dbh) = (shift, shift);
+ my $created_dbh = 0;
+ unless ( ref($dbh) || ! @_ ) {
+ $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
+ $created_dbh = 1;
+ }
+ my @r = map { $self->table($_)->sql_create_table($dbh); } $self->tables;
+ $dbh->disconnect if $created_dbh;
+ @r;
+}
+
+=item pretty_print
+
+Returns the data in this schema as Perl source, suitable for assigning to a
+hash.
+
+=cut
+
+sub pretty_print {
+ my($self) = @_;
+ join("},\n\n",
+ map {
+ my $table = $_;
+ "'$table' => {\n".
+ " 'columns' => [\n".
+ join("", map {
+ #cant because -w complains about , in qw()
+ # (also biiiig problems with empty lengths)
+ #" qw( $_ ".
+ #$self->table($table)->column($_)->type. " ".
+ #( $self->table($table)->column($_)->null ? 'NULL' : 0 ). " ".
+ #$self->table($table)->column($_)->length. " ),\n"
+ " '$_', ".
+ "'". $self->table($table)->column($_)->type. "', ".
+ "'". $self->table($table)->column($_)->null. "', ".
+ "'". $self->table($table)->column($_)->length. "', ".
+ "'". $self->table($table)->column($_)->default. "', ".
+ "'". $self->table($table)->column($_)->local. "',\n"
+ } $self->table($table)->columns
+ ).
+ " ],\n".
+ " 'primary_key' => '". $self->table($table)->primary_key. "',\n".
+ " 'unique' => [ ". join(', ',
+ map { "[ '". join("', '", @{$_}). "' ]" }
+ @{$self->table($table)->unique->lol_ref}
+ ). " ],\n".
+ " 'index' => [ ". join(', ',
+ map { "[ '". join("', '", @{$_}). "' ]" }
+ @{$self->table($table)->index->lol_ref}
+ ). " ],\n"
+ #" 'index' => [ ". " ],\n"
+ } $self->tables
+ ), "}\n";
+}
+
+=cut
+
+=item pretty_read HASHREF
+
+Creates a schema as specified by a data structure such as that created by
+B<pretty_print> method.
+
+=cut
+
+sub pretty_read {
+ my($proto, $href) = @_;
+ my $schema = $proto->new( map {
+ my(@columns);
+ while ( @{$href->{$_}{'columns'}} ) {
+ push @columns, DBIx::DBSchema::Column->new(
+ splice @{$href->{$_}{'columns'}}, 0, 6
+ );
+ }
+ DBIx::DBSchema::Table->new(
+ $_,
+ $href->{$_}{'primary_key'},
+ DBIx::DBSchema::ColGroup::Unique->new($href->{$_}{'unique'}),
+ DBIx::DBSchema::ColGroup::Index->new($href->{$_}{'index'}),
+ @columns,
+ );
+ } (keys %{$href}) );
+}
+
+# private subroutines
+
+sub _load_driver {
+ my($dbh) = @_;
+ my $driver;
+ if ( ref($dbh) ) {
+ $driver = $dbh->{Driver}->{Name};
+ } else {
+ $dbh =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect
+ or '' =~ /()/; # ensure $1 etc are empty if match fails
+ $driver = $1 or confess "can't parse data source: $dbh";
+ }
+
+ #require "DBIx/DBSchema/DBD/$driver.pm";
+ #$driver;
+ eval 'require "DBIx/DBSchema/DBD/$driver.pm"' and $driver or die $@;
+}
+
+sub _tables_from_dbh {
+ my($dbh) = @_;
+ my $sth = $dbh->table_info or die $dbh->errstr;
+ #map { $_->{TABLE_NAME} } grep { $_->{TABLE_TYPE} eq 'TABLE' }
+ # @{ $sth->fetchall_arrayref({ TABLE_NAME=>1, TABLE_TYPE=>1}) };
+ map { $_->[0] } grep { $_->[1] =~ /^TABLE$/i }
+ @{ $sth->fetchall_arrayref([2,3]) };
+}
+
+=back
+
+=head1 AUTHOR
+
+Ivan Kohler <ivan-dbix-dbschema@420.am>
+
+Charles Shapiro <charles.shapiro@numethods.com> and Mitchell Friedman
+<mitchell.friedman@numethods.com> contributed the start of a Sybase driver.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000 Ivan Kohler
+Copyright (c) 2000 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+Each DBIx::DBSchema object should have a name which corresponds to its name
+within the SQL database engine (DBI data source).
+
+pretty_print is actually pretty ugly.
+
+Perhaps pretty_read should eval column types so that we can use DBI
+qw(:sql_types) here instead of externally.
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::ColGroup>,
+L<DBIx::DBSchema::ColGroup::Unique>, L<DBIx::DBSchema::ColGroup::Index>,
+L<DBIx::DBSchema::Column>, L<DBIx::DBSchema::DBD>,
+L<DBIx::DBSchema::DBD::mysql>, L<DBIx::DBSchema::DBD::Pg>, L<FS::Record>,
+L<DBI>
+
+=cut
+
+1;
+
--- /dev/null
+package DBIx::DBSchema::ColGroup;
+
+use strict;
+use vars qw(@ISA);
+#use Exporter;
+
+#@ISA = qw(Exporter);
+@ISA = qw();
+
+=head1 NAME
+
+DBIx::DBSchema::ColGroup - Column group objects
+
+=head1 SYNOPSIS
+
+ use DBIx::DBSchema::ColGroup;
+
+ $colgroup = new DBIx::DBSchema::ColGroup ( $lol_ref );
+ $colgroup = new DBIx::DBSchema::ColGroup ( \@lol );
+ $colgroup = new DBIx::DBSchema::ColGroup (
+ [
+ [ 'single_column' ],
+ [ 'multiple_columns', 'another_column', ],
+ ]
+ );
+
+ $lol_ref = $colgroup->lol_ref;
+
+ @sql_lists = $colgroup->sql_list;
+
+ @singles = $colgroup->singles;
+
+=head1 DESCRIPTION
+
+DBIx::DBSchema::ColGroup objects represent sets of sets of columns. (IOW a
+"list of lists" - see L<perllol>.)
+
+=head1 METHODS
+
+=over 4
+
+=item new [ LOL_REF ]
+
+Creates a new DBIx::DBSchema::ColGroup object. Pass a reference to a list of
+lists of column names.
+
+=cut
+
+sub new {
+ my($proto, $lol) = @_;
+
+ my $class = ref($proto) || $proto;
+ my $self = {
+ 'lol' => $lol,
+ };
+
+ bless ($self, $class);
+
+}
+
+=item lol_ref
+
+Returns a reference to a list of lists of column names.
+
+=cut
+
+sub lol_ref {
+ my($self) = @_;
+ $self->{'lol'};
+}
+
+=item sql_list
+
+Returns a flat list of comma-separated values, for SQL statements.
+
+For example:
+
+ @lol = (
+ [ 'single_column' ],
+ [ 'multiple_columns', 'another_column', ],
+ );
+
+ $colgroup = new DBIx::DBSchema::ColGroup ( \@lol );
+
+ print join("\n", $colgroup->sql_list), "\n";
+
+Will print:
+
+ single_column
+ multiple_columns, another_column
+
+=cut
+
+sub sql_list { #returns a flat list of comman-separates lists (for sql)
+ my($self)=@_;
+ grep $_ ne '', map join(', ', @{$_}), @{$self->{'lol'}};
+}
+
+=item singles
+
+Returns a flat list of all single item lists.
+
+=cut
+
+sub singles { #returns single-field groups as a flat list
+ my($self)=@_;
+ #map ${$_}[0], grep scalar(@{$_}) == 1, @{$self->{'lol'}};
+ map {
+ ${$_}[0] =~ /^(\w+)$/
+ #aah!
+ or die "Illegal column ", ${$_}[0], " in colgroup!";
+ $1;
+ } grep scalar(@{$_}) == 1, @{$self->{'lol'}};
+}
+
+=back
+
+=head1 AUTHOR
+
+Ivan Kohler <ivan-dbix-dbschema@420.am>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000 Ivan Kohler
+Copyright (c) 2000 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::ColGroup::Unique>,
+L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema>, L<perllol>, L<perldsc>,
+L<DBI>
+
+=cut
+
+1;
+
--- /dev/null
+package DBIx::DBSchema::Column;
+
+use strict;
+use vars qw(@ISA $VERSION);
+#use Carp;
+#use Exporter;
+
+#@ISA = qw(Exporter);
+@ISA = qw();
+
+$VERSION = '0.02';
+
+=head1 NAME
+
+DBIx::DBSchema::Column - Column objects
+
+=head1 SYNOPSIS
+
+ use DBIx::DBSchema::Column;
+
+ #named params with a hashref (preferred)
+ $column = new DBIx::DBSchema::Column ( {
+ 'name' => 'column_name',
+ 'type' => 'varchar'
+ 'null' => 'NOT NULL',
+ 'length' => 64,
+ 'default' => '
+ 'local' => '',
+ } );
+
+ #list
+ $column = new DBIx::DBSchema::Column ( $name, $sql_type, $nullability, $length, $default, $local );
+
+ $name = $column->name;
+ $column->name( 'name' );
+
+ $sql_type = $column->type;
+ $column->type( 'sql_type' );
+
+ $null = $column->null;
+ $column->null( 'NULL' );
+ $column->null( 'NOT NULL' );
+ $column->null( '' );
+
+ $length = $column->length;
+ $column->length( '10' );
+ $column->length( '8,2' );
+
+ $default = $column->default;
+ $column->default( 'Roo' );
+
+ $sql_line = $column->line;
+ $sql_line = $column->line($datasrc);
+
+=head1 DESCRIPTION
+
+DBIx::DBSchema::Column objects represent columns in tables (see
+L<DBIx::DBSchema::Table>).
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+=item new [ name [ , type [ , null [ , length [ , default [ , local ] ] ] ] ] ]
+
+Creates a new DBIx::DBSchema::Column object. Takes a hashref of named
+parameters, or a list. B<name> is the name of the column. B<type> is the SQL
+data type. B<null> is the nullability of the column (intrepreted using Perl's
+rules for truth, with one exception: `NOT NULL' is false). B<length> is the
+SQL length of the column. B<default> is the default value of the column.
+B<local> is reserved for database-specific information.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self;
+ if ( ref($_[0]) ) {
+ $self = shift;
+ } else {
+ $self = { map { $_ => shift } qw(name type null length default local) };
+ }
+
+ #croak "Illegal name: ". $self->{'name'}
+ # if grep $self->{'name'} eq $_, @reserved_words;
+
+ $self->{'null'} =~ s/^NOT NULL$//i;
+ $self->{'null'} = 'NULL' if $self->{'null'};
+
+ bless ($self, $class);
+
+}
+
+=item name [ NAME ]
+
+Returns or sets the column name.
+
+=cut
+
+sub name {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
+ $self->{'name'} = $value;
+ } else {
+ $self->{'name'};
+ }
+}
+
+=item type [ TYPE ]
+
+Returns or sets the column type.
+
+=cut
+
+sub type {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'type'} = $value;
+ } else {
+ $self->{'type'};
+ }
+}
+
+=item null [ NULL ]
+
+Returns or sets the column null flag (the empty string is equivalent to
+`NOT NULL')
+
+=cut
+
+sub null {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $value =~ s/^NOT NULL$//i;
+ $value = 'NULL' if $value;
+ $self->{'null'} = $value;
+ } else {
+ $self->{'null'};
+ }
+}
+
+=item length [ LENGTH ]
+
+Returns or sets the column length.
+
+=cut
+
+sub length {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'length'} = $value;
+ } else {
+ $self->{'length'};
+ }
+}
+
+=item default [ LOCAL ]
+
+Returns or sets the default value.
+
+=cut
+
+sub default {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'default'} = $value;
+ } else {
+ $self->{'default'};
+ }
+}
+
+
+=item local [ LOCAL ]
+
+Returns or sets the database-specific field.
+
+=cut
+
+sub local {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'local'} = $value;
+ } else {
+ $self->{'local'};
+ }
+}
+
+=item line [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+
+Returns an SQL column definition.
+
+The data source can be specified by passing an open DBI database handle, or by
+passing the DBI data source name, username and password.
+
+Although the username and password are optional, it is best to call this method
+with a database handle or data source including a valid username and password -
+a DBI connection will be opened and the quoting and type mapping will be more
+reliable.
+
+If passed a DBI data source (or handle) such as `DBI:mysql:database' or
+`DBI:Pg:dbname=database', will use syntax specific to that database engine.
+Currently supported databases are MySQL and PostgreSQL. Non-standard syntax
+for other engines (if applicable) may also be supported in the future.
+
+=cut
+
+sub line {
+ my($self,$dbh) = (shift, shift);
+
+ my $created_dbh = 0;
+ unless ( ref($dbh) || ! @_ ) {
+ $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
+ my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
+ $created_dbh = 1;
+ }
+
+ my $driver = DBIx::DBSchema::_load_driver($dbh);
+ my %typemap;
+ %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap" if $driver;
+ my $type = defined( $typemap{uc($self->type)} )
+ ? $typemap{uc($self->type)}
+ : $self->type;
+
+ my $null = $self->null;
+
+ my $default;
+ if ( defined($self->default) && $self->default ne ''
+ && ref($dbh)
+ # false laziness: nicked from FS::Record::_quote
+ && ( $self->default !~ /^\-?\d+(\.\d+)?$/
+ || $type =~ /(char|binary|blob|text)$/i
+ )
+ ) {
+ $default = $dbh->quote($self->default);
+ } else {
+ $default = $self->default;
+ }
+
+ #this should be a callback into the driver
+ if ( $driver eq 'mysql' ) { #yucky mysql hack
+ $null ||= "NOT NULL";
+ $self->local('AUTO_INCREMENT') if uc($self->type) eq 'SERIAL';
+ } elsif ( $driver eq 'Pg' ) { #yucky Pg hack
+ $null ||= "NOT NULL";
+ $null =~ s/^NULL$//;
+ }
+
+ my $r = join(' ',
+ $self->name,
+ $type. ( ( defined($self->length) && $self->length )
+ ? '('.$self->length.')'
+ : ''
+ ),
+ $null,
+ ( ( defined($default) && $default ne '' )
+ ? 'DEFAULT '. $default
+ : ''
+ ),
+ ( ( $driver eq 'mysql' && defined($self->local) )
+ ? $self->local
+ : ''
+ ),
+ );
+ $dbh->disconnect if $created_dbh;
+ $r;
+
+}
+
+=back
+
+=head1 AUTHOR
+
+Ivan Kohler <ivan-dbix-dbschema@420.am>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000 Ivan Kohler
+Copyright (c) 2000 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+line() has database-specific foo that probably ought to be abstracted into
+the DBIx::DBSchema:DBD:: modules.
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>
+
+=cut
+
+1;
+
--- /dev/null
+package DBIx::DBSchema::DBD;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = '0.02';
+
+=head1 NAME
+
+DBIx::DBSchema::DBD - DBIx::DBSchema Driver Writer's Guide and Base Class
+
+=head1 SYNOPSIS
+
+ perldoc DBIx::DBSchema::DBD
+
+ package DBIx::DBSchema::DBD::FooBase
+ use DBIx::DBSchmea::DBD;
+ @ISA = qw(DBIx::DBSchema::DBD);
+
+=head1 DESCRIPTION
+
+Drivers should be named DBIx::DBSchema::DBD::DatabaseName, where DatabaseName
+is the same as the DBD:: driver for this database. Drivers should implement the
+following class methods:
+
+=over 4
+
+=item columns CLASS DBI_DBH TABLE
+
+Given an active DBI database handle, return a listref of listrefs (see
+L<perllol>), each containing six elements: column name, column type,
+nullability, column length, column default, and a field reserved for
+driver-specific use.
+
+=item column CLASS DBI_DBH TABLE COLUMN
+
+Same as B<columns> above, except return the listref for a single column. You
+can inherit from DBIx::DBSchema::DBD to provide this function.
+
+=cut
+
+sub column {
+ my($proto, $dbh, $table, $column) = @_;
+ #@a = grep { $_->[0] eq $column } @{ $proto->columns( $dbh, $table ) };
+ #$a[0];
+ @{ [
+ grep { $_->[0] eq $column } @{ $proto->columns( $dbh, $table ) }
+ ] }[0]; #force list context on grep, return scalar of first element
+}
+
+=item primary_key CLASS DBI_DBH TABLE
+
+Given an active DBI database handle, return the primary key for the specified
+table.
+
+=item unique CLASS DBI_DBH TABLE
+
+Given an active DBI database handle, return a hashref of unique indices. The
+keys of the hashref are index names, and the values are arrayrefs which point
+a list of column names for each. See L<perldsc/"HASHES OF LISTS"> and
+L<DBIx::DBSchema::ColGroup>.
+
+=item index CLASS DBI_DBH TABLE
+
+Given an active DBI database handle, return a hashref of (non-unique) indices.
+The keys of the hashref are index names, and the values are arrayrefs which
+point a list of column names for each. See L<perldsc/"HASHES OF LISTS"> and
+L<DBIx::DBSchema::ColGroup>.
+
+=back
+
+=head1 TYPE MAPPING
+
+You can define a %typemap array for your driver to map "standard" data
+types to database-specific types. For example, the MySQL TIMESTAMP field
+has non-standard auto-updating semantics; the MySQL DATETIME type is
+what other databases and the ODBC standard call TIMESTAMP, so one of the
+entries in the MySQL %typemap is:
+
+ 'TIMESTAMP' => 'DATETIME',
+
+Another example is the Pg %typemap which maps the standard types BLOB and
+LONG VARBINARY to the Pg-specific BYTEA:
+
+ 'BLOB' => 'BYTEA',
+ 'LONG VARBINARY' => 'BYTEA',
+
+Make sure you use all uppercase-keys.
+
+=head1 AUTHOR
+
+Ivan Kohler <ivan-dbix-dbschema@420.am>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000 Ivan Kohler
+Copyright (c) 2000 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD::mysql>, L<DBIx::DBSchema::DBD::Pg>,
+L<DBIx::DBSchema::ColGroup>, L<DBI>, L<DBI::DBD>, L<perllol>,
+L<perldsc/"HASHES OF LISTS">
+
+=cut
+
+1;
+
--- /dev/null
+package DBIx::DBSchema::Table;
+
+use strict;
+use vars qw(@ISA %create_params);
+#use Carp;
+#use Exporter;
+use DBIx::DBSchema::Column 0.02;
+use DBIx::DBSchema::ColGroup::Unique;
+use DBIx::DBSchema::ColGroup::Index;
+
+#@ISA = qw(Exporter);
+@ISA = qw();
+
+=head1 NAME
+
+DBIx::DBSchema::Table - Table objects
+
+=head1 SYNOPSIS
+
+ use DBIx::DBSchema::Table;
+
+ #old style (depriciated)
+ $table = new DBIx::DBSchema::Table (
+ "table_name",
+ "primary_key",
+ $dbix_dbschema_colgroup_unique_object,
+ $dbix_dbschema_colgroup_index_object,
+ @dbix_dbschema_column_objects,
+ );
+
+ #new style (preferred), pass a hashref of parameters
+ $table = new DBIx::DBSchema::Table (
+ {
+ name => "table_name",
+ primary_key => "primary_key",
+ unique => $dbix_dbschema_colgroup_unique_object,
+ 'index' => $dbix_dbschema_colgroup_index_object,
+ columns => \@dbix_dbschema_column_objects,
+ }
+ );
+
+ $table->addcolumn ( $dbix_dbschema_column_object );
+
+ $table_name = $table->name;
+ $table->name("table_name");
+
+ $primary_key = $table->primary_key;
+ $table->primary_key("primary_key");
+
+ $dbix_dbschema_colgroup_unique_object = $table->unique;
+ $table->unique( $dbix_dbschema__colgroup_unique_object );
+
+ $dbix_dbschema_colgroup_index_object = $table->index;
+ $table->index( $dbix_dbschema_colgroup_index_object );
+
+ @column_names = $table->columns;
+
+ $dbix_dbschema_column_object = $table->column("column");
+
+ #preferred
+ @sql_statements = $table->sql_create_table( $dbh );
+ @sql_statements = $table->sql_create_table( $datasrc, $username, $password );
+
+ #possible problems
+ @sql_statements = $table->sql_create_table( $datasrc );
+ @sql_statements = $table->sql_create_table;
+
+=head1 DESCRIPTION
+
+DBIx::DBSchema::Table objects represent a single database table.
+
+=head1 METHODS
+
+=over 4
+
+=item new [ TABLE_NAME [ , PRIMARY_KEY [ , UNIQUE [ , INDEX [ , COLUMN... ] ] ] ] ]
+
+=item new HASHREF
+
+Creates a new DBIx::DBSchema::Table object. The preferred usage is to pass a
+hash reference of named parameters.
+
+ {
+ name => TABLE_NAME,
+ primary_key => PRIMARY_KEY,
+ unique => UNIQUE,
+ 'index' => INDEX,
+ columns => COLUMNS
+ }
+
+TABLE_NAME is the name of the table. PRIMARY_KEY is the primary key (may be
+empty). UNIQUE is a DBIx::DBSchema::ColGroup::Unique object (see
+L<DBIx::DBSchema::ColGroup::Unique>). INDEX is a
+DBIx::DBSchema::ColGroup::Index object (see
+L<DBIx::DBSchema::ColGroup::Index>). COLUMNS is a reference to an array of
+DBIx::DBSchema::Column objects (see L<DBIx::DBSchema::Column>).
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self;
+ if ( ref($_[0]) ) {
+
+ $self = shift;
+ $self->{column_order} = [ map { $_->name } @{$self->{columns}} ];
+ $self->{columns} = { map { $_->name, $_ } @{$self->{columns}} };
+
+ } else {
+
+ my($name,$primary_key,$unique,$index,@columns) = @_;
+
+ my %columns = map { $_->name, $_ } @columns;
+ my @column_order = map { $_->name } @columns;
+
+ $self = {
+ 'name' => $name,
+ 'primary_key' => $primary_key,
+ 'unique' => $unique,
+ 'index' => $index,
+ 'columns' => \%columns,
+ 'column_order' => \@column_order,
+ };
+
+ }
+
+ #check $primary_key, $unique and $index to make sure they are $columns ?
+ # (and sanity check?)
+
+ bless ($self, $class);
+
+}
+
+=item new_odbc DATABASE_HANDLE TABLE_NAME
+
+Creates a new DBIx::DBSchema::Table object from the supplied DBI database
+handle for the specified table. This uses the experimental DBI type_info
+method to create a table with standard (ODBC) SQL column types that most
+closely correspond to any non-portable column types. Use this to import a
+schema that you wish to use with many different database engines. Although
+primary key and (unique) index information will only be imported from databases
+with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
+column names and attributes *should* work for any database.
+
+Note: the _odbc refers to the column types used and nothing else - you do not
+have to have ODBC installed or connect to the database via ODBC.
+
+=cut
+
+%create_params = (
+# undef => sub { '' },
+ '' => sub { '' },
+ 'max length' => sub { $_[0]->{PRECISION}->[$_[1]]; },
+ 'precision,scale' =>
+ sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
+);
+
+sub new_odbc {
+ my( $proto, $dbh, $name) = @_;
+ my $driver = DBIx::DBSchema::_load_driver($dbh);
+ my $sth = _null_sth($dbh, $name);
+ my $sthpos = 0;
+ $proto->new (
+ $name,
+ scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
+ DBIx::DBSchema::ColGroup::Unique->new(
+ $driver
+ ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
+ : []
+ ),
+ DBIx::DBSchema::ColGroup::Index->new(
+ $driver
+ ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
+ : []
+ ),
+ map {
+ my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
+ or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
+ "returned no results for type ". $sth->{TYPE}->[$sthpos];
+ new DBIx::DBSchema::Column
+ $_,
+ $type_info->{'TYPE_NAME'},
+ #"SQL_". uc($type_info->{'TYPE_NAME'}),
+ $sth->{NULLABLE}->[$sthpos],
+ &{ $create_params{ $type_info->{CREATE_PARAMS} } }( $sth, $sthpos++ ), $driver && #default
+ ${ [
+ eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
+ ] }[4]
+ # DB-local
+ } @{$sth->{NAME}}
+ );
+}
+
+=item new_native DATABASE_HANDLE TABLE_NAME
+
+Creates a new DBIx::DBSchema::Table object from the supplied DBI database
+handle for the specified table. This uses database-native methods to read the
+schema, and will preserve any non-portable column types. The method is only
+available if there is a DBIx::DBSchema::DBD for the corresponding database
+engine (currently, MySQL and PostgreSQL).
+
+=cut
+
+sub new_native {
+ my( $proto, $dbh, $name) = @_;
+ my $driver = DBIx::DBSchema::_load_driver($dbh);
+ $proto->new (
+ $name,
+ scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
+ DBIx::DBSchema::ColGroup::Unique->new(
+ [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ]
+ ),
+ DBIx::DBSchema::ColGroup::Index->new(
+ [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
+ ),
+ map {
+ DBIx::DBSchema::Column->new( @{$_} )
+ } eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
+ );
+}
+
+=item addcolumn COLUMN
+
+Adds this DBIx::DBSchema::Column object.
+
+=cut
+
+sub addcolumn {
+ my($self,$column)=@_;
+ ${$self->{'columns'}}{$column->name}=$column; #sanity check?
+ push @{$self->{'column_order'}}, $column->name;
+}
+
+=item delcolumn COLUMN_NAME
+
+Deletes this column. Returns false if no column of this name was found to
+remove, true otherwise.
+
+=cut
+
+sub delcolumn {
+ my($self,$column) = @_;
+ return 0 unless exists $self->{'columns'}{$column};
+ delete $self->{'columns'}{$column};
+ @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}}; 1;
+}
+
+=item name [ TABLE_NAME ]
+
+Returns or sets the table name.
+
+=cut
+
+sub name {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{name} = $value;
+ } else {
+ $self->{name};
+ }
+}
+
+=item primary_key [ PRIMARY_KEY ]
+
+Returns or sets the primary key.
+
+=cut
+
+sub primary_key {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{primary_key} = $value;
+ } else {
+ #$self->{primary_key};
+ #hmm. maybe should untaint the entire structure when it comes off disk
+ # cause if you don't trust that, ?
+ $self->{primary_key} =~ /^(\w*)$/
+ #aah!
+ or die "Illegal primary key: ", $self->{primary_key};
+ $1;
+ }
+}
+
+=item unique [ UNIQUE ]
+
+Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
+
+=cut
+
+sub unique {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{unique} = $value;
+ } else {
+ $self->{unique};
+ }
+}
+
+=item index [ INDEX ]
+
+Returns or sets the DBIx::DBSchema::ColGroup::Index object.
+
+=cut
+
+sub index {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'index'} = $value;
+ } else {
+ $self->{'index'};
+ }
+}
+
+=item columns
+
+Returns a list consisting of the names of all columns.
+
+=cut
+
+sub columns {
+ my($self)=@_;
+ #keys %{$self->{'columns'}};
+ #must preserve order
+ @{ $self->{'column_order'} };
+}
+
+=item column COLUMN_NAME
+
+Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
+COLUMN_NAME.
+
+=cut
+
+sub column {
+ my($self,$column)=@_;
+ $self->{'columns'}->{$column};
+}
+
+=item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+
+Returns a list of SQL statments to create this table.
+
+The data source can be specified by passing an open DBI database handle, or by
+passing the DBI data source name, username and password.
+
+Although the username and password are optional, it is best to call this method
+with a database handle or data source including a valid username and password -
+a DBI connection will be opened and the quoting and type mapping will be more
+reliable.
+
+If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
+MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
+(if applicable) may also be supported in the future.
+
+=cut
+
+sub sql_create_table {
+ my($self, $dbh) = (shift, shift);
+
+ my $created_dbh = 0;
+ unless ( ref($dbh) || ! @_ ) {
+ $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
+ my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
+ $created_dbh = 1;
+ }
+ #false laziness: nicked from DBSchema::_load_driver
+ my $driver;
+ if ( ref($dbh) ) {
+ $driver = $dbh->{Driver}->{Name};
+ } else {
+ my $discard = $dbh;
+ $discard =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect
+ or '' =~ /()/; # ensure $1 etc are empty if match fails
+ $driver = $1 or die "can't parse data source: $dbh";
+ }
+ #eofalse
+
+#should be in the DBD somehwere :/
+# my $saved_pkey = '';
+# if ( $driver eq 'Pg' && $self->primary_key ) {
+# my $pcolumn = $self->column( (
+# grep { $self->column($_)->name eq $self->primary_key } $self->columns
+# )[0] );
+##AUTO-INCREMENT# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
+# $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
+# #my $saved_pkey = $self->primary_key;
+# #$self->primary_key('');
+# #change it back afterwords :/
+# }
+
+ my @columns = map { $self->column($_)->line($dbh) } $self->columns;
+
+ push @columns, "PRIMARY KEY (". $self->primary_key. ")"
+ #if $self->primary_key && $driver ne 'Pg';
+ if $self->primary_key;
+
+ my $indexnum = 1;
+
+ my @r = (
+ "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n"
+ );
+
+ push @r, map {
+ #my($index) = $self->name. "__". $_ . "_idx";
+ #$index =~ s/,\s*/_/g;
+ my $index = $self->name. $indexnum++;
+ "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
+ } $self->unique->sql_list
+ if $self->unique;
+
+ push @r, map {
+ #my($index) = $self->name. "__". $_ . "_idx";
+ #$index =~ s/,\s*/_/g;
+ my $index = $self->name. $indexnum++;
+ "CREATE INDEX $index ON ". $self->name. " ($_)\n"
+ } $self->index->sql_list
+ if $self->index;
+
+ #$self->primary_key($saved_pkey) if $saved_pkey;
+ $dbh->disconnect if $created_dbh;
+ @r;
+}
+
+#
+
+sub _null_sth {
+ my($dbh, $table) = @_;
+ my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
+ or die $dbh->errstr;
+ $sth->execute or die $sth->errstr;
+ $sth;
+}
+
+=back
+
+=head1 AUTHOR
+
+Ivan Kohler <ivan-dbix-dbschema@420.am>
+
+Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
+with no indices.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000 Ivan Kohler
+Copyright (c) 2000 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+sql_create_table() has database-specific foo that probably ought to be
+abstracted into the DBIx::DBSchema::DBD:: modules.
+
+sql_create_table may change or destroy the object's data. If you need to use
+the object after sql_create_table, make a copy beforehand.
+
+Some of the logic in new_odbc might be better abstracted into Column.pm etc.
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
+L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>
+
+=cut
+
+1;
+
--- /dev/null
+Changes
+MANIFEST
+MANIFEST.SKIP
+README
+TODO
+Makefile.PL
+DBSchema.pm
+t/load.t
+t/load-mysql.t
+t/load-pg.t
+DBSchema/Table.pm
+DBSchema/ColGroup.pm
+DBSchema/ColGroup/Index.pm
+DBSchema/ColGroup/Unique.pm
+DBSchema/Column.pm
+DBSchema/DBD.pm
+DBSchema/DBD/mysql.pm
+DBSchema/DBD/Pg.pm
+DBSchema/DBD/Sybase.pm
--- /dev/null
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'DBIx::DBSchema',
+ 'VERSION_FROM' => 'DBSchema.pm', # finds $VERSION
+ 'PREREQ_PM' => {
+ 'DBI' => 0,
+ 'FreezeThaw' => 0,
+ },
+);
--- /dev/null
+DBIx::DBSchema
+
+Copyright (c) 2000-2002 Ivan Kohler
+Copyright (c) 2000 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+This module implements an OO-interface to database schemas. Using this module,
+you can create a database schema with an OO Perl interface. You can read the
+schema from an existing database. You can save the schema to disk and restore
+it from different process. Most importantly, DBIx::DBSchema can write SQL
+CREATE statements for different databases from a single source.
+
+Currently supported databases are MySQL, PostgreSQL and Sybase.
+DBIx::DBSchema will attempt to use generic SQL syntax for other databases.
+Assistance adding support for other databases is welcomed. See the
+DBIx::DBSchema::DBD manpage, "Driver Writer's Guide and Base Class".
+
+To install:
+ perl Makefile.PL
+ make
+ make test # nothing substantial yet
+ make install
+
+Documentation will then be available via `man DBIx::DBSchema' or
+`perldoc DBIx::DBSchema'.
+
+Anonymous CVS access is available:
+ $ export CVSROOT=":pserver:anonymous@cleanwhisker.420.am:/home/cvs/cvsroot"
+ $ cvs login
+ (Logging in to anonymous@cleanwhisker.420.am)
+ CVS password: anonymous
+ $ cvs checkout DBIx-DBSchema
+as well as <http://www.420.am/cgi-bin/cvsweb/DBIx-DBSchema>.
+
+A mailing list is available. Send a blank message to
+<ivan-dbix-dbschema-users-subscribe@420.am>.
+
+Homepage: <http://www.420.am/dbix-dbschema>
+
+$Id: README,v 1.1.2.1 2004-04-29 09:40:08 ivan Exp $
--- /dev/null
+port and test with additional databases
+
+sql CREATE TABLE output should convert integers
+(i.e. use DBI qw(:sql_types);) to local types using DBI->type_info plus a hash
+to fudge things
+
--- /dev/null
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use DBIx::DBSchema::DBD::mysql;
+$loaded = 1;
+print "ok 1\n";
--- /dev/null
+print "1..1\n";
+eval "use DBD::Pg 1.32";
+if ( length($@) ) {
+ print "ok 1 # Skipped: DBD::Pg 1.32 required for Pg";
+} else {
+ eval "use DBIx::DBSchema::DBD::Pg;";
+ if ( length($@) ) {
+ print "not ok 1\n";
+ } else {
+ print "ok 1\n";
+ }
+}
--- /dev/null
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use DBIx::DBSchema;
+$loaded = 1;
+print "ok 1\n";
#!/bin/sh
-echo "deb http://cleanwhisker.420.am/~ivan/freeside-woody/ ./" >>/etc/apt/sources.list
+echo "deb http://pouncequick.420.am/~ivan/freeside-woody/ ./" >>/etc/apt/sources.list
apt-get update
apt-get install screen zsh libapache-mod-ssl libapache-mod-perl rsync \
libstring-shellquote-perl libnet-scp-perl libapache-asp-perl \
libtie-ixhash-perl libtime-duration-perl \
libhtml-widgets-selectlayers-perl libstorable-perl \
- libapache-dbi-perl libdbd-mysql-perl
+ libapache-dbi-perl libcache-cache-perl libdbd-mysql-perl
useradd freeside
su postgres -c "createuser -P freeside"
--- /dev/null
+#!/bin/sh
+
+wget --passive-ftp --continue http://download.fedora.us/fedora/fedora/1/i386/RPMS.stable/apt-0.5.15cnc5-0.fdr.10.1.i386.rpm
+rpm -i apt*i386.rpm
+
+cp sources.list /etc/apt/sources.list
+
+apt-get update
+
+apt-get install perl-Devel-Symdump perl-BSD-Resource
+
+wget --passive-ftp --continue http://linux.reb00t.com/fedora-current/RPMS/apache-1.3.29-1.n0i.2.MPSSL.i686.rpm http://linux.reb00t.com/fedora-current/RPMS/mm-1.3.0-0.n0i.2.i686.rpm http://mirrors.kernel.org/fedora.us/fedora/fedora/1.91/i386/RPMS.os/db4-4.2.52-3.1.i386.rpm
+
+apt-get remove httpd mod_perl
+
+rpm -i mm-1.3.0-0.n0i.2.i686.rpm db4-4.2.52-3.1.i386.rpm apache-1.3.29-1.n0i.2.MPSSL.i686.rpm
+
+/sbin/chkconfig httpd on
+
+#edit /etc/httpd/conf/httpd.conf, remove mod_auth_db LoadMoudle and AddModule
+
+echo 'OPTIONS="-DHAVE_PERL -DHAVE_SSL"' >>/etc/sysconfig/apache
+
+/etc/init.d/httpd start
+
+echo 'RPM::Allow-Duplicated { "^db4$"; };' >>/etc/apt/apt.conf
+
+wget --continue http://atrpms.physik.fu-berlin.de/RPM-GPG-KEY.atrpms
+rpm --import RPM-GPG-KEY.atrpms
+wget --continue http://dag.wieers.com/packages/RPM-GPG-KEY.dag.txt
+rpm --import RPM-GPG-KEY.dag.txt
+
+apt-get install perl-DBD-MySQL perl-DBI perl-DateManip perl-HTML-Parser perl-HTML-Tagset perl-TimeDate perl-URI perl-libwww-perl perl-suidperl rsync postgresql postgresql-docs postgresql-libs postgresql-server postgresql-devel screen zsh lftp cvs gcc gd perl-GD perl-MailTools perl-FreezeThaw perl-NetAddr-IP perl-Chart
+
+perl -MCPAN -e"install Net::Whois::Raw, Business::CreditCard, \
+ File::CounterFile, String::Approx, Text::Template, \
+ DBIx::DataSource, DBIx::DBSchema, Net::SSH, \
+ String::ShellQuote, Net::SCP, Apache::ASP, \
+ Tie::IxHash, Time::Duration, \
+ HTML::Widgets::SelectLayers, Apache::DBI, \
+ Cache::Cache, IPC::ShareLite, Locale::SubCountry, \
+ DBD::Pg, Crypt::PasswdMD5 "
+
+
+#remove perl & ssl LoadModule lines from /etc/httpd/conf/httpd.conf
+#as they're statically linked (?)
+
+/usr/sbin/useradd freeside
+chsh freeside -s /bin/bash
+
+/sbin/chkconfig postgresql on
+/etc/init.d/postgresql start
+
+echo -e '\n\ny\nn" | su postgres -c "createuser -P freeside"
+
+su freeside -c "createdb freeside"
+
+#?
+cd ../../..
+make install-perl-modules
+make create-config
+freeside-adduser -c -h /usr/local/etc/freeside/htpasswd ivan
+su freeside -c 'freeside-setup ivan'
+su freeside -c '/home/ivan/freeside/bin/populate-msgcat ivan'
+make deploy
+
--- /dev/null
+# Fedora Core (Kernel.org, San Francisco California, USA)
+rpm http://mirrors.kernel.org/fedora.us/fedora fedora/1/i386 os updates
+rpm-src http://mirrors.kernel.org/fedora.us/fedora fedora/1/i386 os updates
+
+# Fedora Extras (Kernel.org, San Francisco California, USA)
+rpm http://mirrors.kernel.org/fedora.us/fedora fedora/1/i386 stable
+rpm-src http://mirrors.kernel.org/fedora.us/fedora fedora/1/i386 stable
+
+### Dag Apt Repository for Red Hat Fedora Core 1 (rhfc1)
+rpm http://apt.sw.be redhat/fc1/en/i386 dag
+
+rpm http://apt.physik.fu-berlin.de redhat/9/en/i386 at-testing
String::Approx, Text::Template, DBIx::DataSource, \
DBIx::DBSchema, Net::SSH, String::ShellQuote, \
Net::SCP, Apache::ASP, Tie::IxHash, Time::Duration, \
- HTML::Widgets::SelectLayers, Apache::DBI"
+ HTML::Widgets::SelectLayers, Apache::DBI, Cache::Cache"
+
+useradd freeside
+
+chkconfig postgresql on
+/etc/init.d/postgresql start
+
+su postgres -c "createuser -P freeside"
+
+su freeside -c "createdb freeside"
+
+#?
+cd ../..
+make install-perl-modules
+make create-config
+freeside-adduser -c -h /usr/local/etc/freeside/htpasswd ivan
+su freeside -c 'freeside-setup ivan'
+su freeside -c '/home/ivan/freeside/bin/populate-msgcat ivan'
+make deploy
+
#!/bin/sh
-wget --passive-ftp ftp://apt-rpm.tuxfamily.org/apt/redhat/9/en/i386/RPMS.extra/apt-*i386.rpm
+wget --passive-ftp --continue ftp://apt-rpm.tuxfamily.org/apt/redhat/9/en/i386/RPMS.extra/apt-*i386.rpm
rpm -i apt*i386.rpm
cp sources.list /etc/apt/
apt-get update; apt-get update
#apt-get install apache mod_ssl mod_perl perl-CGI perl-CPAN perl-DBD-MySQL perl-DBD-Pg perl-DBI perl-DateManip perl-Digest-MD5 perl-HTML-Parser perl-HTML-Tagset perl-MIME-Base64 perl-Storable perl-TimeDate perl-URI perl-libnet perl-libwww-perl perl-suidperl rsync postgresql postgresql-docs postgresql-libs postgresql-server screen zsh lftp cvs #openssh
-apt-get install perl-Devel-Symdump perl-BSD-Resource
+apt-get install perl-Devel-Symdump perl-BSD-Resource rpm-build gdbm-devel expat-devel openssl-devel krb5-devel db4-devel
-wget --passive-ftp http://reb00t.com/linux/RPMS/redhat-9/apache/apache-1.3.28-0.n0i.src.rpm http://reb00t.com/linux/RPMS/redhat-9/mm/mm-1.2.1-0.n0i.i686.rpm http://reb00t.com/linux/RPMS/redhat-9/mm/mm-devel-1.2.1-0.n0i.i686.rpm
+wget --passive-ftp --continue http://reb00t.com/linux/RPMS/redhat-9/apache/apache-1.3.28-0.n0i.src.rpm http://reb00t.com/linux/RPMS/redhat-9/mm/mm-1.2.1-0.n0i.i686.rpm http://reb00t.com/linux/RPMS/redhat-9/mm/mm-devel-1.2.1-0.n0i.i686.rpm
rpm -i mm-1.2.1-0.n0i.i686.rpm mm-devel-1.2.1-0.n0i.i686.rpm apache-1.3.28-0.n0i.src.rpm
+install -d /usr/src/redhat
+for a in BUILD RPMS SOURCES SPECS SRPMS; do install -d /usr/src/redhat/$a; done
+for a in athlon i386 i486 i586 i686 noarch; do install -d /usr/src/redhat/RPMS/$a; done
+
cd /usr/src/redhat/SPECS
rpmbuild -ba apache.spec
cd /usr/src/redhat/RPMS/i386
rpm -i apache-1.3.28-0.n0i.i386.rpm
-apt-get install perl-CGI perl-CPAN perl-DBD-MySQL perl-DBD-Pg perl-DBI perl-DateManip perl-HTML-Parser perl-HTML-Tagset perl-TimeDate perl-URI perl-libwww-perl perl-suidperl rsync postgresql postgresql-docs postgresql-libs postgresql-server screen zsh lftp cvs #openssh
+apt-get install perl-CGI perl-CPAN perl-DBD-MySQL perl-DBD-Pg perl-DBI perl-DateManip perl-HTML-Parser perl-HTML-Tagset perl-TimeDate perl-URI perl-libwww-perl perl-suidperl rsync postgresql postgresql-docs postgresql-libs postgresql-server screen zsh lftp cvs gcc gd #openssh
+
+wget --passive-ftp --continue http://atrpms.physik.fu-berlin.de/dist/rh9/perl-GD/perl-GD-2.11-7.rh9.at.i386.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/atrpms/atrpms-45-1.rh9.at.noarch.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/yum/yum-2.0.4-28.rh9.at.noarch.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/gd/gd-2.0.15-1_6.rh9.at.i386.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/atrpms/atrpms-package-config-45-1.rh9.at.noarch.rpm
+
+cp /etc/apt/apt.conf /etc/apt/apt.conf.real
+
+rpm -i --replacefiles atrpms-package-config-45-1.rh9.at.noarch.rpm yum-2.0.4-28.rh9.at.noarch.rpm atrpms-45-1.rh9.at.noarch.rpm gd-2.0.15-1_6.rh9.at.i386.rpm perl-GD-2.11-7.rh9.at.i386.rpm
+
+mv /etc/apt/apt.conf.real /etc/apt/apt.conf
perl -MCPAN -e"install Locale::Country, Net::Whois, Business::CreditCard, \
Mail::Internet, File::CounterFile, FreezeThaw, \
String::Approx, Text::Template, DBIx::DataSource, \
DBIx::DBSchema, Net::SSH, String::ShellQuote, \
Net::SCP, Apache::ASP, Tie::IxHash, Time::Duration, \
- HTML::Widgets::SelectLayers, Apache::DBI, Cache::Cache"
+ HTML::Widgets::SelectLayers, Apache::DBI, Cache::Cache \
+ Test::Pod NetAddr::IP IPC::ShareLite Chart::LinesPoints"
+
+echo 'OPTIONS="-DHAVE_PERL -DHAVE_SSL"' >>/etc/sysconfig/apache
-#edit /etc/init.d/httpd, add -DHAVE_PERL -DHAVE_SSL, then remove perl & ssl
-# module load bits from /etc/httpd/conf/httpd.conf
+#remove perl & ssl LoadModule lines from /etc/httpd/conf/httpd.conf
+#as they're statically linked
-useradd freeside
+/usr/sbin/useradd freeside
-chkconfig postgresql on
+/sbin/chkconfig postgresql on
/etc/init.d/postgresql start
su postgres -c "createuser -P freeside"
su freeside -c "createdb freeside"
#?
-cd ../..
+cd ../../..
make install-perl-modules
make create-config
freeside-adduser -c -h /usr/local/etc/freeside/htpasswd ivan
--- /dev/null
+#!/bin/sh
+
+# based on install/redhat/9/INSTALL
+
+# apt for SuSE howto: http://linux01.gwdg.de/apt4rpm/
+
+for file in ftp://ftp.gwdg.de/pub/linux/suse/apt/SuSE/9.0-i386/RPMS.suser-rbos/apt-0.5.5cnc6-rb6.i586.rpm ftp://ftp.gwdg.de/pub/linux/suse/apt/SuSE/9.0-i386/RPMS.suser-rbos/apt-libs-0.5.5cnc6-rb6.i586.rpm ftp://ftp.gwdg.de/pub/linux/suse/apt/SuSE/9.0-i386/RPMS.suser-rbos/lua-5.0-rb3.i586.rpm; do
+ curl -C - -o `basename $file` $file
+done
+
+rpm -i lua-5.0-rb3.i586.rpm
+rpm -i apt-libs-0.5.5cnc6-rb6.i586.rpm
+rpm -i apt-0.5.5cnc6-rb6.i586.rpm
+
+perl -pi.bak -e 's/386 update/386 base update/' /etc/apt/sources.list
+
+apt-get update; apt-get update
+
+apt-get install apache mod_ssl mod_perl perl-DBI perl-Msql-Mysql-modules perl-DBD-Pg perl-DateManip perl-HTML-Parser perl-HTML-Tagset perl-TimeDate perl-URI perl-libwww-perl perl-Apache-DBI perl-Apache-ASP perl-GD perl-MailTools perl-Tie-IxHash rsync postgresql postgresql-docs postgresql-libs postgresql-server postgresql-devel screen zsh lftp wget cvs make gcc
+
+perl -MCPAN -e"install DBD::Pg, Net::Whois, Business::CreditCard, \
+ File::CounterFile, FreezeThaw, String::Approx, \
+ Text::Template, DBIx::DataSource, DBIx::DBSchema, \
+ Net::SSH, String::ShellQuote, Net::SCP, \
+ Time::Duration, HTML::Widgets::SelectLayers, \
+ Cache::Cache, Test::Pod, NetAddr::IP, IPC::ShareLite, \
+ Chart::LinesPoints"
+
+/usr/sbin/useradd freeside
+
+/sbin/chkconfig postgresql on
+/etc/init.d/postgresql start
+
+/sbin/chkconfig apache on
+#/etc/init.d/apache start
+
+su postgres -c "createuser -P freeside"
+
+su freeside -c "createdb freeside"
+
+#?
+cd ../../..
+make install-perl-modules
+make create-config
+freeside-adduser -c -h /usr/local/etc/freeside/htpasswd ivan
+su freeside -c 'freeside-setup ivan'
+su freeside -c '/home/ivan/freeside/bin/populate-msgcat ivan'
+make deploy
+
+
+
+
projects / freeside.git / commitdiff
