+++ /dev/null
---#!/usr/bin/perl -w
---# BEGIN BPS TAGGED BLOCK {{{
---#
---# COPYRIGHT:
---#
---# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
---# <jesse@bestpractical.com>
---#
---# (Except where explicitly superseded by other copyright notices)
---#
---#
---# LICENSE:
---#
---# This work is made available to you under the terms of Version 2 of
---# the GNU General Public License. A copy of that license should have
---# been provided with this software, but in any event can be snarfed
---# from www.gnu.org.
---#
---# This work is distributed in the hope that it will be useful, but
---# WITHOUT ANY WARRANTY; without even the implied warranty of
---# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
---# General Public License for more details.
---#
---# You should have received a copy of the GNU General Public License
---# along with this program; if not, write to the Free Software
---# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
---# 02110-1301 or visit their web page on the internet at
---# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
---#
---#
---# CONTRIBUTION SUBMISSION POLICY:
---#
---# (The following paragraph is not intended to limit the rights granted
---# to you to modify and distribute this software under the terms of
---# the GNU General Public License and is only of importance to you if
---# you choose to contribute your changes and enhancements to the
---# community by submitting them to Best Practical Solutions, LLC.)
---#
---# By intentionally submitting any modifications, corrections or
---# derivatives to this work, or any other work intended for use with
---# Request Tracker, to Best Practical Solutions, LLC, you confirm that
---# you are the copyright holder for those contributions and you grant
---# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
---# royalty-free, perpetual, license to use, copy, create derivative
---# works based on those contributions, and sublicense and distribute
---# those contributions and any derivatives thereof.
---#
---# END BPS TAGGED BLOCK }}}
---use warnings;
---use strict;
---
---# fix lib paths, some may be relative
---BEGIN {
--- require File::Spec;
--- my @libs = ("lib", "local/lib");
--- my $bin_path;
---
--- for my $lib (@libs) {
--- unless ( File::Spec->file_name_is_absolute($lib) ) {
--- unless ($bin_path) {
--- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
--- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
--- }
--- else {
--- require FindBin;
--- no warnings "once";
--- $bin_path = $FindBin::Bin;
--- }
--- }
--- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
--- }
--- unshift @INC, $lib;
--- }
---
---}
---
---use RT;
---RT::LoadConfig();
---RT->InitLogging();
---if (RT->Config->Get('DevelMode')) { require Module::Refresh; }
---
---RT::CheckPerlRequirements();
---RT->InitPluginPaths();
---
---my $explicit_port = shift @ARGV;
---my $port = $explicit_port || RT->Config->Get('WebPort') || '8080';
---
---
---require RT::Handle;
---my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
---
---unless ( $integrity ) {
--- print STDERR <<EOF;
---
---RT couldn't connect to the database where tickets are stored.
---If this is a new installation of RT, you should visit the URL below
---to configure RT and initialize your database.
---
---If this is an existing RT installation, this may indicate a database
---connectivity problem.
---
---The error RT got back when trying to connect to your database was:
---
---$msg
---
---EOF
---
--- require RT::Installer;
--- # don't enter install mode if the file exists but is unwritable
--- if (-e RT::Installer->ConfigFile && !-w _) {
--- die 'Since your configuration exists ('
--- . RT::Installer->ConfigFile
--- . ") but is not writable, I'm refusing to do anything.\n";
--- }
---
--- RT->Config->Set( 'LexiconLanguages' => '*' );
--- RT::I18N->Init;
---
--- RT->InstallMode(1);
---} else {
--- RT->ConnectToDatabase();
--- RT->InitSystemObjects();
--- RT->InitClasses( Heavy => 1 );
--- RT->InitPlugins();
--- RT->Config->PostLoadCheck();
---
--- my ($status, $msg) = RT::Handle->CheckCompatibility(
--- $RT::Handle->dbh, 'post'
--- );
--- unless ( $status ) {
--- print STDERR $msg, "\n\n";
--- exit -1;
--- }
---}
---
---require RT::Interface::Web::Standalone;
---my $server = RT::Interface::Web::Standalone->new;
---run_server($port);
---exit 0;
---
---sub run_server {
--- my $port = shift;
--- $server->port($port);
--- eval { $server->run() };
---
--- if ( my $err = $@ ) {
--- handle_startup_error($err);
--- }
---}
---
---sub handle_startup_error {
--- my $err = shift;
--- if ( $err =~ /bind: Permission denied/ ) {
--- handle_bind_error();
--- } else {
--- die
--- "Something went wrong while trying to run RT's standalone web server:\n\t"
--- . $err;
--- }
---}
---
---
---sub handle_bind_error {
---
--- print STDERR <<EOF;
---WARNING: RT couldn't start up a web server on port @{[$port]}.
---This is often the case if you're running @{[$0]} as
---someone other than your system's "root" user.
---EOF
---
--- if ($explicit_port) {
--- print STDERR
--- "Please check your system configuration or choose another port\n\n";
--- } else {
--- print STDERR "\nFor now, RT has chosen an alternate port to run on.\n\n";
--- if ( !$integrity ) {
--- print STDERR <<EOF;
---You can use this server to configure and explore RT. While configuring
---RT, you'll have a chance to set a permanent port and URL for your
---server.
---
---EOF
--- }
--- run_server( 8000 + int( rand(1024) ) );
--- }
---}
+++ /dev/null
---#!/usr/bin/perl -w
---# BEGIN BPS TAGGED BLOCK {{{
---#
---# COPYRIGHT:
---#
---# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
---# <jesse@bestpractical.com>
---#
---# (Except where explicitly superseded by other copyright notices)
---#
---#
---# LICENSE:
---#
---# This work is made available to you under the terms of Version 2 of
---# the GNU General Public License. A copy of that license should have
---# been provided with this software, but in any event can be snarfed
---# from www.gnu.org.
---#
---# This work is distributed in the hope that it will be useful, but
---# WITHOUT ANY WARRANTY; without even the implied warranty of
---# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
---# General Public License for more details.
---#
---# You should have received a copy of the GNU General Public License
---# along with this program; if not, write to the Free Software
---# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
---# 02110-1301 or visit their web page on the internet at
---# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
---#
---#
---# CONTRIBUTION SUBMISSION POLICY:
---#
---# (The following paragraph is not intended to limit the rights granted
---# to you to modify and distribute this software under the terms of
---# the GNU General Public License and is only of importance to you if
---# you choose to contribute your changes and enhancements to the
---# community by submitting them to Best Practical Solutions, LLC.)
---#
---# By intentionally submitting any modifications, corrections or
---# derivatives to this work, or any other work intended for use with
---# Request Tracker, to Best Practical Solutions, LLC, you confirm that
---# you are the copyright holder for those contributions and you grant
---# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
---# royalty-free, perpetual, license to use, copy, create derivative
---# works based on those contributions, and sublicense and distribute
---# those contributions and any derivatives thereof.
---#
---# END BPS TAGGED BLOCK }}}
---use strict;
---
---# As we specify that XML is UTF-8 and we output it to STDOUT, we must be sure
---# it is UTF-8 so further XMLin will not break
---binmode(STDOUT, ":utf8");
---
---# fix lib paths, some may be relative
---BEGIN {
--- require File::Spec;
--- my @libs = ("lib", "local/lib");
--- my $bin_path;
---
--- for my $lib (@libs) {
--- unless ( File::Spec->file_name_is_absolute($lib) ) {
--- unless ($bin_path) {
--- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
--- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
--- }
--- else {
--- require FindBin;
--- no warnings "once";
--- $bin_path = $FindBin::Bin;
--- }
--- }
--- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
--- }
--- unshift @INC, $lib;
--- }
---
---}
---
---use RT;
---use XML::Simple;
---
---RT::LoadConfig();
---RT::Init();
---
---my $LocalOnly = @ARGV ? shift(@ARGV) : 1;
---
---my %RV;
---my %Ignore = (
--- All => [qw(
--- id Created Creator LastUpdated LastUpdatedBy
--- )],
--- Templates => [qw(
--- TranslationOf
--- )],
---);
---
---my $SystemUserId = $RT::SystemUser->Id;
---my @classes = qw(
--- Users Groups Queues ScripActions ScripConditions
--- Templates Scrips ACL CustomFields
---);
---foreach my $class (@classes) {
--- require "RT/$class.pm";
--- my $objects = "RT::$class"->new($RT::SystemUser);
--- $objects->{find_disabled_rows} = 1;
--- $objects->UnLimit;
---
--- if ($class eq 'CustomFields') {
--- $objects->OrderByCols(
--- { FIELD => 'LookupType' },
--- { FIELD => 'SortOrder' },
--- { FIELD => 'Id' },
--- );
--- }
--- else {
--- $objects->OrderBy( FIELD => 'Id' );
--- }
---
--- if ($LocalOnly) {
--- next if $class eq 'ACL'; # XXX - would go into infinite loop - XXX
--- $objects->Limit( FIELD => 'LastUpdatedBy', OPERATOR => '!=', VALUE => $SystemUserId )
--- unless $class eq 'Groups';
--- $objects->Limit( FIELD => 'Id', OPERATOR => '!=', VALUE => $SystemUserId )
--- if $class eq 'Users';
--- $objects->Limit( FIELD => 'Domain', OPERATOR => '=', VALUE => 'UserDefined' )
--- if $class eq 'Groups';
--- }
---
--- my %fields;
--- while (my $obj = $objects->Next) {
--- next if $obj->can('LastUpdatedBy') and $obj->LastUpdatedBy == $SystemUserId;
---
--- if (!%fields) {
--- %fields = map { $_ => 1 } keys %{$obj->_ClassAccessible};
--- delete @fields{
--- @{$Ignore{$class}||=[]},
--- @{$Ignore{All}||=[]},
--- };
--- }
---
--- my $rv;
--- # next if $obj-> # skip default names
--- foreach my $field (sort keys %fields) {
--- my $value = $obj->__Value($field);
--- $rv->{$field} = $value if ( defined ($value) && length($value) );
--- }
--- delete $rv->{Disabled} unless $rv->{Disabled};
---
--- foreach my $record (map { /ACL/ ? 'ACE' : substr($_, 0, -1) } @classes) {
--- foreach my $key (map "$record$_", ('', 'Id')) {
--- next unless exists $rv->{$key};
--- my $id = $rv->{$key} or next;
--- my $obj = "RT::$record"->new($RT::SystemUser);
--- $obj->LoadByCols( Id => $id ) or next;
--- $rv->{$key} = $obj->__Value('Name') || 0;
--- }
--- }
---
--- if ($class eq 'Users' and defined $obj->Privileged) {
--- $rv->{Privileged} = int($obj->Privileged);
--- }
--- elsif ($class eq 'CustomFields') {
--- my $values = $obj->Values;
--- while (my $value = $values->Next) {
--- push @{$rv->{Values}}, {
--- map { ($_ => $value->__Value($_)) } qw(
--- Name Description SortOrder
--- ),
--- };
--- }
--- }
---
--- if (eval { require RT::Attributes; 1 }) {
--- my $attributes = $obj->Attributes;
--- while (my $attribute = $attributes->Next) {
--- my $content = $attribute->Content;
--- $rv->{Attributes}{$attribute->Name} = $content if length($content);
--- }
--- }
---
--- push @{$RV{$class}}, $rv;
--- }
---}
---
---print(<< ".");
---no strict; use XML::Simple; *_ = XMLin(do { local \$/; readline(DATA) }, ForceArray => [qw(
--- @classes Values
---)], NoAttr => 1, SuppressEmpty => ''); *\$_ = (\$_{\$_} || []) for keys \%_; 1; # vim: ft=xml
---__DATA__
---.
---
---print XMLout(
--- { map { ($_ => ($RV{$_} || [])) } @classes },
--- RootName => 'InitialData',
--- NoAttr => 1,
--- SuppressEmpty => '',
--- XMLDecl => '<?xml version="1.0" encoding="UTF-8"?>',
---);
projects / freeside.git / commitdiff