'
' See also
' o https://github.com/ReneNyffenegger/development_misc/blob/master/vba/excel/some_data_import.bas and
' o https://github.com/ReneNyffenegger/development_misc/blob/master/vba/excel/CSV_import.bas
'
option explicit
public sub Run(csvFileName as string, lineCharacteristics as string) ' {
dim diagram as chart
createDataAndDiagramSheet
importCsv csvFileName
set diagram = application.sheets("diagram")
assignDataToChart diagram
formatChart diagram, lineCharacteristics
end sub ' }
private sub createDataAndDiagramSheet() ' {
' There need to be two work sheets. One for the data (that is �imported�
' from a csv file, and one for the created diagram that is based on that
' data
'
' When Excel starts, there is one sheet.
dim sh_diagram as chart
if application.sheets.count <> 1 then
msgBox "Assumption about count of sheets was wrong, the count is: " & application.sheets.count
end if
' Name this first sheet data
application.sheets(1).name = "data"
' Insert the second sheet for the diagram:
set sh_diagram = application.sheets.add (type := xlChart)
sh_diagram.name = "diagram"
end sub ' }
private sub importCsv(csvFileName as string) ' {
'
' https://github.com/ReneNyffenegger/development_misc/blob/master/vba/excel/some_data_import.bas
'
dim qt as queryTable
dim dest as range
dim sh as workSheet
set sh = application.sheets("data")
set dest = application.range("data!$a$1")
set qt = sh.queryTables.add(connection := "TEXT;" & csvFileName, _
destination := dest)
qt.textFileParseType = xlDelimited
qt.textFileSemicolonDelimiter = true
qt.name = "imported_data"
qt.refresh
end sub ' }
private sub assignDataToChart(diagram as chart) ' {
diagram.setSourceData source := range("data!imported_data")
end sub ' }
private sub setPageUp(diagram as chart) ' {
dim ps as pageSetup
set ps = diagram.pageSetup
ps.leftMargin = application.centimetersToPoints(0.5)
ps.rightMargin = application.centimetersToPoints(0.5)
ps.topMargin = application.centimetersToPoints(0.5)
ps.bottomMargin = application.centimetersToPoints(0.5)
ps.headerMargin = application.centimetersToPoints( 0 )
ps.footerMargin = application.centimetersToPoints( 0 )
end sub ' }
private sub formatChart(diagram as chart, lineCharacteristics as string) ' {
dim leg as legend
dim ser as series
dim characteristicsArray() as string
dim columnNameAndvalues () as string
dim columnValues as string
dim valuesArray () as string
dim rgb_s as string
dim width as double
dim rgbArray () as string
dim i as long
dim columnName as string
dim s as string
diagram.chartType = xlLine
diagram.plotArea.top = 9
diagram.plotArea.left = 45
diagram.plotArea.width = 748
diagram.plotArea.height = 480
setPageUp diagram
' { legend
set leg = diagram.legend
leg.includeInLayout = false
leg.format.fill.foreColor.objectThemeColor = msoThemeColorBackground1
leg.format.fill.transparency = 0.3
leg.format.fill.solid
' }
' Split the line charactersistics into its components...
characteristicsArray = split(lineCharacteristics, ";")
' and iterate over each element for the line characteristics
for i = lbound(characteristicsArray) to ubound(characteristicsArray) ' {
' A component is supposed to be
'
' "Column Name:values...."
'
' So, we split on the ":" ...
columnNameAndvalues = split(characteristicsArray(i), ":")
' in order to get columnName and columnNameAndvalues
columnName = columnNameAndvalues(0)
columnValues = columnNameAndvalues(1)
' The values itself are supposed to be divided by a "|":
valuesArray = split(columnValues, "|")
' Left of the bar is the desired rgb value ("red,green,blue"), right of the
' bar the width of the line
rgb_s = valuesArray(0)
width = valuesArray(1)
rgbArray = split(rgb_s, ",")
' cstr()?
' See http://stackoverflow.com/questions/12620239/what-is-the-difference-between-string-variable-and-cstrstring-variable
set ser = diagram.seriesCollection.item(cstr(columnName))
ser.format.line.foreColor.rgb = rgb(rgbArray(0),rgbArray(1),rgbArray(2))
ser.format.line.weight = width
' i = i + 1
next i ' }
end sub ' }
set verify off
define SnapBegin=&1
define SnapEnd=&2
define SQLFile=&3
define LineCharacteristics=&4
set termout off
-- https://github.com/ReneNyffenegger/oracle_scriptlets/blob/master/sqlpath/to_csv.sql
@to_csv &SQLFile u:/temp/awr_data.csv
set termout on
-- https://github.com/ReneNyffenegger/development_misc/blob/master/vba/runVBAFilesInOffice.vbs
$u:\dev1\githup_development_misc\vba\runVBAFilesInOffice.vbs -excel AWRDataToExcel -c Run u:\temp\awr_data.csv "&LineCharacteristics"
create or replace package body bmp as
headersize constant pls_integer := 14;
infosize constant pls_integer := 40;
offset constant pls_integer := infosize + headersize;
bmpWidth pls_integer;
bmpHeight pls_integer;
lineLen pls_integer;
filesize pls_integer;
output_file utl_file.file_type;
the_bits blob;
function unsigned_short(s in pls_integer) return raw is/*{*/
ret raw(2);
v pls_integer;
r pls_integer;
begin
v := trunc (s/256); r := s-v; ret := utl_raw.cast_to_raw(chr(v));
v := trunc (s ); r := s-v; ret := utl_raw.cast_to_raw(chr(v)) || ret;
return ret;
end unsigned_short;/*}*/
function unsigned_rgb(r in pls_integer, g in pls_integer, b in pls_integer) return raw is /*{*/
ret raw(3);
begin
ret := utl_raw.cast_to_raw(chr(r));
ret := utl_raw.cast_to_raw(chr(g)) || ret;
ret := utl_raw.cast_to_raw(chr(b)) || ret;
return ret;
end unsigned_rgb;/*}*/
function unsigned_int(i in pls_integer) return raw is /*{*/
/* i = ret(4) * 256*256*256 +
ret(3) * 256*256 +
ret(2) * 256 +
ret(1) */
-- ret raw(4);
-- v pls_integer;
-- r pls_integer;
begin
-- v := trunc (i/256/256/256); r := i-v; ret := utl_raw.cast_to_raw(chr(v));
-- v := trunc (i/256/256 ); r := i-v; ret := utl_raw.cast_to_raw(chr(v)) || ret;
-- v := trunc (i/256 ); r := i-v; ret := utl_raw.cast_to_raw(chr(v)) || ret;
-- v := trunc (i ); r := i-v; ret := utl_raw.cast_to_raw(chr(v)) || ret;
return utl_raw.cast_from_binary_integer(i, utl_raw.little_endian);
-- return ret;
end unsigned_int;/*}*/
procedure WriteHeader is /*{*/
imagesize pls_integer;
begin
imagesize := bmpHeight * lineLen;
filesize := imagesize + offset;
-- Header
dbms_lob.append(the_bits, utl_raw.cast_to_raw('BM')); -- Pos 0
dbms_lob.append(the_bits, unsigned_int(filesize)); -- Pos 2
dbms_lob.append(the_bits, unsigned_short(0)); -- Pos 6, reserved 1
dbms_lob.append(the_bits, unsigned_short(0)); -- Pos 8, reserved 2
dbms_lob.append(the_bits, unsigned_int(offset)); -- Pos 10, offset to image
-- Information
dbms_lob.append(the_bits, unsigned_int(infosize)); -- Pos 14
dbms_lob.append(the_bits, unsigned_int(bmpWidth)); -- Pos 18
dbms_lob.append(the_bits, unsigned_int(bmpHeight)); -- Pos 22
dbms_lob.append(the_bits, unsigned_short( 1)); -- Pos 26, planes
dbms_lob.append(the_bits, unsigned_short(24)); -- Pos 28, bits per pixel
dbms_lob.append(the_bits, unsigned_int ( 0)); -- Pos 30, no compression
dbms_lob.append(the_bits, unsigned_int (imagesize)); -- Pos 34
dbms_lob.append(the_bits, unsigned_int (7874)); -- Pos 38, x pixels/meter (???)
dbms_lob.append(the_bits, unsigned_int (7874)); -- Pos 42, y pixels/meter (???)
dbms_lob.append(the_bits, unsigned_int (0)); -- Pos 46, Number of colors
dbms_lob.append(the_bits, unsigned_int (0)); -- Pos 50, Important colors
end WriteHeader;/*}*/
procedure Init(width pls_integer, height pls_integer, r in pls_integer, g in pls_integer, b in pls_integer) is/*{*/
bgColor raw(3);
begin
bmpWidth := width;
bmpHeight := height;
-- lineLen must be divisible by 4
lineLen := 4*ceil(3*bmpWidth/4);
bgColor := unsigned_rgb(r,g,b);
the_bits := empty_blob();
dbms_lob.createTemporary(the_bits, true);
dbms_lob.open(the_bits, dbms_lob.lob_readwrite);
WriteHeader;
for x in 0 .. bmpWidth-1 loop for Y in 0 .. bmpHeight-1 loop
dbms_lob.append(the_bits, bgColor);
end loop; end loop;
end Init;/*}*/
function AsBlob return blob is begin/*{*/
return the_bits;
end AsBlob;/*}*/
procedure PixelAt(x in pls_integer, y in pls_integer, rgb in raw) is begin/*{*/
if x < 0 or y < 0 or x >= bmpWidth or y >= bmpHeight then
return;
end if;
dbms_lob.write(the_bits, 3, 1+offset+ (bmpHeight-y-1)*lineLen + x*3, rgb);
end PixelAt;/*}*/
procedure PixelAt(x pls_integer, /*{*/
y pls_integer,
r pls_integer,
g pls_integer,
b pls_integer) is
rgb raw(3);
begin
rgb := unsigned_rgb(r,g,b);
PixelAt(x, y, rgb);
end PixelAt;/*}*/
procedure Line (xFrom pls_integer, /*{*/
yFrom pls_integer,
xTo pls_integer,
yTo pls_integer,
r pls_integer,
g pls_integer,
b pls_integer)
is
rgb raw(3);
c pls_integer;
m pls_integer;
x pls_integer;
y pls_integer;
D pls_integer;
HX pls_integer;
HY pls_integer;
xInc pls_integer;
yInc pls_integer;
begin
rgb := unsigned_rgb(r,g,b);
x := xFrom;
y := yFrom;
D := 0;
HX := xTo - xfrom;
HY := yTo - yfrom;
xInc := 1;
yInc := 1;
if HX < 0 then xInc := -1; HX := -HX; end if;
if HY < 0 then yInc := -1; HY := -HY; end if;
if HY <= HX then
c := 2*HX;
M := 2*HY;
loop
PixelAt(x, y, rgb);
exit when x = xTo;
x := x + xInc;
D := D + M;
if D > HX then y := y+yInc; D := D-c; end if;
end loop;
else
c := 2*HY;
M := 2*HX;
loop
PixelAt(x, y, rgb);
exit when y = yTo;
y := y + yInc;
D := D + M;
if D > HY then
x := x + xInc;
D := D - c;
end if;
end loop;
end if;
end Line;/*}*/
procedure Circle_(x pls_integer,/*{*/
y pls_integer,
xx pls_integer,
yy pls_integer,
rgb raw)
is begin
if xx = 0 then
PixelAt(x , y + yy , rgb);
PixelAt(x , y - yy , rgb);
PixelAt(x + yy, y , rgb);
PixelAt(x - yy, y , rgb);
elsif xx = yy then
PixelAt(x + xx , y + yy , rgb);
PixelAt(x - xx , y + yy , rgb);
PixelAt(x + xx , y - yy , rgb);
PixelAt(x - xx , y - yy , rgb);
elsif xx < yy then
PixelAt(x + xx , y + yy , rgb);
PixelAt(x - xx , y + yy , rgb);
PixelAt(x + xx , y - yy , rgb);
PixelAt(x - xx , y - yy , rgb);
PixelAt(x + yy , y + xx , rgb);
PixelAt(x - yy , y + xx , rgb);
PixelAt(x + yy , y - xx , rgb);
PixelAt(x - yy , y - xx , rgb);
end if;
end Circle_;/*}*/
procedure Circle (x pls_integer,/*{*/
y pls_integer,
radius pls_integer,
r pls_integer,
g pls_integer,
b pls_integer)
is
xx pls_integer := 0;
yy pls_integer := radius;
pp pls_integer := (5-radius*4)/4;
rgb raw(3);
begin
rgb := unsigned_rgb(r,g,b);
Circle_(x, y, xx, yy, rgb);
while xx < yy loop
xx := xx+1;
if pp < 0 then
pp := pp + 2*xx+1;
else
yy := yy - 1;
pp := pp + 2*(xx-yy) + 1;
end if;
Circle_(x, y, xx, yy, rgb);
end loop;
end Circle;/*}*/
procedure Ellipse (/*{*/
-------------------------------------------
--
-- Thanks to Thierry Vergote
-- for implementing ellipse
-- and fixing an endian bug
-- in unsigned_int.
--
-------------------------------------------
x pls_integer,
y pls_integer,
xradius pls_integer,
yradius pls_integer,
r pls_integer,
g pls_integer,
b pls_integer
) is
x_ pls_integer;
y_ pls_integer;
xchange pls_integer;
ychange pls_integer;
ellipseerror pls_integer;
twoasquare pls_integer;
twobsquare pls_integer;
stoppingx pls_integer;
stoppingy pls_integer;
rgb raw(3);
procedure plot4ellipsepoints (/*{*/
xp4 pls_integer,
yp4 pls_integer
) IS
begin
PixelAt(x + xp4, y + yp4, rgb); -- point in quadrant 1
PixelAt(x - xp4, y + yp4, rgb); -- point in quadrant 2
PixelAt(x - xp4, y - yp4, rgb); -- point in quadrant 3
PixelAt(x + xp4, y - yp4, rgb); -- point in quadrant 4
end plot4ellipsepoints;/*}*/
begin
rgb := unsigned_rgb(r,g,b);
twoasquare := 2 * xradius * xradius;
twobsquare := 2 * yradius * yradius;
x_ := xradius;
y_ := 0;
xchange := yradius * yradius * (1 - 2 * xradius);
ychange := xradius * xradius;
ellipseerror := 0;
stoppingx := twobsquare * xradius;
stoppingy := 0;
while stoppingx >= stoppingy loop/*{*/
-- 1st set of points, y_' > 1
plot4ellipsepoints(x_, y_);
y_ := y_ + 1;
stoppingy := stoppingy + twoasquare;
ellipseerror := ellipseerror + ychange;
ychange := ychange + twoasquare;
if 2 * ellipseerror + xchange > 0 then
x_ := x_ - 1;
stoppingx := stoppingx - twobsquare;
ellipseerror := ellipseerror + xchange;
xchange := xchange + twobsquare;
end if;
end loop;/*}*/
-- 1st point set is done; start the 2nd set of points
x_ := 0;
y_ := yradius;
xchange := yradius * yradius;
ychange := xradius * xradius * (1 - 2 * yradius);
ellipseerror := 0;
stoppingx := 0;
stoppingy := twoasquare * yradius;
while stoppingx <= stoppingy loop/*{*/
-- 2nd set of points, y_'< 1
plot4ellipsepoints(x_, y_);
x_ := x_ + 1;
stoppingx := stoppingx + twobsquare;
ellipseerror := ellipseerror + xchange;
xchange := xchange + twobsquare;
if 2 * ellipseerror + ychange > 0 then
y_ := y_ - 1;
stoppingy := stoppingy - twoasquare;
ellipseerror := ellipseerror + ychange;
ychange := ychange + twoasquare;
end if;
end loop;/*}*/
end Ellipse;/*}*/
end bmp;
/
create or replace package bmp as
/*
Package bmp (spec.plsql and body.plsql)
Copyright (C) René Nyffenegger
This source code is provided 'as-is', without any express or implied
warranty. In no event will the author be held liable for any damages
arising from the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this source code must not be misrepresented; you must not
claim that you wrote the original source code. If you use this source code
in a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original source code.
3. This notice may not be removed or altered from any source distribution.
René Nyffenegger rene.nyffenegger@adp-gmbh.ch
*/
procedure Init (width pls_integer,
height pls_integer,
r pls_integer := 0,
g pls_integer := 0,
b pls_integer := 0);
procedure PixelAt(x pls_integer,
y pls_integer,
r pls_integer,
g pls_integer,
b pls_integer);
procedure Line (xFrom pls_integer,
yFrom pls_integer,
xTo pls_integer,
yTo pls_integer,
r pls_integer,
g pls_integer,
b pls_integer);
procedure Circle (x pls_integer,
y pls_integer,
radius pls_integer,
r pls_integer,
g pls_integer,
b pls_integer);
procedure Ellipse (/*{*/
-------------------------------------------
--
-- Thanks to Thierry Vergote
-- for implementing ellipse
-- and fixing an endian bug
-- in this package.
--
-------------------------------------------
x pls_integer,
y pls_integer,
xradius pls_integer,
yradius pls_integer,
r pls_integer,
g pls_integer,
b pls_integer);/*}*/
function AsBlob return blob;
end bmp;
/
create or replace package body calendar as
function EasterSunday(yr in number) return date /*{*/
is
a number;
b number;
c number;
d number;
e number;
m number;
n number;
day_ number;
month_ number;
begin
if yr < 1583 or yr > 2299 then
return null;
end if;
if yr < 1700 then m := 22; n := 2;
elsif yr < 1800 then m := 23; n := 3;
elsif yr < 1900 then m := 23; n := 4;
elsif yr < 2100 then m := 24; n := 5;
elsif yr < 2200 then m := 24; n := 6;
else m := 25; n := 0;
end if;
a := mod (yr,19);
b := mod (yr, 4);
c := mod (yr, 7);
d := mod (19*a + m, 30);
e := mod (2*b + 4*c + 6*d + n,7);
day_ := 22 + d + e;
month_ := 3;
if day_ > 31 then
day_ := day_-31;
month_:= month_+1;
end if;
if day_ = 26 and month_ = 4 then
day_ := 19;
end if;
if day_ = 25 and month_ = 4 and d = 28 and e = 6 and a > 10 then
day_:=18;
end if;
return to_date(
to_char(day_, '00') || '.' ||
to_char(month_, '00') || '.' ||
to_char(yr, '0000'),
'DD.MM.YYYY'
);
end EasterSunday;/*}*/
function CarnivalMonday (yr in number) return date is begin return EasterSunday(yr) -48; end;
function MardiGras (yr in number) return date is begin return EasterSunday(yr) -47; end;
function AshWednesday (yr in number) return date is begin return EasterSunday(yr) -46; end;
function PalmSunday (yr in number) return date is begin return EasterSunday(yr) - 7; end;
function EasterFriday (yr in number) return date is begin return EasterSunday(yr) - 2; end;
function EasterSaturday (yr in number) return date is begin return EasterSunday(yr) - 1; end;
function EasterMonday (yr in number) return date is begin return EasterSunday(yr) + 1; end;
function AscensionOfChrist (yr in number) return date is begin return EasterSunday(yr) +39; end;
function Whitsunday (yr in number) return date is begin return EasterSunday(yr) +49; end;
function Whitmonday (yr in number) return date is begin return EasterSunday(yr) +50; end;
function FeastOfCorpusChristi(yr in number) return date is begin return EasterSunday(yr) +60; end;
end;
/
create or replace package calendar as
function EasterSunday (yr in number) return date;
function CarnivalMonday (yr in number) return date;
function MardiGras (yr in number) return date;
function AshWednesday (yr in number) return date;
function PalmSunday (yr in number) return date;
function EasterFriday (yr in number) return date;
function EasterSaturday (yr in number) return date;
function EasterMonday (yr in number) return date;
function AscensionOfChrist (yr in number) return date;
function Whitsunday (yr in number) return date;
function Whitmonday (yr in number) return date;
function FeastofCorpusChristi (yr in number) return date;
end;
/
create or replace package call_stack as
type who_am_i_r is record (
type_ varchar2( 32),
name_ varchar2(255), -- 2016-11-22 Because of »0X459AF82320 40 ANONYMOUS BLOCK«
pkg_name varchar2(255), -- 2016-11-22
line number,
owner varchar2( 30)
);
function who_am_i(p_lvl in number := 0) return who_am_i_r;
end call_stack;
/
show errors
create or replace package test_who_am_i as -- {
procedure g;
procedure h;
procedure i;
end test_who_am_i; -- }
/
create or replace procedure test_who_am_i_proc as -- {
w call_stack.who_am_i_r;
begin
w := call_stack.who_am_i(0);
if w.pkg_name is not null then raise_application_error(-20800, 'pkg_name: ' || w.pkg_name); end if;
if w.name_ != 'TEST_WHO_AM_I_PROC' then raise_application_error(-20800, 'name: ' || w.name_ ); end if;
if w.type_ != 'PROCEDURE' then raise_application_error(-20800, 'type' ); end if;
if w.line != 5 then raise_application_error(-20800, 'line: ' || w.line ); end if;
if w.owner != user then raise_application_error(-20800, 'owner' ); end if;
end test_who_am_i_proc; -- }
/
create or replace package body test_who_am_i as -- {
procedure i is -- {
begin
h();
end i; -- }
procedure h is -- {
w call_stack.who_am_i_r;
begin
w := call_stack.who_am_i(0);
if nvl(w.pkg_name, '?') != 'TEST_WHO_AM_I' then raise_application_error(-20800, 'pkg_name: ' || w.pkg_name); end if;
if nvl(w.name_ , '?') != 'H' then raise_application_error(-20800, 'name: ' || w.name_ ); end if;
if nvl(w.type_ , '?') != 'PROCEDURE' then raise_application_error(-20800, 'type: ' || w.type_ ); end if;
if nvl(w.line , 0 ) != 12 then raise_application_error(-20800, 'line: ' || w.line ); end if;
if nvl(w.owner , '?') != user then raise_application_error(-20800, 'owner: ' || w.owner ); end if;
w := call_stack.who_am_i(1);
if nvl(w.pkg_name, '?') != 'TEST_WHO_AM_I' then raise_application_error(-20800, 'pkg_name: ' || w.pkg_name); end if;
if nvl(w.name_ , '?') != 'I' then raise_application_error(-20800, 'name: ' || w.name_); end if;
if nvl(w.type_ , '?') != 'PROCEDURE' then raise_application_error(-20800, 'type'); end if;
if nvl(w.line , 0 ) != 5 then raise_application_error(-20800, 'line: ' || w.line); end if;
if nvl(w.owner , '?') != user then raise_application_error(-20800, 'owner'); end if;
w := call_stack.who_am_i(2);
if nvl(w.pkg_name, '?') != 'TEST_WHO_AM_I' then raise_application_error(-20800, 'pkg_name: ' || w.pkg_name); end if;
if nvl(w.name_ , '?') != 'G' then raise_application_error(-20800, 'name: ' || w.name_); end if;
if nvl(w.type_ , '?') != 'PROCEDURE' then raise_application_error(-20800, 'type'); end if;
if nvl(w.line , 0 ) != 43 then raise_application_error(-20800, 'line: ' || w.line); end if;
if nvl(w.owner , '?') != user then raise_application_error(-20800, 'owner'); end if;
test_who_am_i_proc;
end h; -- }
procedure g is -- {
begin
i();
end g; -- }
end test_who_am_i; -- }
/
exec test_who_am_i.g;
select text from user_source where name = 'TEST_WHO_AM_I' and type = 'PACKAGE BODY' and line in (12, 5, 43);
create or replace package body ch_coordinates_conversion as
-- The MIT License (MIT) -- {
--
-- Copyright (c) 2014 Federal Office of Topography swisstopo, Wabern, CH and Joerg Schmidt, Rola AG, Zürich, CH
--
-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
-- in the Software without restriction, including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be included in
-- all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-- THE SOFTWARE.
--
-- Source: http://www.swisstopo.admin.ch/internet/swisstopo/en/home/topics/survey/sys/refsys/projections.html (see PDFs under "Documentation")
--
-- Translated from python to oracle by Joerg Schmidt (Rola AG)
--
-- Please validate your results with NAVREF on-line service: http://www.swisstopo.admin.ch/internet/swisstopo/en/home/apps/calc/navref.html (difference ~ 1-2m) -- }
--
-- TODO Do the lat and lng really need to be in out parameters?
--
function WGStoCHy(lat in out float, lng in out float) return float -- {
-- Convert WGS lat/long (° dec) to CH y
is
lat_aux float;
lng_aux float;
y float;
begin
lat := DECtoSEX(lat);
lng := DECtoSEX(lng);
lat_aux := (lat - 169028.66)/10000;
lng_aux := (lng - 26782.5 )/10000;
y := (600072.37
+ 211455.93 * lng_aux
- 10938.51 * lng_aux * lat_aux
- 0.36 * lng_aux * power( lat_aux, 2 )
- 44.54 * power( lng_aux, 3 ) );
return y;
end WGStoCHy; -- }
function WGStoCHx(lat in out float, lng in out float) return float -- {
-- Convert WGS lat/long (° dec) to CH x
is
lat_aux float;
lng_aux float;
x float;
begin
lat := DECtoSEX(lat);
lng := DECtoSEX(lng);
lat_aux := (lat - 169028.66)/10000;
lng_aux := (lng - 26782.5 )/10000;
x := (200147.07
+ 308807.95 * lat_aux
+ 3745.25 * power(lng_aux, 2 )
+ 76.63 * power( lat_aux, 2 )
- 194.56 * power( lng_aux, 2) * lat_aux
+ 119.79 * power( lat_aux, 3) );
return x;
end WGStoCHx; -- }
function CHtoWGSlat(y float, x float) return float -- {
-- Convert CH y/x to WGS lat
is
y_aux float;
x_aux float;
lat float;
begin
y_aux := (y - 600000)/1000000;
x_aux := (x - 200000)/1000000;
lat := (16.9023892
+ 3.238272 * x_aux
- 0.270978 * power( y_aux, 2 )
- 0.002528 * power( x_aux, 2 )
- 0.0447 * power( y_aux, 2 ) * x_aux
- 0.0140 * power( x_aux, 3 ) );
lat := lat * 100/36;
return lat;
end CHtoWGSlat; -- }
function CHtoWGSlng(y float, x float) return float -- {
-- Convert CH y/x to WGS long
is
y_aux float;
x_aux float;
lng float;
begin
y_aux := (y - 600000)/1000000;
x_aux := (x - 200000)/1000000;
lng := (2.6779094
+ 4.728982 * y_aux
+ 0.791484 * y_aux * x_aux
+ 0.1306 * y_aux * power( x_aux, 2 )
- 0.0436 * power( y_aux, 3 )
);
-- Unit 10000" to 1 " and converts seconds to degrees (dec)
lng := lng * 100/36;
return lng;
end CHtoWGSlng; -- }
function DECtoSEX(angle float) return float -- {
-- Convert decimal angle to sexagesimal seconds
is
deg float;
mnt float;
sec float;
begin
deg := angle;
mnt := (angle-deg)*60;
sec := (((angle-deg)*60)-mnt)*60;
return sec + mnt * 60 + deg * 3600;
end DECtoSEX; -- }
end ch_coordinates_conversion;
/
create or replace package ch_coordinates_conversion as
-- The MIT License (MIT) -- {
--
-- Copyright (c) 2014 Federal Office of Topography swisstopo, Wabern, CH and Joerg Schmidt, Rola AG, Zürich, CH
--
-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
-- in the Software without restriction, including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be included in
-- all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-- THE SOFTWARE.
--
-- Source: http://www.swisstopo.admin.ch/internet/swisstopo/en/home/topics/survey/sys/refsys/projections.html (see PDFs under "Documentation")
--
-- Translated from python to oracle by Joerg Schmidt (Rola AG)
--
-- Please validate your results with NAVREF on-line service: http://www.swisstopo.admin.ch/internet/swisstopo/en/home/apps/calc/navref.html (difference ~ 1-2m) -- }
function WGStoCHy(lat in out float, lng in out float) return float;
function WGStoCHx(lat in out float, lng in out float) return float;
function CHtoWGSlat(y float, x float) return float;
function CHtoWGSlng(y float, x float) return float;
function DECtoSEX(angle float) return float;
-- Convert WGS lat/long (° dec) to CH y
end ch_coordinates_conversion;
/
@rem
@rem This script should create an Oracle Database.
@rem The values specified are quite minimal, on purpose.
@rem The Idea is to have a quick database at hand, when needed.
@rem The created database won't be good enough for a production
@rem database.
@rem
@rem
@rem Most probably, this script should be run as administrator
@rem (cf comment below regarding DIM-00014)
@rem
@ SET ORACLE_HOME=c:\Oracle\product\11.2.0\dbhome_1
@ SET ORACLE_SID=ORA_MANUALLY_CREATED
@ SET DB_NAME=DBMANUAL
@ SET SYSDBA_PASSWORD=IamSysdba
@ SET SYSTEM_PASSWORD=IamSystem
@rem SET Used in 'create database' statement:
@ SET CHARACTER_SET=AL32UTF8
@ SET NATIONAL_CHARACTER_SET=AL16UTF16
@ SET DB_BLOCK_SIZE=8192
@rem SET Where will 'create database' statement go?
@ SET TEMP_DIR=c:\temp
@rem Make sure, correct oradim, sqlplus etc will be invoked.
@rem The variable might already have been set by
@rem Oracle's installer.
@rem SET PATH=%ORACLE_HOME%\bin;%PATH%
@rem 'file root directory'
@rem ----------------------------------------------------
@rem
@rem As we're creating a simple database, we
@rem specify one single root for the files to
@rem be created by the database:
@set DB_FILE_ROOT=c:\tools\Oracle\%DB_NAME%_Files
@rmdir /q /s %DB_FILE_ROOT% > nul
@mkdir %DB_FILE_ROOT%
@rem 'Control Files'
@rem ----------------------------------------------------
@rem
@rem We need to decide for control files.
@rem
@rem The value of this environement variable will be
@rem used when the Initialization Parameter Files are
@rem created.
@rem Currently, only one control file is used.
@rem
@ SET CONTROL_FILES=(%DB_FILE_ROOT%\control_file_01.ctl)
@rem The 'Initialization Parameter File'
@rem ----------------------------------------------------
@rem On Windows, the default directory for the
@rem Initialization Parameter File is: ORACLE_HOME\database
@rem The following environment variable will
@rem point to this location:
@ SET PFILE_PATH=%ORACLE_HOME%\database
@rem
@rem Note: on Unix, the default is ORACLE_HOME/dbs
@rem ----------------------------------------------------
@rem On Windows, the default filename for the
@rem Initialization Parameter File is: initORACLE_SID.ora
@rem The following environment variable will
@rem point to this location:
@set PFILE_NAME=init%ORACLE_SID%.ora
@rem Full Name (path and name) of Initialization Parameter File:
@ SET PFILE=%PFILE_PATH%\%PFILE_NAME%
@rem oh, oh, dangerous: %PFILE_PATH% might contain
@rem other important pfiles
@ REM rmdir /s %PFILE_PATH% 2> nul
@ REM mkdir %PFILE_PATH%
@rem Creating the 'Initialization Parameter File'
@rem ----------------------------------------------------
@echo DB_NAME=%DB_NAME%> %PFILE%
@echo DB_BLOCK_SIZE=%DB_BLOCK_SIZE%>> %PFILE%
@echo CONTROL_FILES=%CONTROL_FILES%>> %PFILE%
@echo UNDO_TABLESPACE=UNDO_TS>> %PFILE%
@rem
@rem TODO: For the following parameter, see http://dba.stackexchange.com/questions/8434
@rem
@rem local_listener='(ADDRESS=(PROTOCOL=TCP)(HOST=localhost)(PORT=1521))' >> %PFILE%
@rem
@rem Create the Oracle Instance.
@rem ----------------------------------------------------
@rem
@rem In Windows, the instance is implemented
@rem as a service.
@ oradim -NEW -SID %ORACLE_SID% -STARTMODE MANUAL
@rem Note:
@rem If the command throws a 'DIM-00014' error message, the
@rem command should be run as administrator
@rem ----------------------------------------------------
@rem The 'Password File'
@rem
@rem The Password File is needed so as to be able
@rem to connect "as sysdba" (see later.)
@rem On Windows, the default directory for the
@rem Password File is: ORACLE_HOME\database (as is for the
@rem Initialization Parameter File).
@rem The following environment variable will
@rem point to this location:
@ SET PWD_PATH=%ORACLE_HOME%\database
@rem Note: on Unix, the default is ORACLE_HOME/dbs
@rem ----------------------------------------------------
@rem On Windows, the default filename for the
@rem Password File is: pwdORACLE_SID.ora
@rem (ORACLE_SID should have been set in 001.sid.bat)
@rem The following environment variable will
@rem point to this location:
@ SET PWD_NAME=pwd%ORACLE_SID%.ora
@rem -----------------------------------
@rem Full Name (path and name) of Password File
@rem
@ SET PWDFILE=%PWD_PATH%\%PWD_NAME%
@ DEL %PWDFILE% 2> nul
@rem Create password file using 'orapwd':
@ orapwd file=%PWDFILE% password=%SYSDBA_PASSWORD%
@rem Create the 'SQL Script' that will create the database
@rem ----------------------------------------------------
@set SCRIPT=%TEMP_DIR%\create_db_script.sql
@echo startup nomount > %SCRIPT%
@REM ---------------------------------------------------
@echo CREATE DATABASE %DB_NAME% >> %SCRIPT%
@echo USER SYS IDENTIFIED BY %SYSDBA_PASSWORD% >> %SCRIPT%
@echo USER SYSTEM IDENTIFIED BY %SYSTEM_PASSWORD% >> %SCRIPT%
@echo LOGFILE GROUP 1 ('%DB_FILE_ROOT%\redo01a.log','%DB_FILE_ROOT%\redo01b.log') SIZE 100M BLOCKSIZE 512, >> %SCRIPT%
@echo GROUP 2 ('%DB_FILE_ROOT%\redo02a.log','%DB_FILE_ROOT%\redo02b.log') SIZE 100M BLOCKSIZE 512 >> %SCRIPT%
@rem currently, only two log file group. At least two are required to prevent
@rem ORA-01518: CREATE DATABASE must specify more than one log file
@rem Make sure to have the commas right when uncommenting the following line:
@rem
@rem @echo GROUP 3 ('%DB_FILE_ROOT%\redo03a.log','%DB_FILE_ROOT%\redo03b.log') SIZE 100M BLOCKSIZE 512 >> %SCRIPT%
@echo -- MAXLOGFILES 5 >> %SCRIPT%
@echo MAXLOGMEMBERS 5 >> %SCRIPT%
@echo MAXLOGHISTORY 1 >> %SCRIPT%
@echo MAXDATAFILES 100 >> %SCRIPT%
@echo CHARACTER SET %CHARACTER_SET% >> %SCRIPT%
@echo NATIONAL CHARACTER SET %NATIONAL_CHARACTER_SET% >> %SCRIPT%
@REM ---------------------------------------------------
@echo EXTENT MANAGEMENT LOCAL >> %SCRIPT%
@echo DATAFILE '%DB_FILE_ROOT%\system01.dbf' SIZE 325M REUSE >> %SCRIPT%
@echo SYSAUX DATAFILE '%DB_FILE_ROOT%\sysaux01.dbf' SIZE 325M REUSE >> %SCRIPT%
@REM ---------------------------------------------------
@echo DEFAULT TABLESPACE users >> %SCRIPT%
@echo DATAFILE '%DB_FILE_ROOT%\users01.dbf' >> %SCRIPT%
@echo SIZE 500M REUSE AUTOEXTEND ON MAXSIZE UNLIMITED >> %SCRIPT%
@REM ---------------------------------------------------
@echo DEFAULT TEMPORARY TABLESPACE temp_ts >> %SCRIPT%
@echo TEMPFILE '%DB_FILE_ROOT%\temp01.dbf' >> %SCRIPT%
@echo SIZE 20M REUSE >> %SCRIPT%
@REM ---------------------------------------------------
@REM -- TODO: NOte UNDO_TS also specified in Initialization Paramter File!
@echo UNDO TABLESPACE undo_ts >> %SCRIPT%
@echo DATAFILE '%DB_FILE_ROOT%\undo01.dbf' >> %SCRIPT%
@echo SIZE 200M REUSE AUTOEXTEND ON MAXSIZE UNLIMITED; >> %SCRIPT%
@REM ---------------------------------------------------
@echo exit >> %SCRIPT%
@ sqlplus sys/%SYSDBA_PASSWORD% as sysdba @%SCRIPT%
@ sqlplus sys/%SYSDBA_PASSWORD% as sysdba @build_data_dictionary.sql
@ sqlplus system/%SYSTEM_PASSWORD% @install_product_user_profile.sql
@rem -------------------------------------------
@rem Create listener service
@ sc create OracleOraDb11g_home1TNSListener binPath= %ORACLE_HOME%\bin\tnslsnr.exe start= demand
@rem The listener service can be deleted with
@rem sc delete OracleOraDb11g_home1TNSListener
@rem
@rem The service can be started with
@rem net start OracleOraDb11g_home1TNSListener
@rem and stopped with
@rem net stop OracleOraDb11g_home1TNSListener
@rem --------------------------------------------
@rem Create tnsadmin.ora file
@echo %DB_NAME%= >> %ORACLE_HOME%\NETWORK\ADMIN\tnsnames.ora
@echo (DESCRIPTION= >> %ORACLE_HOME%\NETWORK\ADMIN\tnsnames.ora
@echo (ADDRESS= >> %ORACLE_HOME%\NETWORK\ADMIN\tnsnames.ora
@echo (PROTOCOL=tcp) >> %ORACLE_HOME%\NETWORK\ADMIN\tnsnames.ora
@echo (HOST=localhost) >> %ORACLE_HOME%\NETWORK\ADMIN\tnsnames.ora
@echo (PORT=1521) >> %ORACLE_HOME%\NETWORK\ADMIN\tnsnames.ora
@echo ) >> %ORACLE_HOME%\NETWORK\ADMIN\tnsnames.ora
@echo (CONNECT_DATA= >> %ORACLE_HOME%\NETWORK\ADMIN\tnsnames.ora
@echo (SID=%ORACLE_SID%) >> %ORACLE_HOME%\NETWORK\ADMIN\tnsnames.ora
@echo (GLOBAL_NAME=%DB_NAME%) >> %ORACLE_HOME%\NETWORK\ADMIN\tnsnames.ora
@echo ) >> %ORACLE_HOME%\NETWORK\ADMIN\tnsnames.ora
@echo ) >> %ORACLE_HOME%\NETWORK\ADMIN\tnsnames.ora
@rem --------------------------------------------
@rem Create listener.ora file
@echo listener=(ADDRESS=(PROTOCOL=tcp)(HOST=localhost)(PORT=1521)) >> %ORACLE_HOME%\NETWORK\ADMIN\listener.ora
-- Must (should?) be run as system.
--
-- Installs the SQL*Plus PRODUCT_USER_PROFILE tables. These
-- tables allow SQL*Plus to disable commands per user. The tables
-- are used only by SQL*Plus and do not affect other client tools
-- that access the database. Refer to the SQL*Plus manual for table
-- usage information.
-- This script should be run on every database that SQL*Plus connects
-- to, even if the tables are not used to restrict commands.
@?/sqlplus/admin/pupbld.sql
exit
create or replace package body debugger as
procedure abort is/*{*/
runinfo dbms_debug.runtime_info;
ret binary_integer;
begin
continue_(dbms_debug.abort_execution);
end abort;/*}*/
procedure backtrace is/*{*/
pkgs dbms_debug.backtrace_table;
i number;
begin
dbms_debug.print_backtrace(pkgs);
i := pkgs.first();
dbms_output.put_line('backtrace');
while i is not null loop
dbms_output.put_line(' ' || i || ': ' || pkgs(i).name || ' (' || pkgs(i).line# ||')');
i := pkgs.next(i);
end loop;
exception
when others then
dbms_output.put_line(' backtrace exception: ' || sqlcode);
dbms_output.put_line(' ' || sqlerrm(sqlcode));
end backtrace;/*}*/
procedure breakpoints is/*{*/
brkpts dbms_debug.breakpoint_table;
i number;
v_line number;
begin
dbms_debug.show_breakpoints(brkpts);
i := brkpts.first();
dbms_output.put_line('');
while i is not null loop
if v_line is not null then
dbms_output.put( to_char(v_line , '99999'));
null;
else
dbms_output.put(' ');
end if;
dbms_output.put( ' ');
dbms_output.put(to_char(i,'999') || ': ');
dbms_output.put(rpad(coalesce(brkpts(i).name, ' '), 31));
dbms_output.put(rpad(coalesce(brkpts(i).owner,' '), 31));
v_line:=brkpts(i).line#;
dbms_output.put( ' ');
dbms_output.put(libunittype_as_string(brkpts(i).libunittype));
dbms_output.put( ' ');
dbms_output.put(bp_status_as_string (brkpts(i).status ));
dbms_output.put_line('');
i := brkpts.next(i);
end loop;
end breakpoints;/*}*/
function libunittype_as_string(lut binary_integer) /*{*/
/*
dbms_debug.continue can be called with the following breakflags:
o break_next_line ( Break at next source line (step over calls) )
o break_any_call ( Break at next source line (step into calls) )
o break_any_return
o break_return
o break_exception
o break_handler
o abort_execution
As the user of debugger might want to use continue with variying breakflags, continue_ (with the
underscore) is the generic wrapper. (I hope this makes sense)
*/
return varchar2 is
begin
if lut = dbms_debug.libunitType_cursor then return 'Cursor'; end if;
if lut = dbms_debug.libunitType_procedure then return 'Proc' ; end if;
if lut = dbms_debug.libunitType_function then return 'Func' ; end if;
if lut = dbms_debug.libunitType_function then return 'Func' ; end if;
if lut = dbms_debug.libunitType_package then return 'Pkg' ; end if;
if lut = dbms_debug.libunitType_package_body then return 'Pkg Bd'; end if;
if lut = dbms_debug.libunitType_trigger then return 'Trig' ; end if;
if lut = dbms_debug.libunitType_unknown then return 'Unk' ; end if;
return '???';
end libunittype_as_string;/*}*/
function bp_status_as_string(bps binary_integer) return varchar2 is/*{*/
-- "User friendly" name for breakpoint_status_*
begin
if bps = dbms_debug.breakpoint_status_unused then return 'unused' ; end if;
if bps = dbms_debug.breakpoint_status_active then return 'active' ; end if;
if bps = dbms_debug.breakpoint_status_disabled then return 'disabled'; end if;
if bps = dbms_debug.breakpoint_status_remote then return 'remote' ; end if;
return '???';
end bp_status_as_string;/*}*/
procedure continue_(break_flags in number) is/*{*/
ret binary_integer;
v_err varchar2(100);
begin
dbms_output.put_line('');
ret := dbms_debug.continue(
cur_line_,
break_flags,
0 +
dbms_debug.info_getlineinfo +
dbms_debug.info_getbreakpoint +
dbms_debug.info_getstackdepth +
dbms_debug.info_getoerinfo +
0);
if ret = dbms_debug.success then
dbms_output.put_line(' reason for break: ' || str_for_reason_in_runtime_info(cur_line_.reason));
if cur_line_.reason = dbms_debug.reason_knl_exit then
return;
end if;
if cur_line_.reason = dbms_debug.reason_exit then
return;
end if;
--print_runtime_info_with_source(cur_line_,cont_lines_before_, cont_lines_after_,cont_lines_width_);
print_source(cur_line_, cont_lines_before_, cont_lines_after_);
elsif ret = dbms_debug.error_timeout then
dbms_output.put_line(' continue: error_timeout');
elsif ret = dbms_debug.error_communication then
dbms_output.put_line(' continue: error_communication');
else
v_err := general_error(ret);
dbms_output.put_line(' continue: general error' || v_err);
end if;
end continue_;/*}*/
procedure detach is/*{*/
begin
dbms_debug.detach_session;
end detach;/*}*/
procedure continue is/*{*/
/*
continue (calling continue_ with break_flags = 0 ) will run until
the program hits a breakpoint
*/
begin
continue_(0);
end continue;/*}*/
procedure delete_bp(breakpoint in binary_integer) is/*{*/
ret binary_integer;
begin
ret := dbms_debug.delete_breakpoint(breakpoint);
if ret = dbms_debug.success then dbms_output.put_line(' breakpoint deleted');
elsif ret = dbms_debug.error_no_such_breakpt then dbms_output.put_line(' No such breakpoint exists');
elsif ret = dbms_debug.error_idle_breakpt then dbms_output.put_line(' Cannot delete an unused breakpoint');
elsif ret = dbms_debug.error_stale_breakpt then dbms_output.put_line(' The program unit was redefined since the breakpoint was set');
else dbms_output.put_line(' Unknown error');
end if;
end delete_bp;/*}*/
procedure print_var(name in varchar2) is/*{*/
ret binary_integer;
val varchar2(4000);
frame number;
begin
frame := 0;
ret := dbms_debug.get_value(
name,
frame,
val,
null);
if ret = dbms_debug.success then dbms_output.put_line(' ' || name || ' = ' || val);
elsif ret = dbms_debug.error_bogus_frame then dbms_output.put_line(' print_var: frame does not exist');
elsif ret = dbms_debug.error_no_debug_info then dbms_output.put_line(' print_var: Entrypoint has no debug info');
elsif ret = dbms_debug.error_no_such_object then dbms_output.put_line(' print_var: variable ' || name || ' does not exist in in frame ' || frame);
elsif ret = dbms_debug.error_unknown_type then dbms_output.put_line(' print_var: The type information in the debug information is illegible');
elsif ret = dbms_debug.error_nullvalue then dbms_output.put_line(' ' || name || ' = NULL');
elsif ret = dbms_debug.error_indexed_table then dbms_output.put_line(' print_var: The object is a table, but no index was provided.');
else dbms_output.put_line(' print_var: unknown error');
end if;
end print_var;/*}*/
procedure start_debugger(debug_session_id in varchar2) is/*{*/
/*
This is the first call the debugging session must make. It, in turn, calls
dbms_debug.attach_session.
After attaching to the session, it waits for the first event (wait_until_running), which is interpreter starting.
*/
begin
dbms_debug.attach_session(debug_session_id);
--cont_lines_before_ := 5;
--cont_lines_after_ := 5;
--cont_lines_width_ := 100;
wait_until_running;
end start_debugger;/*}*/
--function start_debugee return varchar2 as/*{*/
--/* This is the first call the debugged session must make.
--
-- The return value must be passed to the debugging session and used in start_debugger
--*/
-- debug_session_id varchar2(20);
--begin
-- --select dbms_debug.initialize into debug_session_id from dual;
-- debug_session_id := dbms_debug.initialize;
-- dbms_debug.debug_on;
-- return debug_session_id;
--end start_debugee;/*}*/
procedure print_proginfo(prginfo dbms_debug.program_info) as/*{*/
begin
dbms_output.put_line(' Namespace: ' || str_for_namespace(prginfo.namespace));
dbms_output.put_line(' Name: ' || prginfo.name);
dbms_output.put_line(' owner: ' || prginfo.owner);
dbms_output.put_line(' dblink: ' || prginfo.dblink);
dbms_output.put_line(' Line#: ' || prginfo.Line#);
dbms_output.put_line(' lib unit: ' || prginfo.libunittype);
dbms_output.put_line(' entrypoint: ' || prginfo.entrypointname);
end print_proginfo;/*}*/
procedure print_runtime_info(runinfo dbms_debug.runtime_info) as/*{*/
--rsnt varchar2(40);
begin
--rsnt := str_for_reason_in_runtime_info(runinfo.reason);
dbms_output.put_line('');
dbms_output.put_line('Runtime Info');
dbms_output.put_line('Prg Name: ' || runinfo.program.name);
dbms_output.put_line('Line: ' || runinfo.line#);
dbms_output.put_line('Terminated: ' || runinfo.terminated);
dbms_output.put_line('Breakpoint: ' || runinfo.breakpoint);
dbms_output.put_line('Stackdepth ' || runinfo.stackdepth);
dbms_output.put_line('Interpr depth: ' || runinfo.interpreterdepth);
--dbms_output.put_line('Reason ' || rsnt);
dbms_output.put_line('Reason: ' || str_for_reason_in_runtime_info(runinfo.reason));
print_proginfo(runinfo.program);
end print_runtime_info;/*}*/
procedure print_source (/*{*/
runinfo dbms_debug.runtime_info,
lines_before number default 0,
lines_after number default 0
) is
first_line binary_integer;
last_line binary_integer;
prefix varchar2( 99);
suffix varchar2(4000);
--source_lines vc2_table;
source_lines dbms_debug.vc2_table;
cur_line binary_integer;
cur_real_line number;
begin
first_line := greatest(runinfo.line# - cont_lines_before_,1);
last_line := runinfo.line# + cont_lines_after_ ;
if first_line is null or last_line is null then
dbms_output.put_line('first_line or last_line is null');
print_runtime_info(runinfo);
return;
end if;
if runinfo.program.name is not null and runinfo.program.owner is not null then
dbms_output.put_line('');
dbms_output.put_line(' ' || runinfo.program.owner || '.' || runinfo.program.name);
--select
-- cast(multiset(
for r in (
select
-- 90 is the length in dbms_debug.vc2_table....
rownum line,
substr(text,1,90) text
from
all_source
where
name = runinfo.program.name and
owner = runinfo.program.owner and
type <> 'PACKAGE' and
line >= first_line and
line <= last_line
order by
line )-- as vc2_table)
loop
-- into
-- source_lines
-- from
-- dual;
source_lines(r.line) := r.text;
end loop;
else
dbms_debug.show_source(first_line, last_line, source_lines);
-- select
-- cast(
-- multiset(
-- select culumn_value from
-- table(
-- cast(source_lines_dbms as dbms_debug.vc2_table)
-- )
-- )as vc2_table)
-- into
-- source_lines
-- from
-- dual;
end if;
dbms_output.put_line('');
cur_line := source_lines.first();
while cur_line is not null loop
cur_real_line := cur_line + first_line -1;
-- for r in (select column_value text from table(source_lines)) loop
prefix := to_char(cur_real_line,'9999');
if cur_real_line = runinfo.line# then
prefix := prefix || ' -> ';
else
prefix := prefix || ' ';
end if;
-- TODO, most probably superfluos, 90 is the max width.... (ts, ts)
--if length(r.text) > v_lines_width then
-- suffix := substr(r.text,1,v_lines_width);
--else
-- suffix := r.text;
--end if;
suffix := source_lines(cur_line);
suffix := translate(suffix,chr(10),' ');
suffix := translate(suffix,chr(13),' ');
--dbms_output.put_line(prefix || suffix);
dbms_output.put_line(prefix || suffix);
-- line_printed := 'Y';
cur_line := source_lines.next(cur_line);
--cur_line := cur_line + 1;
end loop;
dbms_output.put_line('');
end print_source;/*}*/
procedure print_runtime_info_with_source(/*{*/
runinfo dbms_debug.runtime_info
) is
begin
print_runtime_info(runinfo);
--dbms_output.put_line('line#: ' || runinfo.line#);
--dbms_output.put_line(' - : ' || (runinfo.line# - cont_lines_before_));
--dbms_output.put_line('first_line: ' || first_line);
--dbms_output.put_line('last_line: ' || last_line);
print_source(runinfo);
end print_runtime_info_with_source;/*}*/
procedure self_check as/*{*/
ret binary_integer;
begin
dbms_debug.self_check(5);
exception
when dbms_debug.pipe_creation_failure then dbms_output.put_line(' self_check: pipe_creation_failure');
when dbms_debug.pipe_send_failure then dbms_output.put_line(' self_check: pipe_send_failure');
when dbms_debug.pipe_receive_failure then dbms_output.put_line(' self_check: pipe_receive_failure');
when dbms_debug.pipe_datatype_mismatch then dbms_output.put_line(' self_check: pipe_datatype_mismatch');
when dbms_debug.pipe_data_error then dbms_output.put_line(' self_check: pipe_data_error');
when others then dbms_output.put_line(' self_check: unknown error');
end self_check;/*}*/
procedure set_breakpoint(/*{*/
/*
Out of the four parameters
p_cursor, p_toplevel, p_body, p_trigger,
at most one should be set to zero. They set the
proginfo.namespace
*/
p_line in number, p_name in varchar2 default null, p_owner in varchar2 default null,
p_cursor in boolean default false,
p_toplevel in boolean default false,
p_body in boolean default false,
p_trigger in boolean default false)
as
proginfo dbms_debug.program_info;
ret binary_integer;
bp binary_integer;
begin
if p_cursor then proginfo.namespace := dbms_debug.namespace_cursor;
elsif p_toplevel then proginfo.namespace := dbms_debug.namespace_pkgspec_or_toplevel;
elsif p_body then proginfo.namespace := dbms_debug.namespace_pkg_body;
elsif p_trigger then proginfo.namespace := dbms_debug.namespace_trigger;
else proginfo.namespace := null;
end if;
proginfo.name := p_name;
proginfo.owner := p_owner;
proginfo.dblink := null;
proginfo.entrypointname := null;
ret := dbms_debug.set_breakpoint(
proginfo,
p_line,
bp);
if ret = dbms_debug.success then dbms_output.put_line(' breakpoint set: ' || bp);
elsif ret = dbms_debug.error_illegal_line then dbms_output.put_line(' set_breakpoint: error_illegal_line');
elsif ret = dbms_debug.error_bad_handle then dbms_output.put_line(' set_breakpoint: error_bad_handle');
else dbms_output.put_line(' set_breakpoint: unknown error (' || ret || ')');
end if;
end set_breakpoint;/*}*/
procedure step is/*{*/
begin
continue_(dbms_debug.break_next_line);
end step;/*}*/
procedure step_into is/*{*/
begin
continue_(dbms_debug.break_any_call);
end step_into;/*}*/
procedure step_out is/*{*/
begin
continue_(dbms_debug.break_any_return);
end step_out; /*}*/
function str_for_namespace(nsp in binary_integer) return varchar2 is/*{*/
nsps varchar2(40);
begin
if nsp = dbms_debug.Namespace_cursor then nsps := 'Cursor (anonymous block)';
elsif nsp = dbms_debug.Namespace_pkgspec_or_toplevel then nsps := 'package, proc, func or obj type';
elsif nsp = dbms_debug.Namespace_pkg_body then nsps := 'package body or type body';
elsif nsp = dbms_debug.Namespace_trigger then nsps := 'Triggers';
else nsps := 'Unknown namespace';
end if;
return nsps;
end str_for_namespace;/*}*/
function str_for_reason_in_runtime_info(rsn in binary_integer) return varchar2 is/*{*/
rsnt varchar2(40);
begin
if rsn = dbms_debug.reason_none then rsnt := 'none';
elsif rsn = dbms_debug.reason_interpreter_starting then rsnt := 'Interpreter is starting.';
elsif rsn = dbms_debug.reason_breakpoint then rsnt := 'Hit a breakpoint';
elsif rsn = dbms_debug.reason_enter then rsnt := 'Procedure entry';
elsif rsn = dbms_debug.reason_return then rsnt := 'Procedure is about to return';
elsif rsn = dbms_debug.reason_finish then rsnt := 'Procedure is finished';
elsif rsn = dbms_debug.reason_line then rsnt := 'Reached a new line';
elsif rsn = dbms_debug.reason_interrupt then rsnt := 'An interrupt occurred';
elsif rsn = dbms_debug.reason_exception then rsnt := 'An exception was raised';
elsif rsn = dbms_debug.reason_exit then rsnt := 'Interpreter is exiting (old form)';
elsif rsn = dbms_debug.reason_knl_exit then rsnt := 'Kernel is exiting';
elsif rsn = dbms_debug.reason_handler then rsnt := 'Start exception-handler';
elsif rsn = dbms_debug.reason_timeout then rsnt := 'A timeout occurred';
elsif rsn = dbms_debug.reason_instantiate then rsnt := 'Instantiation block';
elsif rsn = dbms_debug.reason_abort then rsnt := 'Interpreter is aborting';
else rsnt := 'Unknown reason';
end if;
return rsnt;
end str_for_reason_in_runtime_info;/*}*/
procedure wait_until_running as/*{*/
runinfo dbms_debug.runtime_info;
ret binary_integer;
v_err varchar2(100);
begin
ret:=dbms_debug.synchronize( runinfo, 0 /*+
dbms_debug.info_getstackdepth +
dbms_debug.info_getbreakpoint +
dbms_debug.info_getlineinfo +
dbms_debug.info_getoerinfo +
0 */
);
if ret = dbms_debug.success then
print_runtime_info(runinfo);
elsif ret = dbms_debug.error_timeout then
dbms_output.put_line(' synchronize: error_timeout');
elsif ret = dbms_debug.error_communication then
dbms_output.put_line(' synchronize: error_communication');
else
v_err := general_error(ret);
dbms_output.put_line(' synchronize: general error' || v_err);
--dbms_output.put_line(' synchronize: unknown error');
end if;
end wait_until_running;/*}*/
procedure is_running is/*{*/
begin
if dbms_debug.target_program_running then
dbms_output.put_line(' target (debugee) is running');
else
dbms_output.put_line(' target (debugee) is not running');
end if;
end is_running;/*}*/
function general_error(e in binary_integer) return varchar2 is/*{*/
begin
if e = dbms_debug.error_unimplemented then return 'unimplemented' ; end if;
if e = dbms_debug.error_deferred then return 'deferred' ; end if;
if e = dbms_debug.error_exception then return 'probe exception' ; end if;
if e = dbms_debug.error_communication then return 'communication error' ; end if;
if e = dbms_debug.error_unimplemented then return 'unimplemented' ; end if;
if e = dbms_debug.error_timeout then return 'timeout' ; end if;
return '???';
end general_error;/*}*/
procedure version as/*{*/
major binary_integer;
minor binary_integer;
begin
dbms_debug.probe_version(major,minor);
dbms_output.put_line(' probe version is: ' || major || '.' || minor);
end version;/*}*/
procedure current_prg is/*{*/
ri dbms_debug.runtime_info;
pi dbms_debug.program_info;
ret binary_integer;
begin
ret := dbms_debug.get_runtime_info(
0 +
dbms_debug.info_getlineinfo +
dbms_debug.info_getbreakpoint +
dbms_debug.info_getstackdepth +
dbms_debug.info_getoerinfo +
0,
ri);
pi := ri.program;
print_proginfo(pi);
end current_prg;/*}*/
begin
cont_lines_before_ := 5;
cont_lines_after_ := 5;
end debugger;
/
create or replace package debugger as
/*
Package debugger (spec.plsql and body.plsql)
Copyright (C) René Nyffenegger
This source code is provided 'as-is', without any express or implied
warranty. In no event will the author be held liable for any damages
arising from the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this source code must not be misrepresented; you must not
claim that you wrote the original source code. If you use this source code
in a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original source code.
3. This notice may not be removed or altered from any source distribution.
René Nyffenegger rene.nyffenegger@adp-gmbh.ch
*/
procedure abort;
procedure backtrace;
-- highly expermiental
procedure current_prg;
procedure breakpoints;
procedure continue_(break_flags in number);
procedure continue;
procedure delete_bp(breakpoint in binary_integer);
procedure print_var(name in varchar2);
procedure start_debugger(debug_session_id in varchar2);
--function start_debugee return varchar2;
procedure print_proginfo(prginfo dbms_debug.program_info);
procedure print_runtime_info(runinfo dbms_debug.runtime_info);
procedure print_source(
runinfo dbms_debug.runtime_info,
lines_before number default 0,
lines_after number default 0
);
procedure print_runtime_info_with_source(
runinfo dbms_debug.runtime_info
--v_lines_before in number,
--v_lines_after in number,
-- v_lines_width in number
);
procedure self_check;
procedure set_breakpoint(p_line in number, p_name in varchar2 default null, p_owner in varchar2 default null,
p_cursor in boolean default false,
p_toplevel in boolean default false,
p_body in boolean default false,
p_trigger in boolean default false);
procedure step;
procedure step_into;
procedure step_out;
function str_for_namespace(nsp in binary_integer) return varchar2;
function str_for_reason_in_runtime_info(rsn in binary_integer) return varchar2;
procedure wait_until_running;
procedure is_running;
procedure version;
procedure detach;
function libunittype_as_string(lut binary_integer) return varchar2;
function bp_status_as_string(bps binary_integer) return varchar2;
function general_error(e in binary_integer) return varchar2;
-- the following vars are used whenever continue returnes and shows
-- the lines arount line
cont_lines_before_ number;
cont_lines_after_ number;
--cont_lines_width_ number;
--Store the current line of execution
cur_line_ dbms_debug.runtime_info;
end debugger;
/
-- Starts the debugger, asks for a string that identifies
-- the debugee. This string is obtained through running dbe.
exec debugger.start_debugger('&debugee_id')
create or replace package debugged_package as/*{*/
function tst_1(i in integer) return integer;
function tst_2(i in integer) return integer;
end debugged_package;/*}*/
/
create or replace package body debugged_package as/*{*/
function tst_1(i in integer) return integer is/*{*/
begin
if i between 5 and 10 then
return 2*i;
end if;
if i between 0 and 4 then
return tst_2(3+i);
end if;
if i between 6 and 10 then
return tst_2(i-2);
end if;
return i;
end tst_1;/*}*/
function tst_2(i in integer) return integer is/*{*/
begin
if i between 6 and 8 then
return tst_1(i-1);
end if;
if i between 1 and 5 then
return i*2;
end if;
return i-1;
end tst_2;/*}*/
end debugged_package;/*}*/
/
alter package debugged_package compile debug;
create or replace package body desc_table as
function describe(table_name in varchar2) return description is /*{*/
-- used for dbms_utility.name_resolve:
util_context number := 2;
util_schema varchar2(30);
util_part1 varchar2(30);
util_part2 varchar2(30);
util_dblink varchar2(128);
util_part1_type number;
util_object_number number;
tab table_t;
begin
dbms_utility.name_resolve(table_name, util_context, util_schema, util_part1, util_part2, util_dblink, util_part1_type, util_object_number);
tab.own := util_schema;
tab.nam := util_part1;
return describe(tab);
exception
when others then
case
when sqlcode = -6564 then
raise table_does_not_exist;
else
dbms_output.put_line('exception: ' || sqlerrm || '(' || sqlcode || ')' );
end case;
end describe;/*}*/
function describe(tab in table_t) return description is/*{*/
col_r col_t;
ret description;
v_table_name varchar2(30);
v_table_owner varchar2(30);
col_pos number;
begin
ret.tab := tab;
ret.cols := cols_t ();
ret.col_comments := col_comments_t();
ret.parents := tables_t ();
ret.children := tables_t ();
select comments,table_type into ret.tab_comment, ret.tab_type from all_tab_comments
where table_name = tab.nam and owner = tab.own;
col_pos := 1;
for r in (/*{*/
select
t.column_name, t.data_type, t.data_length, t.data_precision, t.data_scale, t.nullable, c.comments
from
all_tab_cols t join all_col_comments c on
t.table_name = c.table_name and
t.column_name = c.column_name and
t.owner = c.owner
where
t.table_name = tab.nam and t.owner = tab.own
order by
column_id) loop
col_r.name := r.column_name;
col_r.nullable := case when r.nullable = 'Y' then true else false end;
col_r.datatype := r.data_type;
col_r.checks := check_t();
if r.data_length is not null and r.data_precision is null then
if r.data_type <> 'DATE' then
col_r.datatype := col_r.datatype || '(' || r.data_length || ')';
end if;
end if;
if r.data_precision is not null then
col_r.datatype := col_r.datatype || '(' || r.data_precision;
if r.data_scale is not null and r.data_scale > 0 then
col_r.datatype := col_r.datatype || ',' || r.data_scale;
end if;
col_r.datatype := col_r.datatype || ')';
end if;
ret.cols.extend;
ret.cols(ret.cols.count) := col_r;
if r.comments is not null then
ret.col_comments.extend;
ret.col_comments(ret.col_comments.count).pos := col_pos;
ret.col_comments(ret.col_comments.count).comment := r.comments;
end if;
col_pos := col_pos+1;
end loop;/*}*/
for r in (/*{ Find Constraints */
select
r_owner, constraint_name, r_constraint_name, constraint_type, search_condition
from
all_constraints
where
table_name = tab.nam and owner = tab.own) loop
if r.constraint_type = 'P' then
for c in (
select column_name, table_name, position
from all_cons_columns
where constraint_name = r.constraint_name) loop
ret.pks(c.column_name) := c.position;
end loop;
select distinct /* distinct in case a table has two foreign keys to table */
owner, table_name bulk collect into ret.children
from
all_constraints
where
r_constraint_name = r.constraint_name and
owner = tab.own;
elsif r.constraint_type = 'R' then -- foreign key
select owner, table_name into v_table_owner, v_table_name
from all_constraints
where constraint_name = r.r_constraint_name and owner = r.r_owner;
ret.parents.extend;
ret.parents(ret.parents.count).own := v_table_owner;
ret.parents(ret.parents.count).nam := v_table_name;
end if;
end loop;/*}*/
return ret;
end describe;/*}*/
end;
/
create or replace package desc_table
/*
Package desc_table (spec.plsql and body.plsql)
Copyright (C) René Nyffenegger
This source code is provided 'as-is', without any express or implied
warranty. In no event will the author be held liable for any damages
arising from the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this source code must not be misrepresented; you must not
claim that you wrote the original source code. If you use this source code
in a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original source code.
3. This notice may not be removed or altered from any source distribution.
René Nyffenegger rene.nyffenegger@adp-gmbh.ch
*/
authid current_user
as
table_does_not_exist exception;
pragma exception_init(table_does_not_exist, -20010);
--TODO: well, long is deprecated, isn't it?
type check_t is table of long;
type col_t is record (name varchar2(30), nullable boolean, datatype varchar2(106), checks check_t);
type cols_t is table of col_t;
type col_comment_t is record (pos number, comment user_tab_comments.comments%type);
type col_comments_t is table of col_comment_t;
type table_t is record (own varchar2(30), nam varchar2(30));
type tables_t is table of table_t;
type char_to_number is table of number(2) index by varchar2(30);
type description is record (tab table_t,
tab_type user_tab_comments.table_type%type, -- 'TABLE', 'VIEW' ..?
tab_comment user_tab_comments.comments%type,
cols cols_t,
col_comments col_comments_t,
pks char_to_number, -- Position of primary keys
parents tables_t,
children tables_t);
-- table_name: 61 chars maximum: 30 chars schema (optional), 1 char dot (optional), 30 chars username
function describe(table_name in varchar2) return description;
function describe(tab in table_t ) return description;
end desc_table;
/
--
-- If invoked with two apetales (@@): path is relative to
-- directory where file_to_table.sql resides.
-- Could be %SQLPATH%
--
-- Compare test_02.sql
--
begin
for r in (
@@file_to_table.sql ..\file_to_table\test_01.sql
) loop
dbms_output.put_line(r.linetext);
end loop;
end;
/
--
-- If invoked with one apetales (@): path is relative to
-- current directory.
--
-- Compare test_02.sql
begin
for r in (
@file_to_table.sql test_02.sql
) loop
dbms_output.put_line(r.linetext);
end loop;
end;
/
create global temporary table tmp_file_to_table (
linenumber number(7),
linetext varchar2(4000)
)
on commit delete rows;
comment on table tmp_file_to_table is 'This table is used in conjunction with the %SQLPATH%/file_to_table.sql and %SQLPATH%/file_to_table.bat files.';
connect / as sysdba
create user ipc_user identified by ipc_user;
grant
create procedure,
create session,
select_catalog_role
to
ipc_user;
-- Don't directly grant:
--
-- grant select on v_$process to ipc_user;
-- grant select on v_$session to ipc_user;
connect ipc_user/ipc_user
-- User ipc_user may select from v$process
select count(*) from v$process;
create or replace function tq84_proc_memory return varchar2 as
v_result varchar2(200);
begin
select
'Used: ' || round(pga_used_mem /1024/1024)||', '||
'Alloc: ' || round(pga_alloc_mem /1024/1024)||', '||
'Freeable: ' || round(pga_freeable_mem/1024/1024)||', '||
'PGA Max: ' || round(pga_max_mem /1024/1024)
into
v_result
from
v$process
where
addr = (select paddr from v$session where sid =
sys_context('USERENV','SID'));
return v_result;
end tq84_proc_memory;
/
-- function tq84_proc_memory does not compile:
show errors
-- LINE/COL ERROR
-- -------- -----------------------------------------------------------------
-- 5/5 PL/SQL: SQL Statement ignored
-- 15/33 PL/SQL: ORA-00942: table or view does not exist
-- It would compile, if grants on v$* were directly given:
-- grant select on v_$process to ipc_user /
-- grant select on v_$session to ipc_user.
connect / as sysdba
grant execute on dbms_job to ipc_user;
grant execute on dbms_pipe to ipc_user;
grant create job to ipc_user;
connect ipc_user/ipc_user
@IPC.pks
@IPC.pkb
create or replace function tq84_proc_memory return varchar2 as
v_proc varchar2(32000);
begin
v_proc := q'!
declare
x varchar2(200);
begin
select
'Used: ' || round(pga_used_mem /1048576)||', '||
'Alloc: ' || round(pga_alloc_mem /1048576)||', '||
'Freeable: ' || round(pga_freeable_mem/1048576)||', '||
'PGA Max: ' || round(pga_max_mem /1048576)
into
x
from
v$process
where
addr = (select paddr from v$session where sid = !' ||
sys_context('USERENV','SID') || q'!);
:result := x;
end;!';
return ipc.exec_plsql_in_other_session(v_proc);
end tq84_proc_memory;
/
show errors
select tq84_proc_memory from dual;
select ipc.exec_plsql_in_other_session('begin :result := user; end;') from dual;
connect / as sysdba
drop user ipc_user cascade;
create or replace package ipc as
-- $Id: ipc.sps 16460 2014-11-19 09:27:54Z tq84 $
function exec_plsql_in_other_session(plsql in varchar2, maxwait_seconds in number := 1) return varchar2;
end ipc;
/
create or replace package mailer is
procedure auth_login(
smtp in out utl_smtp.connection,
username in varchar2,
password in varchar2);
procedure header (
smtp in out utl_smtp.connection,
mail_addr_from in varchar2,
mail_addr_to in varchar2,
subject in varchar2);
procedure html(smtp in out utl_smtp.connection,
html in varchar2);
procedure attachment(
smtp in out utl_smtp.connection,
filename in varchar2,
content in blob);
procedure end_mail(
smtp in out utl_smtp.connection);
end mailer;
/
create or replace package body operation_log as
type num_t is table of number;
parent_ids num_t := num_t();
procedure log_insert( -- {
p_txt varchar2,
p_is_exception varchar2 :='N',
p_back_trace varchar2 := null,
p_clob clob := null
) is
pragma autonomous_transaction;
v_back_trace varchar2(4000);
v_caller call_stack.who_am_i_r := call_stack.who_am_i(2);
v_parent_id number;
begin
if parent_ids.count > 0 then
v_parent_id := parent_ids(parent_ids.count);
end if;
insert into operation_log_table values (operation_log_seq.nextval, sysdate, p_txt,
v_caller.type_,
substr(v_caller.name_, 1, 30), -- TODO 2016-11-22: This substr is necessarey because of »0X459AF82320 40 ANONYMOUS BLOCK«
v_caller.pkg_name,
v_caller.line,
v_caller.owner,
p_is_exception, v_parent_id, p_back_trace,
p_clob
);
commit;
end log_insert; -- }
procedure log_(txt varchar2, is_exception boolean := false, clob_ clob := null) is -- {
v_is_exception varchar2(1) := 'N';
v_back_trace varchar2(4000);
begin
if is_exception then
v_is_exception := 'Y';
v_back_trace := dbms_utility.format_error_backtrace;
end if;
log_insert(txt, p_is_exception => v_is_exception, p_back_trace => v_back_trace, p_clob => clob_);
end log_; -- }
procedure indent(txt varchar2) is -- {
begin
log_insert(txt);
parent_ids.extend;
parent_ids(parent_ids.count) := operation_log_seq.currval;
end indent; -- }
procedure dedent(txt varchar2 := null) is -- {
begin
if parent_ids.count > 0 then
parent_ids.trim;
else
log_insert('Warning: dedent called but parent_ids.count = 0');
end if;
if txt is not null then
log_insert(txt);
end if;
end dedent; -- }
procedure exc(txt varchar2 := null) is -- {
begin
if sqlcode = c_ex_num then
dedent(txt);
else
log_(sqlerrm, is_exception => true);
dedent(txt);
end if;
raise_application_error(c_ex_num, sqlerrm);
end exc; -- }
procedure print_id_recursively(p_id number, p_level number := 0, p_curly_braces boolean := false) is -- {
v_first boolean := true;
v_tm varchar2(21);
v_txt varchar2(4000);
v_caller_type operation_log_table.caller_type %type;
v_caller_name operation_log_table.caller_name %type;
v_caller_pkg_name operation_log_table.caller_pkg_name %type;
v_caller_line operation_log_table.caller_line %type;
v_caller_owner operation_log_table.caller_owner %type;
v_cnt_children number;
c_txt_width constant number := 120;
c_caller_width constant number := 150;
v_clob varchar(8);
begin
select to_char(tm, 'yyyy-mm-dd hh24:mi:ss'), txt, caller_type, caller_name, caller_pkg_name, caller_line, caller_owner,case when clob_ is not null then ' -clob- ' else ' ' end
into v_tm ,v_txt,v_caller_type,v_caller_name,v_caller_pkg_name,v_caller_line,v_caller_owner,v_clob
from operation_log_table
where id = p_id;
select count(*) into v_cnt_children from operation_log_table where id_parent = p_id;
dbms_output.put( substr(rpad(
lpad(' ', p_level * 2) ||
replace(
replace(
replace(v_txt, chr( 10), ' '),
chr(123), ' '), -- opening curly brace
chr(125), ' '), -- closing curly brace
c_caller_width),
1, c_txt_width
) || ' ' ||
&tq84_prefix.string_op.sprintf('%8s %s %-30s %-30s %4d %-30s',
v_clob ,
v_tm ,
v_caller_name ,
v_caller_pkg_name ,
v_caller_line ,
v_caller_owner
));
if p_curly_braces and v_cnt_children > 0 then
dbms_output.put_line(' ' || chr(123));
else
dbms_output.put_line('');
end if;
for r in (select id from operation_log_table where id_parent = p_id order by id) loop
print_id_recursively(r.id, p_level + 1, p_curly_braces => p_curly_braces);
end loop;
if p_curly_braces then
if v_cnt_children > 0 then
dbms_output.put_line(lpad(' ', (p_level) * 2) || chr(125));
end if;
end if;
end print_id_recursively; -- }
procedure find_last_root_ids(p_count number := 20) is -- {
begin
for r in (
select id, tm from (
select id, tm, row_number() over (order by id desc) r
from operation_log_table
where id_parent is null
order by id desc
)
where r <= p_count
) loop
dbms_output.put_line(to_char(r.id, '9999999') || ': ' || to_char(r.tm, 'dd.mm.yyyy hh24:mi:ss'));
end loop;
end find_last_root_ids; -- }
end operation_log;
/
show errors
drop table plan_table purge;
@?/rdbms/admin/utlxplan.sql
drop table plan2html_t purge;
create table plan2html_t (
seq number unique,
html varchar2(4000)
);
drop sequence plan2html_seq;
create sequence plan2html_seq;
create or replace package body plan2html as
nbsp constant varchar2(6) := chr(38) || 'nbsp;';
procedure write_out(html varchar2) is -- {
begin
insert into plan2html_t values(plan2html_seq.nextval, html);
end write_out; -- }
procedure explained_stmt_to_table(stmt_id varchar2) is -- {
c_show_projection constant boolean := false;
procedure show_step(stmt_id varchar2, pid number, lvl number) is -- {
object_id varchar2(4000);
v_rowspan number;
padding_left varchar2(4000);
procedure td(text varchar2, attr varchar2:=null) is -- {
attr_ varchar2(4000);
begin
if attr is not null then
attr_ := ' ' || attr;
end if;
write_out('<td' || attr_ || '>' || text || '</td>');
end td; -- }
begin
for step in (select * from plan_table where statement_id = stmt_id and nvl(parent_id, -999) = nvl(pid, -999) order by position) loop
v_rowspan := 1;
if c_show_projection then
v_rowspan := v_rowspan + 1;
end if;
padding_left := 'padding-left:' || (lvl * 20) || 'px';
if step.filter_predicates is not null then
v_rowspan := v_rowspan + 1;
end if;
if step.access_predicates is not null then
v_rowspan := v_rowspan + 1;
end if;
write_out('<tr>'); -- {
if lvl != step.depth then
raise_application_error(-20800, 'Wrong assumption lvl=' || lvl || ', depth=' || step.depth || '!');
end if;
td(step.id, 'rowspan=' || v_rowspan || ' style=''vertical-align:top; color:grey''');
if step.object_name is not null then -- {
object_id := ' <b>' || lower(step.object_owner || '.' || step.object_name) || '</b>';
end if; -- }
if step.object_node is not null then -- {
object_id := object_id || '@' || lower(step.object_node);
end if; -- }
if step.object_alias is not null then -- {
if object_id is not null then
object_id := ' ' || object_id;
end if;
object_id := object_id || ' [' || lower(step.object_alias) || ']';
end if; -- }
td(lower(step.operation) || ' ' || lower(step.options) || object_id, 'colspan=2 style=''' || padding_left || '''');
td(lower(step.object_type));
td( step.object_instance);
td( step.cardinality, 'style=''text-align: right''');
td( step.cost || ' [' || step.cpu_cost || '+' || step.io_cost || ']');
td( step.bytes , 'style=''text-align: right''');
td( step.temp_space, 'style=''text-align: right''');
td( step.time);
td( step.qblock_name); -- Name of the query block (either system-generated or defined by the user with the QB_NAME hint)
td( step.partition_start || ' - ' || step.partition_stop || ' [' || step.partition_id || ']');
td( step.distribution);
-- td('xml: ' || step.other_xml);
-- td('Other: ' || step.other_tag);
td( step.optimizer); -- ALL_ROWS, ANALYZED ...
td(step.search_columns); -- Number of index columns with start and stop keys (that is: the number of columns with matching predicates)
write_out('</tr>'); -- }
if c_show_projection then -- {
write_out('<tr>');
td('');
td('Proj: ' || step.projection, 'colspan=14');
write_out('</tr>');
end if; -- }
if step.filter_predicates is not null then -- {
write_out('<tr>');
td('<span style=''color:grey''>' || replace(substr(step.filter_predicates, 1, 3950), '"', '') || '</span>', 'colspan=14 style=''' || padding_left || '''');
write_out('</tr>');
end if; -- }
if step.access_predicates is not null then -- {
write_out('<tr>');
td('<span style=''color:grey''>' || replace(substr(step.access_predicates, 1, 3950), '"', '') || '</span>', 'colspan=14 style=''' || padding_left || '''');
write_out('</tr>');
end if; -- }
show_step(stmt_id, step.id, lvl+1);
end loop;
end show_step; -- }
begin
write_out('<table border=0 style=''border:black solid 1px''>');
write_out('<tr style=''background-color:#ecdcff''><td></td><td></td><td></td><td>Typ</td><td>Inst</td><td>Card</td><td>Cost</td><td>Bytes</td><td>Temp</td><td>Time</td><td>qblck</td><td>Part</td><td>Dist</td><td>Opt</td><td>S.C.</td></tr>');
show_step(stmt_id, null, 0);
write_out('</table>');
end explained_stmt_to_table; -- }
end plan2html;
/
show errors
@plan2html.pkb
delete plan2html_t;
delete from plan_table where statement_id = 'TEST-01';
explain plan set statement_id='TEST-01' for select * from all_objects where object_name like :1;
exec plan2html.explained_stmt_to_table ('TEST-01');
$del c:\temp\expl.html
@spool c:\temp\expl.html
select html from plan2html_t order by seq;
select '<code><pre>' from dual;
select * from table(dbms_xplan.display(statement_id => 'TEST-01'));
select '</pre></code>' from dual;
@spool_off
$\temp\expl.html
create or replace package body plscope as
-- Used if it is necessary to prevent circles, for example
-- in find_call_path_recurse.
type signatures_seen_t is table of number(1) index by signature_;
counter number := 0;
procedure dot_call(caller in varchar2, callee in varchar2) is/*{*/
begin
dbms_output.put_line(' "' || caller || '" -> "' || callee || '"');
end dot_call;/*}*/
procedure gexf_call(caller in varchar2, callee in varchar2) is/*{*/
begin
dbms_output.put_line(' <edge source="' || caller || '" target="' || callee || '"/>');
end gexf_call;/*}*/
procedure fill_callable(owner_ in varchar2, delete_existing in boolean) is/*{*/
begin
if delete_existing then
delete plscope_callable;
end if;
insert into plscope_callable
(signature, object_name, name, exclude)
select signature, object_name, name, 0
from all_identifiers
where ( ( type in ('PROCEDURE', 'FUNCTION' ) and usage = 'DEFINITION' ) or
( type in ('CURSOR' , 'PACKAGE', 'PACKAGE BODY' ) and usage = 'DECLARATION')
)
and owner = owner_;
end fill_callable;/*}*/
procedure fill_call(owner_ in varchar2, delete_existing in boolean) is/*{*/
callers signature_t_;
begin
if delete_existing then
delete plscope_call;
end if;
fill_callable(owner_, delete_existing);
for callable in (select signature from plscope_callable /* TODO: where owner = owner_ */) loop
callers := who_calls(callable.signature);
for i in 1 .. callers.count loop
begin
insert into plscope_call (caller, callee) values (callers(i), callable.signature);
exception when others then
-- raise_application_error(-20801, sqlerrm || ': ' || callers(i) || ' ' || callable.signature);
dbms_output.put_line (sqlerrm || ': ' || callers(i) || ' ' || callable.signature);
end;
end loop;
end loop;
end fill_call;/*}*/
procedure print_dot_graph is/*{*/
begin
dbms_output.put_line('digraph G {');
for call in (
select
caller.object_name object_name_caller,
caller.name name_caller,
' -> ',
callee.object_name object_name_callee,
callee.name name_callee
from
plscope_call call
join plscope_callable caller on call.caller = caller.signature
join plscope_callable callee on call.callee = callee.signature
) loop
dot_call(call.object_name_caller || '.' || call.name_caller, call.object_name_callee || '.' || call.name_callee);
end loop;
dbms_output.put_line('}');
end print_dot_graph;/*}*/
procedure print_upwards_graph(sig signature_, format in varchar2) is /*{*/
begin
--
-- Use ../sqlpath/ps_upwards.sql to create a dot file and
-- render it's content.
--
if lower(format) = 'dot' then
dbms_output.put_line('digraph G ' || chr(123));
dbms_output.put_line(' graph [overlap=false size="11.7,16.5"];');
dbms_output.put_line(' node [shape=plaintext fontsize=11 fontname="Arial Narrow"];'); -- shape=record
elsif lower(format) = 'gefx' then
--
-- Fileformat: see http://gexf.net/format/
--
dbms_output.put_line('<?xml version="1.0" encoding="UTF-8"?>');
dbms_output.put_line('<gexf xmlns="http://www.gexf.net/1.2draft" version="1.2">');
dbms_output.put_line('<edges>');
end if;
for r in (
with c (complete_name_caller, complete_name_callee, signature_caller, level_) as (
------
-- Recursive query:
-- First "iteration" get the direct callers of the desired signature_ (parameter sig):
--
select complete_name_caller,
complete_name_callee,
signature_caller,
0 level_ -- First iteration, "level" is 0
from plscope_call_v xx
where xx.signature_callee = sig
UNION ALL
--
-- Itaration:
-- get the callers of all calls that had been identified
-- by the prior iteration:
--
select yy.complete_name_caller,
yy.complete_name_callee,
yy.signature_caller,
cc.level_ + 1 level_ -- Next iteration, increase level
from c cc join plscope_call_v yy on
yy.signature_callee = cc.signature_caller and
yy.exclude_caller = 0
)
--search depth first by c.object_name_caller set sorting
cycle signature_caller set is_cycle to 1 default 0
select distinct complete_name_caller, complete_name_callee, signature_caller /*, is_cycle */ from c
where
is_cycle = 0 /*and
level_ < 5*/
) loop
if lower(format) = 'dot' then
dot_call(r.complete_name_caller, r.complete_name_callee);
else
gexf_call(r.complete_name_caller, r.complete_name_callee);
end if;
end loop;
if lower(format) = 'dot' then
dbms_output.put_line(chr(125));
elsif lower(format) = 'gefx' then
dbms_output.put_line('</edges>');
dbms_output.put_line('</gexf>');
end if;
end print_upwards_graph;/*}*/
procedure print_downwards_graph(sig signature_, format in varchar2) is /*{*/
begin
--
-- Use ../sqlpath/ps_downwards.sql to create a dot file and
-- render it's content.
--
if lower(format) = 'dot' then
dbms_output.put_line('digraph G ' || chr(123));
dbms_output.put_line(' graph [overlap=false size="11.7,16.5"];');
dbms_output.put_line(' node [shape=plaintext fontsize=11 fontname="Arial Narrow"];'); -- shape=record
elsif lower(format) = 'gefx' then
--
-- Fileformat: see http://gexf.net/format/
--
dbms_output.put_line('<?xml version="1.0" encoding="UTF-8"?>');
dbms_output.put_line('<gexf xmlns="http://www.gexf.net/1.2draft" version="1.2">');
dbms_output.put_line('<edges>');
end if;
for r in (
with c (complete_name_caller, complete_name_callee, signature_callee, level_) as (
------
-- Recursive query:
-- First "iteration" get the direct callees of the desired signature_ (parameter sig):
--
select complete_name_caller,
complete_name_callee,
signature_callee,
0 level_ -- First iteration, "level" is 0
from plscope_call_v xx
where xx.signature_caller = sig and
xx.exclude_callee = 0
UNION ALL
--
-- Iteration:
-- get the callees of all calls that had been identified
-- by the prior iteration:
--
select yy.complete_name_caller,
yy.complete_name_callee,
yy.signature_callee,
cc.level_ + 1 level_ -- Next iteration, increase level
from c cc join plscope_call_v yy on
yy.signature_caller = cc.signature_callee
where yy.exclude_caller = 0 and
yy.exclude_callee = 0
)
--search depth first by c.object_name_caller set sorting
cycle signature_callee set is_cycle to 1 default 0
select distinct complete_name_caller, complete_name_callee, signature_callee /*, is_cycle */ from c
where
is_cycle = 0 /*and
level_ < 5*/
) loop
if lower(format) = 'dot' then
dot_call(r.complete_name_caller, r.complete_name_callee);
else
gexf_call(r.complete_name_caller, r.complete_name_callee);
end if;
end loop;
if lower(format) = 'dot' then
dbms_output.put_line(chr(125));
elsif lower(format) = 'gefx' then
dbms_output.put_line('</edges>');
dbms_output.put_line('</gexf>');
end if;
end print_downwards_graph;/*}*/
function find_call_path_recurse(sig_from signature_, sig_to signature_, sigs_seen in out nocopy signatures_seen_t) return boolean/*{*/
is
found_at_least_one boolean := false;
begin
counter := counter + 1;
if counter > 1000 then
return false;
end if;
-- Check if this function had already been called with the
-- 'current' value of sig_from:
if sigs_seen.exists(sig_from) then
-- Yes, already been called, return so as not to
-- recurse infinitely (or at least until there's a
-- stack problem).
return false;
end if;
-- Mark the 'current' signature as seen, see check above:
sigs_seen(sig_from) := 1;
for call in (
select
complete_name_caller,
complete_name_callee,
signature_callee
from
plscope_call_v
where
signature_caller = sig_from
) loop
if call.signature_callee = sig_to then
dot_call(call.complete_name_caller, call.complete_name_callee);
found_at_least_one := true;
else
if find_call_path_recurse(call.signature_callee, sig_to, sigs_seen) then
dot_call(call.complete_name_caller, call.complete_name_callee);
found_at_least_one := true;
end if;
end if;
end loop;
return found_at_least_one;
end find_call_path_recurse;/*}*/
procedure find_call_path(sig_from signature_, sig_to signature_)/*{*/
is
-- Try to find a call path from a 'callable' to another 'callable',
-- possibly via more than one hop.
call_count number;
sigs_seen signatures_seen_t;
dummy boolean;
begin
dbms_output.put_line('digraph G {');
dbms_output.put_line(' node [shape=plaintext fontsize=11 fontname="Arial Narrow"];');
dummy := find_call_path_recurse(sig_from, sig_to, sigs_seen);
dbms_output.put_line('}');
end find_call_path;/*}*/
procedure find_definition (/*{*/
-- In:
obj_ in varchar2, owner_ in varchar2, obj_typ_ in varchar2, usage_id_ in number,
--- Out:
sig out signature_/*, nam_ out varchar2*/
)
is
wait_for_definition varchar2(30) := '?';
wait_for_type varchar2(30) := '?';
usage_id_l number;
begin
usage_id_l := usage_id_;
while usage_id_l != 0 and (wait_for_definition != 'DEFINITION' or wait_for_type not in ('FUNCTION', 'PROCEDURE', 'CURSOR', 'PACKAGE', 'PACKAGE BODY')) loop
select signature, usage /*, name*/, type , usage_context_id
into sig , wait_for_definition/*, nam_*/, wait_for_type , usage_id_l
from
all_identifiers where usage_id = usage_id_l and
object_name = obj_ and
owner = owner_ and
object_type = obj_typ_;
end loop;
exception when others then
dbms_output.put_line('find_definition: obj: ' || obj_ || ' / ' || obj_typ_ || ', usage_id: ' || usage_id_ || ',' || usage_id_l);
dbms_output.put_line(' ' || sqlerrm);
sig := null;
end find_definition ;/*}*/
function who_calls(sig_called signature_) return signature_t_ is/*{*/
caller_sig signature_;
ret signature_t_ := signature_t_();
begin
for caller in (
select object_name, owner, object_type, usage_context_id from all_identifiers
where signature = sig_called and
usage ='CALL'
) loop
find_definition(
-- In:
caller.object_name,
caller.owner,
caller.object_type,
caller.usage_context_id,
-- Out:
caller_sig/*, caller_nam*/);
if caller_sig is not null then
ret.extend;
ret(ret.count) := caller_sig;
else
dbms_output.put_line('find_definition failed for ' || caller.object_name || ' ' || caller.object_type || ' ' || caller.usage_context_id || ' ' || sig_called);
end if;
end loop;
return ret;
end who_calls;/*}*/
procedure gather_identifiers is/*{*/
begin
execute immediate q'!alter session set plscope_settings='IDENTIFIERS:ALL'!';
for i in 1 .. 2 loop
--
-- For a reason I don't really understand, the loop needs to run twice,
-- as otherwise not all identifiers are collected correctly.
for o in (
select object_type, object_name from user_objects
where object_type in ('PACKAGE', 'TYPE', 'FUNCTION', 'PROCEDURE', 'TRIGGER') and
object_name not in ('PLSCOPE')
) loop
begin
execute immediate 'alter ' || o.object_type || ' ' || o.object_name || ' compile';
exception when others then
dbms_output.new_line;
dbms_output.put_line (sqlerrm);
dbms_output.put_line (' ' || o.object_name || ' (' || o.object_type || ')');
end;
end loop;
end loop;
end gather_identifiers;/*}*/
end plscope;
/
--
-- Displays the hierarchical relationship of identifiers
-- in a package that has been compiled with PL/Scope enabled.
--
-- alter session set plscope_settings='IDENTIFIERS:ALL'
--
-- alter package ... compile;
--
----------------
with package_identifier_hier
(line, col, identifier, type, usage, usage_id, usage_context_id, object_name, object_type, owner, indent)
as (
select line,
col,
name identifier,
type,
usage,
usage_id,
usage_context_id,
object_name,
object_type,
owner,
0 indent
from all_identifiers
where owner = user and
object_name = '&OBJECT_NAME' and
object_type = 'PACKAGE BODY' and
usage_context_id = 0
UNION ALL
select iteration.line,
iteration.col,
iteration.name identifier,
iteration.type,
iteration.usage,
iteration.usage_id,
iteration.usage_context_id,
iteration.object_name,
iteration.object_type,
iteration.owner,
predecessor.indent + 1 indent
from all_identifiers iteration join
package_identifier_hier predecessor on
predecessor.owner = iteration.owner and
predecessor.object_name = iteration.object_name and
predecessor.object_type = iteration.object_type and
predecessor.usage_id = iteration.usage_context_id
)
select lpad (' ', 2 * indent) ||
identifier || ' ' ||
lower(type) || ' (' || lower(usage) || ')'
identifier_hierarchy
from package_identifier_hier
order by line, col;
create or replace package plscope as
subtype signature_ is varchar2(32);
type signature_t_ is table of signature_;
procedure fill_callable(owner_ in varchar2, delete_existing in boolean);
procedure fill_call (owner_ in varchar2, delete_existing in boolean);
procedure print_upwards_graph (sig signature_, format in varchar2);
procedure print_downwards_graph (sig signature_, format in varchar2);
-- Try to find a call path from a 'callable' to another 'callable',
-- possibly via more than one hops.
procedure find_call_path(sig_from signature_, sig_to signature_);
procedure print_dot_graph;
function who_calls(sig_called signature_) return signature_t_;
procedure gather_identifiers;
end plscope;
/
--
-- Call 'plscope.gather_identifiers' after
-- installing these tables/views in order
-- to fill 'all_identifiers'.
--
-- Then call 'plscope.fill_call'.
--
declare
procedure drop_if_exists(name in varchar2) is -- {
type_ varchar2(30);
begin
select object_type into type_ from user_objects where object_name = upper(name);
execute immediate
'drop ' || type_ || ' ' || name ||
case when type_ = 'TABLE' then ' purge' end;
exception when no_data_found then
null;
end drop_if_exists; -- }
begin
drop_if_exists ('plscope_ref_v' );
drop_if_exists ('plscope_call_v' );
drop_if_exists ('plscope_call' );
drop_if_exists ('plscope_callable');
end;
/
create table plscope_callable (
signature varchar2(32) not null primary key,
object_name varchar2(30) not null,
name varchar2(30) not null,
complete_name varchar2(61) as (object_name || '.' || name) virtual,
exclude number(1) not null check (exclude in (0,1))
);
comment on column plscope_callable.exclude is 'Flag if calls from/to this callable should be excluded when plscope.downwards / plscope.upwards is executed';
create table plscope_call (
caller not null references plscope_callable,
callee not null references plscope_callable
);
create view plscope_call_v as
select
caller.object_name object_name_caller,
caller.name name_caller,
caller.complete_name complete_name_caller,
caller.exclude exclude_caller,
--
callee.object_name object_name_callee,
callee.name name_callee,
callee.complete_name complete_name_callee,
callee.exclude exclude_callee,
--
caller.signature signature_caller,
callee.signature signature_callee
from
plscope_call call
join plscope_callable caller on call.caller = caller.signature
join plscope_callable callee on call.callee = callee.signature;
create view plscope_ref_v as with direct as (
select '->' ion from dual union all
select '<-' ion from dual
)
select
case when direct.ion = '->' then object_name_caller else object_name_callee end object_name_referenced,
case when direct.ion = '->' then name_caller else name_callee end name_referenced,
case when direct.ion = '->' then complete_name_caller else complete_name_callee end complete_name_referenced,
--
direct.ion direction,
--
case when direct.ion = '<-' then object_name_caller else object_name_callee end object_name_references,
case when direct.ion = '<-' then name_caller else name_callee end name_references,
case when direct.ion = '<-' then complete_name_caller else complete_name_callee end complete_name_references
from
plscope_call_v cross join direct;
create package body pck_a as -- {
function foo_bar_baz return varchar2 is -- {
v_unused number;
v_used varchar2(20);
begin
v_used := pck_c.func_c_01;
return c_foo||c_bar||c_baz||v_used;
end foo_bar_baz; -- }
end pck_a; -- }
/
show errors
create package body pck_b as -- {
function fun_unused return varchar2 is -- {
begin
return 'unused';
end fun_unused; -- }
function fun_another_unused return varchar2 is -- {
begin
return 'another unused';
end fun_another_unused; -- }
function fun_2 return varchar2 is -- {
rec used_rec_t;
begin
select id into rec.id
from tab_01
where id = 1;
return 'fun_2';
end fun_2; -- }
function not_really_used return varchar2 is -- {
type rec_t is record (
id number,
unused varchar2(100)
);
rec rec_t;
begin
select id into rec.id from tab_01 where rownum = 1;
return fun_2 || pck_a.foo_bar_baz;
end not_really_used; -- }
end pck_b; -- }
/
show errors
create package pck_b as -- {
type used_rec_t is record (
id tab_01.id%type,
text tab_01.text%type
);
v_unused_b date;
function not_really_used return varchar2;
end pck_b; -- }
/
create package body pck_c as -- {
function func_c_02 return varchar2 is begin -- {
return 'FUNC_D';
end func_c_02; -- }
function func_c_01 return varchar2 is begin -- {
for r in (select * from tab_01) loop
if r.text = pck_a.c_foo then
return 'X';
elsif r.text = pck_a.c_bar then
return 'Y';
elsif r.text = pck_a.c_baz then
return func_c_02;
end if;
end loop;
return null;
end func_c_01; -- }
function func_c_trg_01 return varchar2 is begin -- called by trg_01 {
return 'TRG_01';
end func_c_trg_01; -- }
end pck_c; -- }
/
create package pck_c as -- {
function func_c_01 return varchar2;
function func_c_02 return varchar2;
function func_c_trg_01 return varchar2; -- called by trg_01
end pck_c; -- }
/
connect / as sysdba
declare
procedure drop_user_if_exists is
cnt number;
begin
select count(*) into cnt from dba_users where username = 'TQ84_PLSCOPE_TEST';
if cnt > 0 then
execute immediate 'drop user tq84_plscope_test cascade';
end if;
end drop_user_if_exists;
begin
drop_user_if_exists;
end;
/
create user tq84_plscope_test
identified by tq84_plscope_test
default tablespace data
temporary tablespace temp
quota unlimited on data;
grant
create procedure,
create session,
create synonym,
create table,
create trigger,
create view
to tq84_plscope_test;
grant all on sys.all_identifiers to tq84_plscope_test;
-- Grants needed for tq84_all_identifiers (see ../tq84_plscope_test.sql)
grant all on sys."_CURRENT_EDITION_OBJ" to tq84_plscope_test;
grant all on sys.plscope_identifier$ to tq84_plscope_test;
grant all on sys.plscope_action$ to tq84_plscope_test;
grant all on sys.user$ to tq84_plscope_test;
connect tq84_plscope_test/tq84_plscope_test;
@tab_01.sql
@pck_a.pks
@pck_b.pks
@pck_c.pks
@pck_a.pkb
@pck_b.pkb
@pck_c.pkb
@trg_01.plsql
-- Install PL-Scope:
@@../tables.sql
@@../spec.plsql
@@../body.plsql
-- Run PL-Scope
connect tq84_plscope_test/tq84_plscope_test
exec plscope.gather_identifiers
@@../tq84_all_identifiers
commit;
-- Prevent ORA-04068: existing state of packages has been discarded
connect tq84_plscope_test/tq84_plscope_test
exec plscope.fill_call(user, true);
-- Vim Tests
@@../vim/unused_constants.sql
@@../vim/unused_functions.sql
@@../vim/unused_variables.sql
$fc unused_constants.ef unused_constants.expected
$fc unused_functions.ef unused_functions.expected
$fc unused_variables.ef unused_variables.expected
--
-- :set efm=%f-%l-%c-%m
-- :cf unused_constants.ef
--
@spool unused_constants.ef
select distinct
lower(x.object_name) ||
case x.object_type
when 'PACKAGE BODY' then '.pkb'
when 'PACKAGE' then '.pks'
end || '-' ||
x.line || '-' ||
x.col || '-' ||
x.name t
from (
select signature from all_identifiers where usage in ('DECLARATION') and type in ('CONSTANT') and owner = user
minus
select signature from all_identifiers where usage in ('REFERENCE') and owner = user
) o, all_identifiers x
where o.signature = x.signature
order by
1
;
@spool_off
--
-- :set efm=%f-%l-%c-%m
-- :cf unused_functions.ef
--
@spool unused_functions.ef
select
lower(object_name) ||
case object_type
when 'PACKAGE BODY' then '.pkb'
when 'PACKAGE' then '.pks'
when 'TYPE BODY' then '.tyb'
when 'TYPE' then '.tys'
end || '-' ||
line || '-' ||
col || '-' ||
name t
from (
select distinct
x.object_name,
x.object_type,
x.line,
x.col,
x.name
from (
select
distinct signature
from
all_identifiers
where
usage in ('DEFINITION' , 'DECLARATION' ) and
type in ('FUNCTION', 'PROCEDURE' /*,'CURSOR' ,'VARIABLE'*/) and
object_type in ('PACKAGE', 'PACKAGE BODY') and
owner = user
minus
select
signature
from
all_identifiers
where
-- (usage = 'DECLARATION' and object_type = 'PACKAGE') or -- << Only functions that are declared in package body
-- -- Comment, if all unreferenced functions are desired.
(usage not in ('DECLARATION', 'DEFINITION'))
) o,
all_identifiers x
where
o.signature = x.signature
)
order by
object_name,
object_type,
line,
col;
@spool_off
--
-- :set efm=%f-%l-%c-%m
-- :cf unused_variables.ef
--
@spool unused_variables.ef
select
lower(object_name) ||
case object_type
when 'PACKAGE BODY' then '.pkb'
when 'PACKAGE' then '.pks'
when 'TYPE BODY' then '.tyb'
when 'TYPE' then '.tys'
end || '-' ||
x.line || '-' ||
x.col || '-' ||
x.name t
from (
select
signature from all_identifiers where usage in ( 'DEFINITION', 'DECLARATION') and type in (/*'CURSOR'*/ /*'CONSTANT'?*/ 'VARIABLE') and
-- object_type in ('PACKAGE BODY') and
owner = user
minus
select signature from all_identifiers where usage not in ('DEFINITION', 'DECLARATION')
) o,
all_identifiers x
where
o.signature = x.signature
order by
x.object_name,
x.line desc;
@spool_off
create or replace package body schema_to_neato as
type descriptions is table of desc_table.description;
procedure print(l in varchar2) is begin
dbms_output.put_line(l);
end print;
procedure add_relations(descs in descriptions) is
description desc_table.description;
procedure add_relation(parent in desc_table.table_t, child in desc_table.table_t) is begin
print(' "' || child.own || '.' || child.nam || '" -> "' || parent.own || '.' || parent.nam || '" [arrowhead=crow]');
end add_relation;
begin
-- iterating over all table descriptions:
for desc_no in 1 .. descs.count loop
description := descs(desc_no);
for child_no in 1 .. description.children.count loop
for tab_no_i in 1 .. descs.count loop
if descs(tab_no_i).tab.nam = description.children(child_no).nam and
descs(tab_no_i).tab.own = description.children(child_no).own then
add_relation(descs(tab_no_i).tab, descs(desc_no).tab);
end if;
end loop;
end loop;
end loop;
end add_relations;
procedure create_neato(tables in tables_t) is
descs descriptions := descriptions();
begin
print('digraph ri {' );
print(' page = "15,10";' ); -- A3
print(' overlap=false;' );
print(' splines=true;' );
print(' node [fontsize=8 fontname=Verdana shape=record];');
for idx_table in 1 .. tables.count loop
descs.extend;
descs(descs.count) := desc_table.describe(tables(idx_table));
end loop;
add_relations(descs);
print('}');
end create_neato;
end schema_to_neato;
/
create or replace package schema_to_neato
authid current_user
as
-- Don't confuse with desc_table.tables_t
type tables_t is table of varchar2(61);
procedure create_neato(tables in tables_t);
end schema_to_neato;
/
drop table erd_child_2_x_erd_other purge;
drop table erd_other purge;
drop table erd_child_2 purge;
drop table erd_child_1 purge;
drop table erd_parent purge;
--
-- Start from Shell (currently: cmd.exe) with
--
-- sqlplus rene/rene @neato_from_shell
--
set serveroutput on size 100000 format wrapped
set feedback off
set pagesize 0
set trimspool on
set termout off
spool c:\temp\neato_created.neato
set termout on
begin
schema_to_neato.create_neato(
schema_to_neato.tables_t(
'ERD_PARENT',
'ERD_CHILD_1',
'ERD_CHILD_2',
'ERD_OTHER',
'ERD_CHILD_2_X_ERD_OTHER'
)
);
end;
/
spool off
$neato -Tpng -oc:\temp\erd.png c:\temp\neato_created.neato
$c:\temp\erd.png
exit
drop trigger create_package_trg;
create or replace trigger create_package_trg
after create on schema
declare
j number;
begin
if ora_sysevent != 'CREATE' or ora_dict_obj_type not in ('PACKAGE', 'PACKAGE BODY', 'FUNCTION', 'PROCEDURE', 'TYPE', 'TYPE BODY') then
return;
end if;
-- Execute Insert Statement with dbms_job so that it runs in its own
-- session and can «see» the new source text.
dbms_job.submit(j, '
begin
insert into source_compilation(schema, name, type, compile_date, svn_revision, svn_date)
select
schema,
name,
type,
sysdate,
svn_revision,
svn_date
from
svn_keywords_in_source
where
type = ''' || ora_dict_obj_type || ''' and
name = ''' || ora_dict_obj_name || ''';
end;');
dbms_output.put_line('j: ' || j);
END create_package_trg;
/
create or replace package body trace_file as
-- Needs
--
-- grant
-- alter session ,
-- create session ,
-- create procedure ,
-- create sequence ,
-- create any directory ,
-- create table ,
-- create trigger ,
-- drop any directory ,
-- create public synonym
-- to <user>;
--
-- grant select on v_$process to <user>;
-- grant select on v_$session to <user>;
-- grant select on v_$parameter to <user>;
-- grant select on dba_users to <user>;
--
-- grant execute on utl_file to <user>;
--
-------------------------------------------------------
trace_file_dir varchar2(250);
trace_file_name varchar2( 50);
trace_file utl_file.file_type;
chars_read number;
procedure start_(sql_stmt in varchar2, remove_file in boolean := true) is begin/*{*/
cur_line# := 0;
chars_read := 0;
begin -- try to create directory 'TRACE_DIR'.
execute immediate 'create directory trace_dir as ''' || trace_file_dir || '''';
exception when others then -- Check if directory already existed.
if sqlcode != -955 then raise; end if;
end;
if remove_file then
-- Try to remove a possibly already existing trace file.
begin
utl_file.fremove('TRACE_DIR', trace_file_name);
exception when utl_file.invalid_operation then
-- If no such file existed, utl_file will throw
-- invalid_operation (and we need to do nothing):
null;
end;
end if;
execute immediate sql_stmt;
end start_;/*}*/
procedure stop__(sql_stmt in varchar2) is begin/*{*/
execute immediate sql_stmt;
-- Print directory and name of trace file
-- dbms_output.put_line('Dir: ' || trace_file_dir);
-- dbms_output.put_line('Name: ' || trace_file_name);
trace_file := utl_file.fopen('TRACE_DIR', trace_file_name, 'R', max_line_len);
end stop__;/*}*/
function next_line(line out varchar2) return boolean is /*{*/
-- size of newline, might be 1 on some systems
size_nl constant number := 2;
begin
utl_file.get_line(trace_file, line, max_line_len);
cur_line# := cur_line# + 1;
chars_read := chars_read + nvl(length(line),0) + size_nl;
return true;
exception when no_data_found then
execute immediate 'drop directory trace_dir';
return false;
when others then
raise_application_error(-20000,
'Error at line: ' || cur_line# ||
' for file: ' || trace_file_name ||
' directory: ' || trace_file_dir ||
' chars read: ' || chars_read ||
' message: ' || sqlerrm);
end next_line;/*}*/
procedure dump_block(file_no in number, block_no in number) is/*{*/
begin
-- http://www.adp-gmbh.ch/ora/misc/dump_block.html
start_('alter system dump datafile ' || file_no || ' block ' || block_no);
stop__('alter session set sql_trace=false');
end dump_block;/*}*/
procedure dump_block(row_id in rowid) is/*{*/
begin
dump_block(
file_no => dbms_rowid.rowid_relative_fno(row_id),
block_no => dbms_rowid.rowid_block_number(row_id)
);
end dump_block;/*}*/
begin/*{*/
select
u_dump .value ,
lower(db_name.value) || '_ora_' ||
proc .spid ||
nvl2(proc.traceid, '_' || proc.traceid, null) || '.trc'
into trace_file_dir,
trace_file_name
from
v$parameter u_dump
cross join v$parameter db_name
cross join v$process proc
join v$session sess
on proc.addr = sess.paddr
where
u_dump .name = 'user_dump_dest' and
db_name.name = 'db_name' and
sess .audsid = sys_context('userenv','sessionid');
/*}*/
end trace_file;
/
create or replace package trace_file
/*
Package trace_file (spec.plsql and body.plsql)
Copyright (C) René Nyffenegger
This source code is provided 'as-is', without any express or implied
warranty. In no event will the author be held liable for any damages
arising from the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this source code must not be misrepresented; you must not
claim that you wrote the original source code. If you use this source code
in a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original source code.
3. This notice may not be removed or altered from any source distribution.
René Nyffenegger rene.nyffenegger@adp-gmbh.ch
*/
authid current_user
as
max_line_len constant number := 32767;
cur_line# number ;
procedure start_ (sql_stmt in varchar2, remove_file in boolean := true);
procedure stop__ (sql_stmt in varchar2);
function next_line(line out varchar2) return boolean;
----
procedure dump_block(file_no in number, block_no in number);
procedure dump_block(row_id in rowid);
end trace_file;
/
http://hoopercharles.wordpress.com/2011/01/24/watching-consistent-gets-10200-trace-file-parser/
---
ALTER SESSION SET EVENTS '10046 trace name context forever, level 8';
http://www.hellodba.com/reader.php?ID=35&lang=en
exec trace_file.start_('alter session set sql_trace=true');
select sysdate from dual;
select count(*) from user_tables;
exec trace_file.stop__('alter session set sql_trace=false');
set serveroutput on size 1000000
declare
line varchar2(32767);
begin
while trace_file.next_line(line) loop
dbms_output.put_line(to_char(trace_file.cur_line#, '9999') || ': ' || line);
end loop;
end;
/
create table dump_block_test (
c number,
txt varchar2(200)
);
declare
row_id rowid;
line varchar2(32767);
begin
for c in ascii('a') .. ascii('z') loop
insert into dump_block_test values (c, lpad(chr(c), c, chr(c)));
end loop;
for c in ascii('A') .. ascii('Z') loop
insert into dump_block_test values (c, lpad(chr(c), c, chr(c)));
end loop;
commit;
--Make sure datafile is written to file:
execute immediate 'alter system checkpoint';
select rowid into row_id
from dump_block_test
where c = ascii('Q');
trace_file.dump_block(row_id);
while trace_file.next_line(line) loop
dbms_output.put_line(to_char(trace_file.cur_line#, '9999') || ': ' || line);
end loop;
end;
/
--select * from dump_block_test;
drop table dump_block_test;
create or replace package tq84_txt as
function rpd(txt varchar2, len_ number) return varchar2;
function dt(d date) return varchar2;
function num(nm number, pattern varchar2) return varchar2;
function num(nm number, len_left_of_dot pls_integer, len_right_of_dot pls_integer := 0) return varchar2;
function export(nm number ) return varchar2;
function export(txt varchar2) return varchar2;
end tq84_txt;
/
create or replace package body tq84_txt as
function rpd(txt varchar2, len_ number) return varchar2 is -- {
begin
if txt is null then
return rpad(' ', len_);
end if;
return rpad(txt, len_);
end rpd; -- }
function num(nm number, pattern varchar2) return varchar2 is -- {
begin
if nm is null then
return rpad(' ', length(pattern) + 1);
end if;
return to_char(nm, pattern);
end num; -- }
function num(nm number, len_left_of_dot pls_integer, len_right_of_dot pls_integer := 0) return varchar2 is -- {
pattern varchar2(100);
begin
pattern := lpad('9', len_left_of_dot - 1, '9');
pattern := pattern || '0';
if len_right_of_dot > 0 then
pattern := pattern || '.';
pattern := pattern || lpad('0', len_right_of_dot, '0');
end if;
return num(nm, pattern);
end num; -- }
function dt(d date) return varchar2 is -- {
begin
return to_char(d, 'yyyy-mm-dd');
end dt; -- }
function export(nm number) return varchar2 is -- {
begin
if nm is null then
return 'null';
end if;
return nm;
end export; -- }
function export(txt varchar2) return varchar2 is -- {
begin
if txt is null then
return 'null';
end if;
return '''' || replace(txt, '''', '''''') || '''';
end export; -- }
end tq84_txt;
/