comment on

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