1: package Table;
2: use strict;
3:
4: #############################################################
5: #
6: # Table - a Textfile-based Database
7: #
8: # Definitions:
9: #
10: # a ROW is a string of tab-delimited fields.
11: # FIELDS is a row containing column names.
12: #
13: #
14: # Usage:
15: #
16: # my $table = new Table( "tablename" );
17: #
18: # $table->read( "filename" );
19: # $table->write( "filename" );
20: #
21: # $table->name ( $tablename );
22: # $table->fields( $colNames );
23: # $table->rows ( @rows );
24: #
25: # $table->addRow( @rows );
26: # $table->row ( @rowNums );
27: #
28: # $table->column ( @colNames );
29: # $table->insertColumnAfter( $newCol, $afterCol );
30: # $table->putColumn ( $colName, @colData );
31: # $table->rmColumn ( $colName );
32: #
33: # $table->sumColumn ( $colName );
34: #
35: # $table->select( [colname, pattern], [colname, pattern] ... );
36: #
37: # Not Implemented:
38: #
39: # # $table->join( $myColumn, $otherTable, $otherColumn );
40: #
41: #
42: #
43: # EXAMPLE:
44: #
45: # !/usr/bin/perl
46: # use strict;
47: # use Table;
48: #
49: # my $tab = new Table();
50: #
51: # $tab->fields( "One", "Two", "Three" );
52: # $tab->rows( "a\tb\tc", "d\te\tf", "g\th\ti" );
53: #
54: # print $tab->toString(), "\n";
55: #
56: # $tab->write( "db2.txt" );
57: #
58: # my $tab2 = new Table();
59: # $tab2->read( "db2.txt" );
60: #
61: # print $tab2->toString(), "\n";
62: #
63: # print join( "\n", $tab->select( [ 'Two', 'e' ], [ 'One', 'd' ] ) ), "\n";
64: # print join( "\n", $tab->select( [ 'Two', 'e' ], [ 'One', 'f' ] ) ), "\n";
65: #
66: #
67: #
68: #
69: #
70: #
71: #############################################################
72:
73: #########################################
74: #
75: # Table constructor
76: #
77: #########################################
78: sub new
79: {
80: my $proto = shift;
81: my $class = ref($proto) || $proto;
82: my $self = {};
83:
84: $self->{NAME} = '';
85: $self->{FIELDS} = [];
86: $self->{FIELDINDEX} = {};
87: $self->{ROWS} = [];
88:
89: bless ($self, $class);
90: return $self;
91: }
92:
93: #########################################
94: #
95: # Read in table data from a file.
96: #
97: #########################################
98: sub read
99: {
100: my $self = shift;
101: my $file = shift;
102:
103: #
104: # Open and read in the specified file.
105: #
106: open( IN, $file );
107: my ($name, $fields, @rows) = <IN>;
108: close IN;
109:
110: chomp ($name, $fields, @rows );
111:
112: $self->name( $name ); # set the table name
113: $self->fields( $fields ); # set the field names
114: $self->rows( @rows ); # set the row data
115: return @rows; # return the row data
116: }
117:
118: #########################################
119: #
120: # Write out table data to a file.
121: #
122: #########################################
123: sub write
124: {
125: my $self = shift;
126: my $file = shift;
127:
128: open( OUT, ">$file" );
129: print OUT $self->name(), "\n";
130: print OUT join( "\t", @{$self->{FIELDS}} ), "\n";
131: print OUT join( "\n", $self->rows() ), "\n";
132: close OUT;
133: }
134:
135:
136: #########################################
137: #
138: # toString method
139: #
140: #########################################
141: sub toString
142: {
143: my $self = shift;
144: return $self->name(). "\n"
145: . join( "\t", $self->fields() ) . "\n"
146: . join( "\n", $self->rows() ) . "\n";
147: }
148:
149: #########################################
150: #
151: # Name accessor
152: #
153: #########################################
154: sub name
155: {
156: my $self = shift;
157: $self->{NAME} = shift if @_;
158: return $self->{NAME};
159: }
160:
161: ###########################
162: #
163: # Field hash refresh.
164: # Called by fields().
165: #
166: ###########################
167: sub refreshFieldData
168: {
169: my $self = shift;
170: my $i = 0;
171:
172: %{$self->{FIELDINDEX}} = map
173: {
174: ($_, $i++);
175: } @{$self->{FIELDS}};
176: }
177:
178: #########################################
179: #
180: # Fields accessor
181: #
182: #########################################
183: sub fields
184: {
185: my $self = shift;
186: if (@_)
187: {
188: @{ $self->{FIELDS} } = split( "\t", $_[0] ); # or just @_
189: $self->refreshFieldData();
190: }
191: return @{ $self->{FIELDS} };
192: }
193:
194: #########################################
195: #
196: # Return the position of a column.
197: #
198: #########################################
199: sub indexOf
200: {
201: my $self = shift;
202: my $name = shift;
203: return @{$self->{FIELDINDEX}}{$name};
204: }
205:
206: #########################################
207: #
208: # Rows accessor
209: # Destructively assigns rows to table.
210: #
211: #########################################
212: sub rows
213: {
214: my $self = shift;
215: if (@_) { @{ $self->{ROWS} } = @_ }
216: return @{ $self->{ROWS} };
217: }
218:
219:
220: #########################################
221: #
222: # Add rows
223: #
224: #########################################
225: sub addRow
226: {
227: my $self = shift;
228: push( @{ $self->{ROWS} }, @_ );
229: }
230:
231:
232: #########################################
233: #
234: # Fetch rows by row numbers
235: #
236: #########################################
237: sub row
238: {
239: my $self = shift;
240: return ${ $self->{ROWS} }[ @_ ];
241: }
242:
243:
244: #########################################
245: #
246: # Fetch columns by column names
247: #
248: #########################################
249: sub column
250: {
251: my $self = shift;
252: my @names = @_;
253: my @indices = map { ${$self->{FIELDINDEX}}{$_} } @names;
254: my @response;
255:
256: foreach ($self->rows())
257: {
258: push( @response, join( "\t", (split "\t")[@indices] ) );
259: }
260: return @response;
261: }
262:
263: #########################################
264: #
265: # Insert a new empty column.
266: #
267: #########################################
268: sub insertColumnAfter
269: {
270: my $self = shift;
271: my $newCol = shift;
272: my $index = $self->indexOf( shift ) + 1;
273: my @fields = $self->fields();
274:
275: splice @fields, $index, 0, $newCol;
276: $self->fields( join( "\t", @fields ) );
277:
278: my @newRows = ();
279: foreach ($self->rows())
280: {
281: my @row = split( "\t" );
282: splice @row, $index, 0, ' ';
283: $_ = join( "\t", @row );
284: push @newRows, $_;
285: }
286: $self->rows( @newRows );
287: }
288:
289: #########################################
290: #
291: # Remove column by column name
292: #
293: #########################################
294: sub rmColumn
295: {
296: my $self = shift;
297: my $name = shift;
298: my $index = $self->indexOf( $name );
299: my @fields = $self->fields();
300:
301: splice @fields, $index, 1;
302: $self->fields( join( "\t", @fields ) );
303:
304: my @newRows = ();
305: foreach ($self->rows())
306: {
307: my @row = split( "\t" );
308: splice @row, $index, 1;
309: $_ = join( "\t", @row );
310: push @newRows, $_;
311: }
312: $self->rows( @newRows );
313: }
314:
315: #########################################
316: #
317: # Replace column data by column name
318: #
319: #########################################
320: sub putColumn
321: {
322: my $self = shift;
323: my $index = $self->indexOf( shift );
324: my @col = @_;
325:
326: my @newRows = ();
327: foreach ($self->rows())
328: {
329: my $value = shift @col;
330: my @row = split( "\t" );
331: $row[$index] = $value;
332: push @newRows, join( "\t", @row );
333: }
334: $self->rows( @newRows );
335: }
336:
337: #########################################
338: #
339: # Return the sum of the column values.
340: #
341: #########################################
342: sub sumColumn
343: {
344: my $self = shift;
345: my @col = $self->column( shift );
346: my $val = 0;
347:
348: $val += $_ for @col;
349:
350: return $val;
351: }
352:
353:
354: #########################################
355: #
356: # Implementation of the select
357: # statement: basically, do a multiple-
358: # column pattern match on the database
359: # and return any resulting matches.
360: #
361: # WARNING: this only performs an
362: # intersection select().
363: #
364: #########################################
365: sub select
366: {
367: my $self = shift;
368: my @selects = @_; # an array of references
369:
370: my @patterns = ( '.*' ) x $self->rows();
371:
372: # print "patterns=", @patterns, "\n";
373:
374: #
375: # First, copy the patterns into the
376: # patterns array at the index corresponding
377: # to the given column name.
378: #
379: foreach (@selects)
380: {
381: # each member is a 2-element array
382: my ($column, $pattern) = @{$_};
383: $column = $self->indexOf( $column );
384: # print "Inserting $pattern in column $column\n";
385: $patterns[$column] = $pattern;
386: }
387:
388: # print "patterns=@patterns\n";
389:
390: #
391: # Now, turn the patterns array into something
392: # that looks like a real row in our table.
393: #
394: my $select = join( "\t", @patterns );
395:
396: # print "select=$select\n";
397:
398: #
399: # Now do a grep.
400: #
401: return grep( /$select/, $self->rows() );
402: }
403:
404: #########################################
405: #
406: # Implementation of the join statement:
407: # create a new table made up of the
408: # union of rows based around the specified
409: # column names.
410: #
411: #########################################
412: #sub join
413: #{
414: # my $self = shift;
415: # my $col = shift;
416: # my $coli = $self->indexOf( $col );
417: #
418: # my $other = shift;
419: # my $ocol = shift;
420: # my $ocoli = $other->indexOf( $ocol );
421: #
422: # my @rows = $self->rows();
423: # my @orows = $other->rows();
424: #}
425:
426:
427: 1; # end of package
428:
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: SQL? We don't need no steenking SQL!
by Juerd (Abbot) on May 15, 2002 at 21:33 UTC | |
by kal (Hermit) on May 16, 2002 at 20:16 UTC | |
| |
|
Re: SQL? We don't need no steenking SQL!
by graff (Chancellor) on May 19, 2002 at 20:53 UTC | |
by rje (Deacon) on May 21, 2002 at 20:50 UTC |