#******************************************************************************* # # Copyright (c) 1997-2001, Perforce Software, Inc. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL PERFORCE SOFTWARE, INC. BE LIABLE FOR ANY # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. # #******************************************************************************* #******************************************************************************* #* Name : P4::Journal.pm #* Author : Tony Smith <tony@perforce.com> #* Description : Perl module for manipulating Perforce Journal files. #* #* Provides methods for parsing, and editing #* Perforce journal files. #* #******************************************************************************* #******************************************************************************* #* Journal Record class. Used to hold ready parsed records. #******************************************************************************* package P4::JournalRec; use AutoLoader; use strict; use vars qw( %FIELDMAP $AUTOLOAD ); %FIELDMAP = ( 'db.boddate' => [ [ 'key', 'attr', 'date' ], ], 'db.bodtext' => [ [ 'key','attr','text' ], ], 'db.change' => [ [ 'change','descKey','client', 'user','date','status', 'description' ], ], 'db.counters'=> [ [ 'name','value' ], ], 'db.depot' => [ [ 'name','type','address','map' ], ], 'db.desc' => [ [ 'descKey','description' ], ], 'db.domain' => [ [ 'name','type','host','mount', 'owner','updateDate','options', 'description' ], [ 'name','type','host','mount', 'owner','updateDate','accessDate', 'options','description' ], ], 'db.fix' => [ [ 'job','change','date','xstatus', 'client','user' ], [ 'job','change','date','status', 'client','user' ] ], 'db.group' => [ [ 'user','group' ], [ 'user','group','maxResults' ], [ 'user','group','isSubGroup','maxResults' ], ], 'db.have' => [ [ 'clientFile','depotFile','haveRev' ], [ 'clientFile','depotFile','haveRev','type' ], ], 'db.integ' => [ [ 'toFile','fromFile','startFromRev', 'endFromRev','toRev','how', 'committed','resolved','change' ], ], 'db.ixdate' => [ [ 'date','attr','value' ] ], 'db.ixtext' => [ [ 'word','attr','value' ] ], 'db.job' => [ [ 'job','xuser','xdate','xstatus', 'description' ], ], 'db.jobdesc' => [ [ 'xjob','xdescription' ], ], 'db.locks' => [ [ 'depotFile','client','user','isLocked' ], [ 'depotFile','client','user', 'action','isLocked' ], ], 'db.protect' => [ [ 'seq','user','host','perm', 'mapFlag','depotFile' ], [ 'seq','isGroup','user','host', 'perm','mapFlag','depotFile' ], [ 'seq','isGroup','user','host', 'perm','mapFlag','depotFile' ], ], 'db.rev' => [ [ 'depotFile','depotRev','type', 'isHead','action','change','date', 'lbrFile','lbrRev','lbrType' ], [ 'depotFile','depotRev','type', 'isHead','action','change','date', 'digest','lbrFile','lbrRev', 'lbrType' ], [ 'depotFile','depotRev','type', 'action','change','date', 'digest','lbrFile','lbrRev', 'lbrType' ], [ 'depotFile','depotRev','type', 'action','change','date','modTime', 'digest','lbrFile','lbrRev', 'lbrType' ] ], 'db.revcx' => [ [ 'change','depotFile','depotRev','action' ], ], 'db.review' => [ [ 'user','seq','mapFlag','depotFile','type' ], ], 'db.trigger' => [ [ 'seq','trigger','mapFlag', 'depotFile','action' ], ], 'db.user' => [ [ 'user','email','jobView', 'updateDate','accessDate', 'fullName' ], [], # there was no revision 1! [ 'user','email','jobView', 'updateDate','accessDate', 'fullName','password' ] ], 'db.view' => [ [ 'name','seq','mapFlag', 'viewFile','depotFile' ], ], 'db.working' => [ [ 'clientFile','depotFile','client', 'user','haveRev','workRev', 'type','action','change', 'modTime','isLocked' ], # modTime was actually called date [ 'clientFile','depotFile','client', 'user','haveRev','workRev', 'type','action','change', 'modTime','isLocked' ] ], ); $FIELDMAP{ 'db.fixrev' } = $FIELDMAP{ 'db.fix' }; $FIELDMAP{ 'db.jobpend' } = $FIELDMAP{ 'db.job' }; sub new { my $class = shift; my $rawrec = shift; my $self = { 'record' => $rawrec }; bless( $self, $class ); } sub DESTROY { } sub Raw() { my $self = shift; return $self->{'record'}; } sub SetRaw( $ ) { my $self = shift; my $rec = shift; $self->{'record'} = $rec; } # Set the record based on an array sub Set( \@ ) { my $self = shift; my $rec = ""; foreach my $field( @_ ) { if ( $field =~ /^\-?[0-9]+$/ ) { # Nothing } elsif ( $field =~ /^([0-9A-F][0-9A-F])+$/ ) { # Nothing } else { $field =~ s/\@/\@\@/g; $field =~ s/^((?:.|\n)*)$/\@$1\@/; } $rec .= "$field "; } $self->{'record'} = $rec; } # # Return the fields of the record as a cooked array. All '@' # encoding is removed. # sub Fields() { my $self = shift; my $rec = $self->{'record'}; my @infields = split(/ /, $rec); my @outfields; # Now need to rejoin some of the fields which contained embedded spaces while (@infields) { my $buf = shift( @infields ); if ( $buf =~ /^[0-9a-fA-F]+$/ ) { # Numeric field. push(@outfields, $buf); } elsif ( $buf =~ /^\@\@$/ ) { # It's an empty string push(@outfields, ""); } elsif ( $buf =~ /^\@(.|\n)+\@$/ ) { # The field is properly terminated $buf =~ s/^\@((.|\n)*)\@$/$1/; $buf =~ s/\@\@/\@/g; push(@outfields, $buf); } elsif ( $buf =~ /^\@([^@]|\@\@)*$/ ) { # Has been split too early and is not terminated. while ( $buf =~ /^\@([^@]|\@\@)*$/ ) { croak("Premature end of data!") if ( ! scalar( @infields ) ); $buf = $buf . " " . shift @infields; } unshift(@infields, $buf); } else { push(@outfields, $buf); } } @outfields; } # # Fetch fields by name. Expressions such as $rec->LbrFile() will be resolved # using the field map. # sub AUTOLOAD { my $self = shift; my $field = $AUTOLOAD; $field =~ s/.*:://; my @fields = $self->Fields(); my $op = $fields[0]; my $version = $fields[ 1 ]; my $tablename = $fields[ 2 ]; # Can only get, not set these fields return $op if ( $field =~ /^operation$/i ); return $tablename if ( $field =~ /^table$/i ); return $version if ( $field =~ /^version$/i ); if ( ! defined( $FIELDMAP{ $tablename } ) ) { croak("No fieldmap for table $tablename"); } my $tablemap = $FIELDMAP{ $tablename }[ $version ]; my $i; for ( $i = 0; $i < scalar (@$tablemap); $i++ ) { last if ( $tablemap->[$i] =~ /^$field$/i ); } if ( $i >= scalar(@$tablemap) ) { croak("No field $field exists in $tablename records!"); } if ( @_ ) { $fields[$i+3] = shift; $self->Set( @fields ); } else { return $fields[$i+3]; } } #******************************************************************************* #* Main Journal package #******************************************************************************* package P4::Journal; use Carp; use English; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK @MEMBERS ); require Exporter; @ISA = qw(Exporter ); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ); $VERSION = '0.25'; @MEMBERS = qw( File ); #******************************************************************************* #* Public Methods #******************************************************************************* sub new { my $class = shift; my $self = {}; my $arg; @$self{@MEMBERS} = (undef) x @MEMBERS; bless($self, $class); if ( @_ ) { $self->{File} = shift } return $self; } sub File( $ ) { my $self = shift; $self->{'File'} = shift; } sub Parse() { my $self = shift; my $file; my $rec = ""; my @fields; if ( @_ ) { $file = shift; open(FH, $file) or croak("Failed to open file $file"); } elsif ( defined ($self->{File} )) { $file = $self->{File}; open(FH, $file) or croak("Failed to open file $file"); } else { # Read from stdin instead. *FH = *STDIN; } while ( <FH> ) { $rec = $rec . $_; if ( $rec =~ /^(((\@([^\@]|\@\@)*\@)|\-?(\d|[A-F])+) )+$/ ) { $rec =~ s/\r?\n$//; $self->ParseRecord( new P4::JournalRec( $rec ) ); $rec = ""; } } close(FH); 1; } # # Default implementation does nothing. # sub ParseRecord( $ ) { my $rec = shift; warn( "Called the default implemetation of ParseRecord. You probably" . " didn't want to do that." ); } # Autoload methods go after =cut, and are processed by the autosplit program. 1; __END__ =head1 NAME P4::Journal - Perl extension for parsing Perforce Journals =head1 SYNOPSIS use P4::Journal; my $journal = new P4::Journal("jnl.1"); $journal->Parse(); =head1 DESCRIPTION P4::Journal provides a simple way to parse a Perforce Journal file. It provides a basic parser which can be use to build applications which parse Perforce Journal files and edit them. It leaves the policy of how it will be used to the client merely implements the minimum functionality required to implement Journal parsing and editing scripts. Just Parsing the checkpoint/journal is not any use in itself. To build useful functionality, derive your own class from P4::Journal and override the ParseRecord method. Documentation is still quite brief - sorry. =head1 METHODS - P4::Journal =over 4 =item new() The constructor for the P4::Journal class can be invoked either with, or without a filename argument. If invoked without an argument, then the filename must be passed as an argument to the Parse() method when it is called. my $jnl = new P4::Journal(); my $jnl2 = new P4::Journal("jnl.12"); =item Parse() Parses the specified file, and builds a data structure containing the parsed data. $jnl->Parse("jnl.12"); $jnl2->Parse(); =item ParseRecord() For each record that is parsed, a P4::JournalRec object is created and passed to this method. The default implementation just dumps the record in a semi-readable form to STDOUT. You will almost certainly want to override this method to achieve your aim. See below for documentation on the P4::JournalRec class which is your main tool for manipulating journal records. =back =head1 DESCRIPTION - P4::JournalRec P4::JournalRec provides an object-oriented interface to the journal records extracted from the input file. You have access to the raw record; you may access the record as an array of fields, or you may access fields by name. =head1 METHODS - P4::JournalRec =over 4 =item Raw() Returns the raw journal record as a scalar =item SetRaw() Allows you to supply an updated raw record - use at your own risk! =item Set() Supply a new record as an array of fields. Set() will handle all the formatting of the record for you. =item Fields() Returns all the fields in the record as an array. All formatting is removed so you get the decoded data to do with as you will. Note that $rec->Set( $rec->Fields() ) is essentially a no-op. =item Table() Returns the name of the table for the record (ie. db.rev etc ). =item AUTOLOAD() The AUTOLOAD method allows you to get and set individual fields by name. i.e. the change number in a db.change record might be fetched like this: C<$change = $rec-E<gt>Change();> and set like this: C<$rec-E<gt>Change( $change );> You should be sure that such a field exists in the record you are accessing before you call the method. =head1 AUTHOR Tony Smith <tony@perforce.com> =head1 LICENSE Copyright (c) 1997-2001, Perforce Software, Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL PERFORCE SOFTWARE, INC. BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. =head1 SEE ALSO perl(1). =cut
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#2 | 544 | Tony Smith |
Deleted Journal parsing scripts as they will be sent out only on request. |
||
#1 | 543 | Tony Smith |
Added my Checkpoint/Journal parsing perl module to the depot. Now supports an OO interface to journal records and to the parsing in general. |